develooper Front page | perl.cvs.parrot | Postings from December 2008

[svn:parrot] r33843 - in branches/rakudoreg/languages/perl6: . config/makefiles src/builtins src/classes src/parser

From:
jonathan
Date:
December 12, 2008 16:28
Subject:
[svn:parrot] r33843 - in branches/rakudoreg/languages/perl6: . config/makefiles src/builtins src/classes src/parser
Message ID:
20081213002843.2D743CB9AF@x12.develooper.com
Author: jonathan
Date: Fri Dec 12 16:28:42 2008
New Revision: 33843

Modified:
   branches/rakudoreg/languages/perl6/config/makefiles/root.in
   branches/rakudoreg/languages/perl6/perl6.pir
   branches/rakudoreg/languages/perl6/src/builtins/guts.pir
   branches/rakudoreg/languages/perl6/src/classes/Bool.pir
   branches/rakudoreg/languages/perl6/src/classes/Failure.pir
   branches/rakudoreg/languages/perl6/src/classes/Order.pir
   branches/rakudoreg/languages/perl6/src/classes/Protoobject.pir
   branches/rakudoreg/languages/perl6/src/parser/actions.pm
   branches/rakudoreg/languages/perl6/src/parser/grammar.pg

Log:
[rakudo] Initial work on registering types at compile time and then typename checking against them. Passes most of spectest that we passed before; 3/6 broken tests here are due to us passing stuff before for the wrong reasons or due to incorrect tests that we just got away with before anyway.

Modified: branches/rakudoreg/languages/perl6/config/makefiles/root.in
==============================================================================
--- branches/rakudoreg/languages/perl6/config/makefiles/root.in	(original)
+++ branches/rakudoreg/languages/perl6/config/makefiles/root.in	Fri Dec 12 16:28:42 2008
@@ -83,6 +83,7 @@
   src/classes/Signature.pir \
   src/classes/Grammar.pir \
   src/classes/Module.pir \
+  src/classes/UnderConstructionProto.pir \
   src/builtins/globals.pir \
   src/builtins/any-list.pir \
   src/builtins/any-num.pir \

Modified: branches/rakudoreg/languages/perl6/perl6.pir
==============================================================================
--- branches/rakudoreg/languages/perl6/perl6.pir	(original)
+++ branches/rakudoreg/languages/perl6/perl6.pir	Fri Dec 12 16:28:42 2008
@@ -118,6 +118,12 @@
     $P0 = new 'List'
     set_hll_global ['Perl6'], '@?END_BLOCKS', $P0
 
+    ##  create a list of "UnderConstruction" objects we need to remove from
+    ##  the namespace once we reach the point of having finished compiling
+    ##  them
+    $P0 = new 'List'
+    set_hll_global ['Perl6';'Grammar';'Actions'], '@?UNDER_CONSTRUCTION', $P0
+
     ##  tell PAST::Var how to encode Perl6Str and Str values
     $P0 = get_hll_global ['PAST';'Compiler'], '%valflags'
     $P0['Perl6Str'] = 'e'

Modified: branches/rakudoreg/languages/perl6/src/builtins/guts.pir
==============================================================================
--- branches/rakudoreg/languages/perl6/src/builtins/guts.pir	(original)
+++ branches/rakudoreg/languages/perl6/src/builtins/guts.pir	Fri Dec 12 16:28:42 2008
@@ -218,6 +218,10 @@
     .const 'Sub' $P0 = "!SUBTYPE_ACCEPTS"
     subset.'add_method'('ACCEPTS', $P0)
 
+    # It's an abstraction.
+    $P0 = get_hll_global 'Abstraction'
+    subset.'add_role'($P0)
+
     # Instantiate it - we'll only ever create this one instance.
     subset = subset.'new'()
 

Modified: branches/rakudoreg/languages/perl6/src/classes/Bool.pir
==============================================================================
--- branches/rakudoreg/languages/perl6/src/classes/Bool.pir	(original)
+++ branches/rakudoreg/languages/perl6/src/classes/Bool.pir	Fri Dec 12 16:28:42 2008
@@ -31,6 +31,10 @@
     $P0 = boolproto.'new'()
     $P0 = 1
     set_hll_global ['Bool'], 'True', $P0
+
+    $P0 = class $P0
+    $P1 = box 1
+    setprop $P0, 'enum', $P1
 .end
 
 

Modified: branches/rakudoreg/languages/perl6/src/classes/Failure.pir
==============================================================================
--- branches/rakudoreg/languages/perl6/src/classes/Failure.pir	(original)
+++ branches/rakudoreg/languages/perl6/src/classes/Failure.pir	Fri Dec 12 16:28:42 2008
@@ -12,6 +12,15 @@
 
     $P0 = box 1
     set_hll_global '$WARNINGS', $P0
