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

[svn:parrot] r34460 - branches/rvar/languages/perl6/src/parser

From:
pmichaud
Date:
December 27, 2008 17:22
Subject:
[svn:parrot] r34460 - branches/rvar/languages/perl6/src/parser
Message ID:
20081228012233.5F3EECBA12@x12.develooper.com
Author: pmichaud
Date: Sat Dec 27 17:22:32 2008
New Revision: 34460

Modified:
   branches/rvar/languages/perl6/src/parser/actions.pm
   branches/rvar/languages/perl6/src/parser/grammar.pg

Log:
[rakudo]:  Refactor the grammar to match STD.pm, and rip out 
lots of variable code so we can start rebuilding it from scratch.


Modified: branches/rvar/languages/perl6/src/parser/actions.pm
==============================================================================
--- branches/rvar/languages/perl6/src/parser/actions.pm	(original)
+++ branches/rvar/languages/perl6/src/parser/actions.pm	Sat Dec 27 17:22:32 2008
@@ -2053,558 +2053,50 @@
 }
 
 
-method variable_declarator($/) {
-    my $past := $( $<variable> );
 
-    # If it's an attribute declaration, we handle traits elsewhere.
-    my $twigil := $<variable><twigil>[0];
-    if $<trait> && $twigil ne '.' && $twigil ne '!' {
-        for $<trait> {
-            my $trait := $_;
-            if $trait<trait_auxiliary> {
-                my $aux := $trait<trait_auxiliary>;
-                my $sym := $aux<sym>;
-                if $sym eq 'is' {
-                    if $aux<postcircumfix> {
-                        $/.panic("'" ~ ~$trait ~ "' not implemented");
-                    }
-                    else {
-                        $past.viviself(~$aux<name>);
-                    }
-                }
-                else {
-                    $/.panic("'" ~ $sym ~ "' not implemented");
-                }
-            }
-            elsif $trait<trait_verb> {
-                my $verb := $trait<trait_verb>;
-                my $sym := $verb<sym>;
-                if $sym ne 'handles' {
-                    $/.panic("'" ~ $sym ~ "' not implemented");
-                }
-            }
-        }
+method scope_declarator($/) {
+    my $sym  := ~$<sym>;
+    my $past := $( $<scoped> );
+    if $past.isa(PAST::Var) {
+        my $scope := $sym eq 'my' ?? 'lexical' !! 'package';
+        our $?BLOCK;
+        $?BLOCK.symbol( $past.name() , :scope($scope) );
     }
-
     make $past;
 }
 
 
 method scoped($/) {
-    my $past;
-
-    # Variable declaration?
-    if $<declarator><variable_declarator> {
-        $past := $( $<declarator><variable_declarator> );
-
-        # Unless it's an attribute, emit code to set type and initialize it to
-        # the correct proto.
-        if $<fulltypename> && $past.isa(PAST::Var) {
-            my $type_pir := "    %r = new %0, %1\n    setprop %r, 'type', %2\n";
-            my $type := build_type($<fulltypename>);
-            $past.viviself(
-                PAST::Op.new(
-                    :inline($type_pir),
-                    PAST::Val.new( :value(~$past.viviself()) ),
-                    PAST::Op.new(
-                        :pasttype('if'),
-                        PAST::Op.new(
-                            :pirop('isa'),
-                            $type,
-                            PAST::Val.new( :value("P6protoobject") )
-                        ),
-                        $type,
-                        PAST::Var.new(
-                            :name('Failure'),
-                            :scope('package')
-                        )
-                    ),
-                    $type
-                )
-            );
-        }
-    }
-
-    # Variable declaration, but with a signature?
-    elsif $<declarator><signature> {
-        if $<fulltypename> {
-            $/.panic("Distributing a type across a signature at declaration unimplemented.");
-        }
-        $past := $( $<declarator><signature> );
-    }
-
-    # Routine declaration?
-    else {
-        $past := $( $<routine_declarator> );
-
-        # Don't support setting return type yet.
-        if $<fulltypename> {
-            $/.panic("Setting return type of a routine not yet implemented.");
-        }
-    }
+    my $past := $( $<declarator> );
     make $past;
 }
 
 
-sub declare_attribute($/, $sym, $variable_sigil, $variable_twigil, $variable_name) {
-    # Get the class or role we're in.
-    our $?CLASS;
-    our $?ROLE;
-    our $?PACKAGE;
-    our $?BLOCK;
-    my $class_def;
-    if $?ROLE =:= $?PACKAGE {
-        $class_def := $?ROLE;
-    }
-    else {
-        $class_def := $?CLASS;
-    }
-    unless defined( $class_def ) {
-        $/.panic(
-                "attempt to define attribute '" ~ $name ~ "' outside of class"
-        );
-    }
-
-    # Is this a role-private or just a normal attribute?
-    my $name;
-    if $sym eq 'my' {
-        # These are only allowed inside a role.
-        unless $class_def =:= $?ROLE {
-            $/.panic('Role private attributes can only be declared in a role');
-        }
-
-        # We need to name-manage this somehow. We'll do $!rolename!attrname
-        # for now; long term, want some UUID. For the block entry, we enter it
-        # as $!attrname, add the real name and set the scope as rpattribute,
-        # then translate it to the right thing when we see it.
-        our $?NS;
-        $name := ~$variable_sigil ~ '!' ~ $?NS ~ '!' ~ ~$variable_name;
-        my $visible_name := ~$variable_sigil ~ '!' ~ ~$variable_name;
-        my $real_name := '!' ~ $?NS ~ '!' ~ ~$variable_name;
-        $?BLOCK.symbol($visible_name, :scope('rpattribute'), :real_name($real_name));
-    }
-    else {
-        # Register name as attribute scope.
-        $name := ~$variable_sigil ~ '!' ~ ~$variable_name;
-        $?BLOCK.symbol($name, :scope('attribute'));
-    }
-
-    # Add attribute to class (always name it with ! twigil).
-    if $/<scoped><fulltypename> {
-        $class_def.push(
-            PAST::Op.new(
-                :pasttype('call'),
-                :name('!keyword_has'),
-                PAST::Var.new(
-                    :name('def'),
-                    :scope('register')
-                ),
-                PAST::Val.new( :value($name) ),
-                build_type($/<scoped><fulltypename>)
-            )
-        );
-    }
-    else {
-        $class_def.push(
-            PAST::Op.new(
-                :pasttype('call'),
-                :name('!keyword_has'),
-                PAST::Var.new(
-                    :name('def'),
-                    :scope('register')
-                ),
-                PAST::Val.new( :value($name) )
-            )
-        );
-    }
-
-    # Is there any "handles" trait verb or an "is rw" or "is ro"?
-    my $rw := 0;
-    if $<scoped><declarator><variable_declarator><trait> {
-        for $<scoped><declarator><variable_declarator><trait> {
-            if $_<trait_verb><sym> eq 'handles' {
-                # Get the methods for the handles and add them to
-                # the class
-                my $meths := process_handles(
-                    $/,
-                    $( $_<trait_verb><EXPR> ),
-                    $name
-                );
-                for @($meths) {
-                    $class_def.push($_);
-                }
-            }
-            elsif $_<trait_auxiliary><sym> eq 'is' {
-                # Just handle rw for now.
-                if ~$_<trait_auxiliary><name> eq 'rw' {
-                    $rw := 1;
-                }
-                else {
-                    $/.panic("Only 'is rw' trait is implemented for attributes");
-                }
-            }
-            else {
-                $/.panic("Only is and handles trait verbs are implemented for attributes");
-            }
-        }
-    }
-
-    # Generate private accessor.
-    my $accessor := make_accessor($/, '!' ~ ~$variable_name, $name, 1, 'attribute');
-    $class_def.push(add_method_to_class($accessor));
-
-    # Twigil handling.
-    if $variable_twigil eq '.' {
-        # We have a . twigil, so we need to generate a public accessor.
-        my $accessor := make_accessor($/, ~$variable_name, $name, $rw, 'attribute');
-        $class_def.push(add_method_to_class($accessor));
-    }
-    elsif $variable_twigil eq '!' {
-        # Don't need to do anything.
-    }
-    elsif $variable_twigil eq '' {
-        # We have no twigil, make $name as an alias to $!name.
-        $?BLOCK.symbol(
-            ~$variable_sigil ~ ~$variable_name, :scope('attribute')
-        );
-    }
-    else {
-        # It's a twigil that you canny use in an attribute declaration.
-        $/.panic(
-                "invalid twigil "
-            ~ $variable_twigil ~ " in attribute declaration"
-        );
+method declarator($/) {
+    my $past;
+    if $<variable_declarator> {
+        $past := $( $<variable_declarator> );
     }
+    make $past;
 }
 
-method scope_declarator($/) {
-    our $?BLOCK;
-    my $declarator := $<sym>;
-    my $past := $( $<scoped> );
-
-    # What sort of thing are we scoping?
-    if $<scoped><declarator><variable_declarator> {
-        our $?PACKAGE;
-        our $?ROLE;
-        our $?CLASS;
-
-        # Variable. If it's declared with "has" it is always an attribute. If
-        # it is declared with "my" inside a role and has the ! twigil, it is
-        # a role private attribute.
-        my $variable := $<scoped><declarator><variable_declarator><variable>;
-        my $twigil := $variable<twigil>[0];
-        my $role_priv := $?ROLE =:= $?PACKAGE && $declarator eq 'my' && $twigil eq '!';
-        if $declarator eq 'has' || $role_priv {
-            # Attribute declarations need special handling.
-            my $sigil := ~$<scoped><declarator><variable_declarator><variable><sigil>;
-            my $twigil := ~$<scoped><declarator><variable_declarator><variable><twigil>[0];
-            my $name := ~$<scoped><declarator><variable_declarator><variable><name>;
-            declare_attribute($/, $declarator, $sigil, $twigil, $name);
-
-            # Always leave a PAST::Var attribute node behind (can't just use what was
-            # produced as . twigil may have transformed it to a method call).
-            $past := PAST::Var.new(
-                :node($<scoped><declarator><variable_declarator><variable>),
-                :name($name),
-                :scope('attribute'),
-                :isdecl(1)
-            );
-        }
-
-        # If we're in a class and have something declared with a sigil, then
-        # we need to generate an accessor method and emit that along with the
-        # lexical declaration itself.
-        elsif ($twigil eq '.' || $twigil eq '!') && $?CLASS =:= $?PACKAGE {
-            # This node is just the variable declaration; also register it in
-            # the symbol table.
-            my $orig_past := $past;
-            $past := PAST::Var.new(
-                :name(~$variable<sigil> ~ '!' ~ ~$variable<name>),
-                :scope('lexical'),
-                :isdecl(1),
-                :viviself(container_type(~$variable<sigil>))
-            );
-            $?BLOCK.symbol($past.name(), :scope('lexical'));
-
-            # Now generate accessor, if it's public.
-            if $twigil eq '.' {
-                $?CLASS.push(make_accessor($/, $orig_past.name(), $past.name(), 1, 'lexical'));
-            }
-        }
-
-        # Otherwise, just a normal variable declaration.
-        else {
-            # Has this already been declared?
-            my $name := $past.name();
-            unless $?BLOCK.symbol($name) {
-                #  First declaration
-                my $scope := 'lexical';
-                $past.isdecl(1);
-                if $declarator eq 'our' {
-                    $scope := 'package';
-                }
-                elsif $declarator ne 'my' {
-                    $/.panic(
-                          "scope declarator '"
-                        ~ $declarator ~ "' not implemented"
-                    );
-                }
-
-                # Add block entry and set scope.
-                $past.scope($scope);
-                $?BLOCK.symbol($name, :scope($scope));
-            }
-        }
-    }
-
-    # Signature.
-    elsif $<scoped><declarator><signature> {
-        # We'll emit code to declare each of the parameters, then we'll have
-        # the declaration evaluate to the signature object, thus allowing an
-        # assignment to it.
-        my @declare := sig_extract_declarables($/, $past);
-        $past := PAST::Op.new(:name('list'), :node($/) );
-        for @declare {
-            # Work out sigil and twigil.
-            my $sigil := substr($_, 0, 1);
-            my $twigil := substr($_, 1, 1);
-            my $desigilname;
-            if $twigil eq '.' || $twigil eq '!' {
-                $desigilname := substr($_, 2);
-            }
-            else {
-                $twigil := '';
-                $desigilname := substr($_, 1);
-            }
-
-            # Decide by declarator.
-            if $declarator eq 'my' || $declarator eq 'our' {
-                # Add declaration code.
-                my $scope;
-                if $declarator eq 'my' {
-                    $scope := 'lexical'
-                }
-                else {
-                    $scope := 'package';
-                }
-                $past.push(PAST::Var.new(
-                    :name($_),
-                    :isdecl(1),
-                    :scope($scope),
-                    :viviself(container_type($sigil))
-                ));
-
-                # Add block entry.
-                $?BLOCK.symbol($_, :scope($scope));
-            } elsif $declarator eq 'has' {
-                declare_attribute($/, $declarator, $sigil, $twigil, $desigilname);
-            }
-            else {
-                $/.panic("Scope declarator " ~ $declarator ~ " unimplemented with signatures.");
-            }
-        }
-    }
-
-    # Routine?
-    elsif $<scoped><routine_declarator> {
-        # What declarator?
-        if $declarator eq 'our' {
-            # Default, nothing to do.
-        }
-        elsif $declarator eq 'my' {
-            if $<scoped><routine_declarator><sym> eq 'method' {
-                # Add ! to start of name.
-                $past.name('!' ~ $past.name());
-            }
-            else {
-                $/.panic("Lexically scoped subs not yet implemented.");
-            }
-        }
-        else {
-            $/.panic("Cannot apply declarator '" ~ $declarator ~ "' to a routine.");
-        }
-    }
-
-    # Something else we've not implemetned yet?
-    else {
-        $/.panic("Don't know how to apply a scope declarator here.");
-    }
 
+method variable_declarator($/) {
+    my $past := $( $<variable> );
+    $past.isdecl(1);
+    $past.viviself(
+        PAST::Op.new( :pirop('new Ps'),
+                      container_type($<variable><sigil>)
+        )
+    );
     make $past;
 }
 
-
 method variable($/, $key) {
-    my $past;
-    if $key eq 'special_variable' {
-        $past := $( $<special_variable> );
-    }
-    elsif $key eq '$0' {
-        $past := PAST::Var.new(
-            :scope('keyed_int'),
-            :node($/),
-            :viviself('Failure'),
-            PAST::Var.new(
-                :scope('lexical'),
-                :name('$/')
-            ),
-            PAST::Val.new(
-                :value(~$<matchidx>),
-                :returns('Int')
-            )
-        );
-    }
-    elsif $key eq '$<>' {
-        $past := $( $<postcircumfix> );
-        $past.unshift(PAST::Var.new(
-            :scope('lexical'),
-            :name('$/'),
-            :viviself('Failure')
-        ));
-    }
-    elsif $key eq '$var' {
-        our $?BLOCK;
-        # Handle naming.
-        my @identifier := Perl6::Compiler.parse_name($<name>);
-        my $name := @identifier.pop();
-
-        my $twigil := ~$<twigil>[0];
-        my $sigil := ~$<sigil>;
-        my $fullname := $sigil ~ $twigil ~ ~$name;
-
-        if $fullname eq '@_' || $fullname eq '%_' {
-            unless $?BLOCK.symbol($fullname) {
-                $?BLOCK.symbol( $fullname, :scope('lexical') );
-                my $var;
-                if $sigil eq '@' {
-                    $var := PAST::Var.new( :name($fullname), :scope('parameter'), :slurpy(1) );
-                }
-                else {
-                    $var := PAST::Var.new( :name($fullname), :scope('parameter'), :slurpy(1), :named(1) );
-                }
-                $?BLOCK[0].unshift($var);
-            }
-        }
-
-        if $twigil eq '^' || $twigil eq ':' {
-            if $?BLOCK.symbol('___HAVE_A_SIGNATURE') {
-                $/.panic('A signature must not be defined on a sub that uses placeholder vars.');
-            }
-            unless $?BLOCK.symbol($fullname) {
-                $?BLOCK.symbol( $fullname, :scope('lexical') );
-                $?BLOCK.arity( +$?BLOCK.arity() + 1 );
-                my $var := PAST::Var.new(:name($fullname), :scope('parameter'));
-                if $twigil eq ':' { $var.named( ~$name ); }
-                my $block := $?BLOCK[0];
-                my $i := +@($block);
-                while $i > 0 && $block[$i-1]<name> gt $fullname {
-                    $block[$i] := $block[$i-1];
-                    $i--;
-                }
-                $block[$i] := $var;
-            }
-        }
-
-        # If it's $.x, it's a method call, not a variable.
-        if $twigil eq '.' {
-            $past := PAST::Op.new(
-                :node($/),
-                :pasttype('callmethod'),
-                :name($name),
-                PAST::Var.new(
-                    :name('self'),
-                    :scope('lexical'),
-                    :node($/)
-                )
-            );
-        }
-        else {
-            # Variable. [!:^] twigil should be kept in the name.
-            if $twigil eq '!' || $twigil eq ':' || $twigil eq '^' || $twigil eq '?' {
-                $name := $twigil ~ ~$name;
-            }
-
-            # All but subs should keep their sigils.
-            my $sigil := '';
-            if $<sigil> ne '&' {
-                $sigil := ~$<sigil>;
-            }
-
-            # If we have no twigil, but we see the name noted as an attribute in
-            # an enclosing scope, add the ! twigil anyway; it's an alias.
-            if $twigil eq '' {
-                our @?BLOCK;
-                for @?BLOCK {
-                    if defined( $_ ) {
-                        my $sym_table := $_.symbol($sigil ~ $name);
-                        if defined( $sym_table )
-                                && $sym_table<scope> eq 'attribute' {
-                            $name := '!' ~ $name;
-                            $twigil := '!';
-                        }
-                    }
-                }
-            }
-
-            # If it's a role-private attribute, fix up the name.
-            if $twigil eq '!' {
-                our @?BLOCK;
-                for @?BLOCK {
-                    if defined( $_ ) {
-                        my $sym_table := $_.symbol($sigil ~ $name);
-                        if defined( $sym_table )
-                                && $sym_table<scope> eq 'rpattribute' {
-                            $name := $sym_table<real_name>;
-                        }
-                    }
-                }
-            }
-
-            $past := PAST::Var.new(
-                :name( $sigil ~ $name ),
-                :node($/)
-            );
-            if @identifier || $twigil eq '*' {
-                $past.namespace(@identifier);
-                $past.scope('package');
-            }
-
-            # If it has a ! twigil, give it attribute scope and add self.
-            if $twigil eq '!' {
-                $past.scope('attribute');
-                $past.unshift(PAST::Var.new(
-                    :name('self'),
-                    :scope('lexical')
-                ));
-            }
-
-            # If we have something with an & sigil see if it has any entries
-            # in the enclosing blocks; otherwise, default to package.
-            if $<sigil> eq '&' {
-                $past.scope('package');
-                our @?BLOCK;
-                for @?BLOCK {
-                    if defined($_) {
-                        my $sym_table := $_.symbol($name);
-                        if defined($sym_table) && defined($sym_table<scope>) {
-                            $past.scope( $sym_table<scope> );
-                        }
-                    }
-                }
-            }
-
-            # If we have the ? sigil, lexical scope.
-            if $twigil eq '?' {
-                $past.scope('lexical');
-            }
-
-            $past.viviself(container_type($sigil));
-        }
-    }
+    my $past := PAST::Var.new( :name(~$/), :node($/) );
     make $past;
 }
 
-
 method circumfix($/, $key) {
     my $past;
     if $key eq '( )' {

Modified: branches/rvar/languages/perl6/src/parser/grammar.pg
==============================================================================
--- branches/rvar/languages/perl6/src/parser/grammar.pg	(original)
+++ branches/rvar/languages/perl6/src/parser/grammar.pg	Sat Dec 27 17:22:32 2008
@@ -625,19 +625,6 @@
     ]
 }
 
-
-token variable_declarator {
-    <variable>
-    <trait>*
-# XXX let EXPR handle this automatically until we can pass arguments
-#    <.ws>
-#    [ # XXX <EXPR(%item_assignment)>
-#    | $<op>=['='|'.='] <.ws> <EXPR>
-#    ]?
-    {*}
-}
-
-
 rule enum_declarator {
     'enum' <name>?
     [
@@ -647,60 +634,69 @@
 }
 
 
-token declarator {
-    [
-    | <variable_declarator>
-    | '(' 
-      {{
-          $P0 = new 'Integer'
-          $P0 = 1
-          set_global [ 'Perl6' ; 'Grammar' ; 'Actions' ], '$?SIG_BLOCK_NOT_NEEDED', $P0
-      }}
-      ~ ')' <signature>
-      {{
-          $P0 = new 'Integer'
-          $P0 = 0
-          set_global [ 'Perl6' ; 'Grammar' ; 'Actions' ], '$?SIG_BLOCK_NOT_NEEDED', $P0
-      }}
-    ]
+
+rule scope_declarator {
+    $<sym>=[my|our|state|constant|has]
+    <scoped>
     {*}
 }
 
-
 rule scoped {
-    <fulltypename>*
     [
     | <declarator>
     | <routine_declarator>
+    | <fulltypename>+ <multi_declarator>
     ]
     {*}
 }
 
-
-rule scope_declarator {
-    $<sym>=[my|our|state|constant|has]
-    <scoped>
+token declarator {
+    [
+    | <variable_declarator>
+    | '(' ~ ')' <signature> <trait>*
+    | <routine_declarator>
+    | <regex_declarator>
+    | <type_declarator>
+    ]
     {*}
 }
 
-token circumfix {
-    | '(' <statementlist> ')' {*}                #= ( )
-    | '[' <statementlist> ']' {*}                #= [ ]
-    | <?before '{' | <lambda> > <pblock> {*}     #= { }
-    | <sigil> '(' <semilist> ')' {*}             #= $( )
+token variable_declarator {
+    <variable>
+    <.ws>
+    <trait>*
+    <post_constraint>*
+    {*}
 }
 
 token variable {
-    | <special_variable> {*}                     #= special_variable
-    | <sigil> <twigil>? <name> {*}               #= $var
-    | <sigil> $<matchidx>=[\d+] {*}              #= $0
-    | <sigil> <?before '<' > <postcircumfix> {*} #= $<>
+    <?sigil>
+    [
+    | <sigil> <twigil>? <desigilname> {*}                #= desigilname
+    | <special_variable> {*}                             #= special_variable
+    | <sigil> $<matchidx>=[\d+] {*}                      #= $0
+    | <sigil> <?before '<' | '(' > <postcircumfix> {*}   #= $<>
+    ]
 }
 
 token sigil { '$' | '@' | '%' | '&' | '@@' }
 
 token twigil { <[.!^:*+?=]> }
 
+token desigilname {
+    [
+    | <?before '$' > <variable>
+    | <longname=name>
+    ]
+}
+
+token circumfix {
+    | '(' <statementlist> ')' {*}                #= ( )
+    | '[' <statementlist> ']' {*}                #= [ ]
+    | <?before '{' | <lambda> > <pblock> {*}     #= { }
+    | <sigil> '(' <semilist> ')' {*}             #= $( )
+}
+
 token name {
     | <identifier> <morename>*
     | <morename>+
@@ -875,14 +871,6 @@
     ]
 }
 
-token desigilname {
-    [
-    | <?before '$' > <variable>
-    | <name>
-    ]
-    {*}
-}
-
 #### expressions and operators ####
 
 ##  The EXPR rule is our entry point into the operator



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