[svn:parrot] r19116 - in trunk: . languages/perl6/config/makefiles languages/perl6/src/PAST languages/perl6/src/classes languages/perl6/src/pmc

[pmichaud]

Author: pmichaud
Date: Mon Jun 18 22:50:40 2007
New Revision: 19116

Added:
   trunk/languages/perl6/src/classes/Bool.pir
Modified:
   trunk/MANIFEST
   trunk/languages/perl6/config/makefiles/root.in
   trunk/languages/perl6/src/PAST/Grammar.tg
   trunk/languages/perl6/src/classes/Str.pir
   trunk/languages/perl6/src/pmc/perl6bool.pmc
   trunk/languages/perl6/src/pmc/perl6str.pmc

Log:
[perl6]:
* Clean up handling of .WHAT methods to return classes instead of
  strings.
* Add stringify for Bool and Str class objects.
* Set capitalized barewords and names to do package lookups.
* All 01-sanity tests now pass except 08-test.t .
* Portions courtesy Mark Glines ([EMAIL PROTECTED]).


Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST      (original)
+++ trunk/MANIFEST      Mon Jun 18 22:50:40 2007
@@ -1684,6 +1684,7 @@
 languages/perl6/src/builtins/op.pir                         [perl6]
 languages/perl6/src/builtins/range.pir                      [perl6]
 languages/perl6/src/builtins/string.pir                     [perl6]
+languages/perl6/src/classes/Bool.pir                        [perl6]
 languages/perl6/src/classes/Code.pir                        [perl6]
 languages/perl6/src/classes/List.pir                        [perl6]
 languages/perl6/src/classes/Num.pir                         [perl6]

Modified: trunk/languages/perl6/config/makefiles/root.in
==============================================================================
--- trunk/languages/perl6/config/makefiles/root.in      (original)
+++ trunk/languages/perl6/config/makefiles/root.in      Mon Jun 18 22:50:40 2007
@@ -43,6 +43,7 @@
   src/builtins/op.pir \
   src/builtins/range.pir \
   src/builtins/string.pir \
+  src/classes/Bool.pir \
   src/classes/Code.pir \
   src/classes/List.pir \
   src/classes/Num.pir \

Modified: trunk/languages/perl6/src/PAST/Grammar.tg
==============================================================================
--- trunk/languages/perl6/src/PAST/Grammar.tg   (original)
+++ trunk/languages/perl6/src/PAST/Grammar.tg   Mon Jun 18 22:50:40 2007
@@ -584,11 +584,11 @@
 }
 
 transform past (Perl6::Grammar::type_name) :language('PIR') {
-    .local pmc cpast
+    .local pmc past
     $S0 = node
-    cpast = new 'PAST::Val'
-    cpast.'init'('node'=>node, 'vtype'=>'.Perl6Str', 'name'=>$S0, 
'ctype'=>'s~')
-    .return (cpast)
+    past = new 'PAST::Var'
+    past.'init'('node'=>node, 'name'=>$S0, 'scope'=>'package')
+    .return (past)
 }
 
 

Added: trunk/languages/perl6/src/classes/Bool.pir
==============================================================================
--- (empty file)
+++ trunk/languages/perl6/src/classes/Bool.pir  Mon Jun 18 22:50:40 2007
@@ -0,0 +1,31 @@
+.namespace
+
+.sub __onload :init :load
+    $P0 = getclass 'Perl6Bool'
+    set_global 'Bool', $P0
+    $P0 = new 'Perl6Bool'
+    $P0 = 0
+    set_global 'Bool::False', $P0
+    $P0 = new 'Perl6Bool'
+    $P0 = 1
+    set_global 'Bool::True', $P0
+.end
+
+.namespace [ 'Perl6Bool' ]
+
+.sub 'isa' :method
+    .param string x
+    $I0 = iseq x, 'Bool'
+    .return ($I0)
+.end
+
+.sub 'WHAT' :method
+    $P0 = getclass 'Perl6Bool'
+    .return ($P0)
+.end
+
+# Local Variables:
+#   mode: pir
+#   fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:

Modified: trunk/languages/perl6/src/classes/Str.pir
==============================================================================
--- trunk/languages/perl6/src/classes/Str.pir   (original)
+++ trunk/languages/perl6/src/classes/Str.pir   Mon Jun 18 22:50:40 2007
@@ -1,3 +1,9 @@
+.namespace
+
+.sub __onload :init :load
+    $P0 = getclass 'Perl6Str'
+    set_global 'Str', $P0
+.end
 
 .namespace [ 'Perl6Str' ]
 
@@ -7,6 +13,11 @@
     .return ($I0)
 .end
 
+.sub 'WHAT' :method
+    $P0 = getclass 'Perl6Str'
+    .return ($P0)
+.end
+
 # Local Variables:
 #   mode: pir
 #   fill-column: 100

Modified: trunk/languages/perl6/src/pmc/perl6bool.pmc
==============================================================================
--- trunk/languages/perl6/src/pmc/perl6bool.pmc (original)
+++ trunk/languages/perl6/src/pmc/perl6bool.pmc Mon Jun 18 22:50:40 2007
@@ -26,8 +26,11 @@
     hll Perl6
     maps Boolean {
 
-    METHOD STRING* WHAT() {
-        return string_from_const_cstring(INTERP, "Bool", 4);
+    STRING* get_string() {
+        PMC *class = GET_CLASS(PMC_data(SELF), SELF);
+        if (class == SELF)
+            return string_from_const_cstring(INTERP, "Str", 3);
+        return SUPER();
     }
 
 }

Modified: trunk/languages/perl6/src/pmc/perl6str.pmc
==============================================================================
--- trunk/languages/perl6/src/pmc/perl6str.pmc  (original)
+++ trunk/languages/perl6/src/pmc/perl6str.pmc  Mon Jun 18 22:50:40 2007
@@ -157,8 +157,11 @@
         return sign * f;
     }
 
-    METHOD STRING* WHAT() {
-        return string_from_const_cstring(INTERP, "Str", 3);
+    STRING* get_string() {
+        PMC *class = GET_CLASS(PMC_data(SELF), SELF);
+        if (class == SELF) 
+            return string_from_const_cstring(INTERP, "Str", 3);
+        return SUPER();
     }
 
 }