+
+    # There are a few other types that we don't have yet, but we will fake
+    # up by sticking a Failure in the namespace for them.
+    set_hll_global 'Class', failureproto
+    set_hll_global 'Void', failureproto
+    set_hll_global 'Inf', failureproto
+    set_hll_global 'NaN', failureproto
+    set_hll_global 'Regex', failureproto
+    set_hll_global 'StrPos', failureproto
 .end
 
 

Modified: branches/rakudoreg/languages/perl6/src/classes/Order.pir
==============================================================================
--- branches/rakudoreg/languages/perl6/src/classes/Order.pir	(original)
+++ branches/rakudoreg/languages/perl6/src/classes/Order.pir	Fri Dec 12 16:28:42 2008
@@ -33,6 +33,9 @@
     $P0 = -1
     set_hll_global ['Order'], 'Increase', $P0
 
+    $P0 = class $P0
+    $P1 = box 1
+    setprop $P0, 'enum', $P1
 .end
 
 

Modified: branches/rakudoreg/languages/perl6/src/classes/Protoobject.pir
==============================================================================
--- branches/rakudoreg/languages/perl6/src/classes/Protoobject.pir	(original)
+++ branches/rakudoreg/languages/perl6/src/classes/Protoobject.pir	Fri Dec 12 16:28:42 2008
@@ -13,7 +13,6 @@
 =item defined()
 
 =cut
-
 .namespace ['P6protoobject']
 .sub 'defined' :method
     $P0 = get_hll_global ['Bool'], 'False'

Modified: branches/rakudoreg/languages/perl6/src/parser/actions.pm
==============================================================================
--- branches/rakudoreg/languages/perl6/src/parser/actions.pm	(original)
+++ branches/rakudoreg/languages/perl6/src/parser/actions.pm	Fri Dec 12 16:28:42 2008
@@ -115,6 +115,12 @@
         )
     );
 
+    # Finally, clear up any temporary entries we made in the namespace.
+    our @?UNDER_CONSTRUCTION;
+    while @?UNDER_CONSTRUCTION.elems() > 0 {
+        @?UNDER_CONSTRUCTION.pop().cleanup();
+    }
+
     make $past;
 }
 
@@ -653,6 +659,15 @@
         my $getvals_sub := PAST::Compiler.compile( $block );
         my %values := $getvals_sub();
 
+        # Register the enum itself in the namespace.
+        our @?UNDER_CONSTRUCTION;
+        my @namespace := Perl6::Compiler.parse_name($<name>[0]);
+        my $short_name := @namespace ?? @namespace.pop() !! undef;
+        @?UNDER_CONSTRUCTION.push(
+            Perl6::Compiler::UnderConstructionProto.create(@namespace, $short_name)
+        );
+        @namespace.push($short_name); # Restore for putting stuff inside the namespace.
+
         # Now we need to emit a role of the name of the enum containing:
         #  * One attribute with the same name as the enum
         #  * A method of the same name as the enum
@@ -842,7 +857,7 @@
 
         # Now we need to create instances of each of these and install them
         # in a package starting with the enum's name, plus an alias to them
-        # in the current package.
+        # in the current package. Also register them in the namespace.
         for %values.keys() {
             # Instantiate with value.
             $class_past.push(PAST::Op.new(
@@ -880,6 +895,14 @@
                     :scope('package')
                 )
             ));
+
+            # Register both.
+            @?UNDER_CONSTRUCTION.push(
+                Perl6::Compiler::UnderConstructionProto.create(@namespace, $_)
+            );
+            @?UNDER_CONSTRUCTION.push(
+                Perl6::Compiler::UnderConstructionProto.create(list(), $_)
+            );
         }
 
         # Assemble all that we build into a statement list and then place it
@@ -1196,7 +1219,7 @@
         if $_<parameter><type_constraint> {
             for $_<parameter><type_constraint> {
                 # Just a type name?
-                if $_<typename><name><identifier> {
+                if $_<typename><name> && substr($_<typename><name>, 0, 2) ne '::' {
                     # Get type; we may have to fix up the scope if it's
                     # been captured within the signature.
                     my $type := $( $_<typename> );
@@ -1218,7 +1241,7 @@
                     $cur_param_types.push($type_obj);
                 }
                 # is it a ::Foo type binding?
-                elsif $_<typename> {
+                elsif substr($_<typename>, 0, 2) eq '::' {
                     my $tvname := ~$_<typename><name><morename>[0]<identifier>;
                     $params.push(PAST::Op.new(
                         :pasttype('bind'),
@@ -1773,6 +1796,10 @@
     my $name := $<name>;
 
     if $key eq 'open' {
+        our @?UNDER_CONSTRUCTION;
+        my @namespace := Perl6::Compiler.parse_name($<name>[0]);
+        my $short_name := @namespace ?? @namespace.pop() !! undef;
+
         # Start of package definition. Handle class and grammar specially.
         if $?PACKAGE =:= $?GRAMMAR {
             # Anonymous grammars not supported.
@@ -1795,6 +1822,11 @@
                     )
                 )
             );
+
+            # Register type in the namespace.
+            @?UNDER_CONSTRUCTION.push(
+                Perl6::Compiler::UnderConstructionProto.create(@namespace, $short_name)
+            );
         }
         elsif $?PACKAGE =:= $?CLASS {
             my $class_def;
@@ -1814,19 +1846,20 @@
                     )
                 );
 
-                # Add a name, if we have one.
-                if $name {
+                # Add a name, if we have one, and register in the namespace.
+                if $<name> {
                     $class_def[1].push( PAST::Val.new( :value(~$name[0]) ) );
+                    @?UNDER_CONSTRUCTION.push(
+                        Perl6::Compiler::UnderConstructionProto.create(@namespace, $short_name)
+                    );
                 }
             }
             else {
                 # We're adding to an existing class. Look up class by name and put
                 # it in $def.
-                unless $<name> {
+                unless $name {
                     $/.panic("Can only use is also trait on a named class.");
                 }
-                my @namespace := Perl6::Compiler.parse_name($<name>[0]);
-                my $short_name := @namespace.pop();
                 $class_def := PAST::Op.new(
                     :node($/),
                     :pasttype('bind'),
@@ -2015,6 +2048,14 @@
 
         # Also store the current namespace.
         $?NS := $name;
+
+        # Register type in the namespace.
+        our @?UNDER_CONSTRUCTION;
+        my @namespace := Perl6::Compiler.parse_name($name);
+        my $short_name := @namespace ?? @namespace.pop() !! undef;
+        @?UNDER_CONSTRUCTION.push(
+            Perl6::Compiler::UnderConstructionProto.create(@namespace, $short_name)
+        );
     }
     else {
         # Declare the namespace and that the result block holds things that we
@@ -3128,13 +3169,14 @@
     }
 
     # Create subset type.
-    my @name := Perl6::Compiler.parse_name($<name>);
+    my @namespace := Perl6::Compiler.parse_name($<name>);
+    my $short_name := @namespace.pop();
     $past := PAST::Op.new(
         :node($/),
         :pasttype('bind'),
         PAST::Var.new(
-            :name(@name.pop()),
-            :namespace(@name),
+            :name($short_name),
+            :namespace(@namespace),
             :scope('package')
         ),
         PAST::Op.new(
@@ -3151,6 +3193,12 @@
         )
     );
 
+    # Register in the namespace.
+    our @?UNDER_CONSTRUCTION;
+    @?UNDER_CONSTRUCTION.push(
+        Perl6::Compiler::UnderConstructionProto.create(@namespace, $short_name)
+    );
+
     # Put this code in $?INIT, so the type is created early enough, then this
     # node results in an empty statement node.
     our $?INIT;

Modified: branches/rakudoreg/languages/perl6/src/parser/grammar.pg
==============================================================================
--- branches/rakudoreg/languages/perl6/src/parser/grammar.pg	(original)
+++ branches/rakudoreg/languages/perl6/src/parser/grammar.pg	Fri Dec 12 16:28:42 2008
@@ -806,10 +806,45 @@
 }
 
 token typename {
-    <?before <.upper> | '::' > <name>
+    $<name>=<registered_typename>
     {*}
 }
 
+# XXX This goes away once we have assertions.
+token registered_typename {
+    <name>
+    {{
+        .local pmc compiler_obj, check_ns, check_symbol
+        .local string full_name
+        full_name = match['name']
+        $S0 = substr full_name, 0, 2
+        if $S0 == '::' goto type_ok
+        compiler_obj = get_hll_global [ 'Perl6' ], 'Compiler'
+        check_ns = compiler_obj.'parse_name'(full_name)
+        $S0 = pop check_ns
+        check_symbol = get_hll_global check_ns, $S0
+        if null check_symbol goto fail_it
+        $I0 = does check_symbol, 'Abstraction'
+        if $I0 goto type_ok
+        # XXX The following should be covered by a check for does Abstraction
+        $I0 = isa check_symbol, 'P6protoobject'
+        if $I0 goto type_ok
+        $I0 = isa check_symbol, 'Role'
+        if $I0 goto type_ok
+        $P0 = class check_symbol
+        $P0 = getprop 'enum', $P0
+        if null $P0 goto not_enum
+        if $P0 goto type_ok
+      not_enum:
+        goto fail_it
+      type_ok:
+        $P0 = match['name']
+        .return ($P0)
+      fail_it:
+    }}
+    <fail>
+}
+
 # These regex rules are some way off STD.pm at the moment, but we'll work them
 # closer to it over time.
 rule regex_declarator {



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About