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

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

From:
pmichaud
Date:
December 27, 2008 21:50
Subject:
[svn:parrot] r34465 - branches/rvar/languages/perl6/src/parser
Message ID:
20081228055047.51BF0CB9B0@x12.develooper.com
Author: pmichaud
Date: Sat Dec 27 21:50:46 2008
New Revision: 34465

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

Log:
[rakudo]:  More variable refactoring -- "my TypeName $x".


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 21:50:46 2008
@@ -512,55 +512,12 @@
 }
 
 
-method multi_declarator($/, $key) {
-    my $past := $( $/{$key} );
-
-    # If we just got a routine_def, make it a sub.
-    if $key eq 'routine_def' {
-        create_sub($/, $past);
-    }
-
-    # If we have an only, proto or multi, we must have a name.
-    if $<sym> ne "" && $past.name() eq "" {
-        $/.panic("'" ~ $<sym> ~ "' can only be used on named routines");
-    }
-
-    # If it was multi or a proto, then emit a :multi.
-    if $<sym> eq 'multi' || $<sym> eq 'proto' {
-        # For now, if this is a multi we need to add code to transform the sub's
-        # multi container to a Perl6MultiSub.
-        $past.loadinit().push(
-            PAST::Op.new(
-                :pasttype('call'),
-                :name('!TOPERL6MULTISUB'),
-                PAST::Var.new(
-                    :name('block'),
-                    :scope('register')
-                )
-            )
-        );
-
-        # Flag the sub as multi, but it will get the signature from the
-        # signature object, so don't worry about that here.
-        my $pirflags := $past.pirflags();
-        unless $pirflags { $pirflags := '' }
-        $past.pirflags($pirflags  ~ ' :multi()');
-    }
-
-    # Protos also need the proto property setting on them.
-    if $<sym> eq 'proto' {
-        $past.loadinit().push(
-            PAST::Op.new(
-                :inline('    setprop %0, "proto", %1'),
-                PAST::Var.new(
-                    :name('block'),
-                    :scope('register')
-                ),
-                1
-            )
-        );
+method multi_declarator($/) {
+    my $sym := ~$<sym>;
+    my $past;
+    if $( $<declarator> ) {
+        $past := $( $<declarator> );
     }
-
     make $past;
 }
 
@@ -2055,14 +2012,34 @@
     if $past.isa(PAST::Var) {
         my $scope := $sym eq 'my' ?? 'lexical' !! 'package';
         our $?BLOCK;
-        $?BLOCK.symbol( $past.name() , :scope($scope) );
+        my $symbol := $?BLOCK.symbol( $past.name() );
+        $symbol<scope> := $scope;
+        $past.viviself( $symbol<viviself> );
+        $past := PAST::Op.new( :pirop('setprop'), $past, 'type', $symbol<type>[0] );
     }
     make $past;
 }
 
 
 method scoped($/) {
-    my $past := $( $<declarator> );
+    my $past;
+    if $<declarator> {
+        $past := $( $<declarator> );
+    }
+    elsif $<multi_declarator> {
+        $past := $( $<multi_declarator> );
+        if $past.isa(PAST::Var) {
+            our $?BLOCK;
+            my $symbol := $?BLOCK.symbol( $past.name() );
+            my $type := $symbol<type>;
+            for @($<fulltypename>) {
+                $type.push( $( $_ ) );
+            }
+            $symbol<viviself> := PAST::Op.new( :pirop('new PsP'), 
+                                     'ObjectRef', 
+                                     $( $<fulltypename>[0] ) );
+        }
+    }
     make $past;
 }
 
@@ -2079,11 +2056,11 @@
 method variable_declarator($/) {
     my $past := $( $<variable> );
     $past.isdecl(1);
-    $past.viviself(
-        PAST::Op.new( :pirop('new Ps'),
-                      container_type($<variable><sigil>)
-        )
-    );
+    my $name     := $past.name();
+    my $type     := List.new();
+    my $viviself := container_type($<variable><sigil>);
+    our $?BLOCK;
+    $?BLOCK.symbol($name, :type($type), :viviself($viviself) );
     make $past;
 }
 
@@ -2196,6 +2173,40 @@
 }
 
 
+method typename($/) {
+    # Extract shortname part of identifier, if there is one.
+    my $ns := Perl6::Compiler.parse_name($<name>);
+    my $shortname := $ns.pop();
+
+    # determine type's scope
+    my $scope := '';
+    our @?BLOCK;
+    if +$ns == 0 && @?BLOCK {
+        for @?BLOCK {
+            if defined($_) && !$scope {
+                my $sym := $_.symbol($shortname);
+                if defined($sym) && $sym<scope> { $scope := $sym<scope>; }
+            }
+        }
+    }
+
+    # Create default PAST node for package lookup of type.
+    my $past := PAST::Var.new(
+        :name($shortname),
+        :namespace($ns),
+        :node($/),
+        :scope($scope ?? $scope !! 'package'),
+    );
+
+    make $past;
+}
+
+
+method fulltypename($/) {
+    make $( $<typename> );
+}
+
+
 method number($/, $key) {
     make $( $/{$key} );
 }
@@ -2341,36 +2352,6 @@
 }
 
 
-method typename($/) {
-    # Extract shortname part of identifier, if there is one.
-    my $ns := Perl6::Compiler.parse_name($<name>);
-    my $shortname := $ns.pop();
-
-    # determine type's scope
-    my $scope := '';
-    our @?BLOCK;
-    if +$ns == 0 && @?BLOCK {
-        for @?BLOCK {
-            if defined($_) && !$scope {
-                my $sym := $_.symbol($shortname);
-                if defined($sym) && $sym<scope> { $scope := $sym<scope>; }
-            }
-        }
-    }
-
-    # Create default PAST node for package lookup of type.
-    my $past := PAST::Var.new(
-        :name($shortname),
-        :namespace($ns),
-        :node($/),
-        :scope($scope ?? $scope !! 'package'),
-        :viviself('Failure')
-    );
-
-    make $past;
-}
-
-
 method term($/, $key) {
     my $past;
     if $key eq 'noarg' {
@@ -2958,41 +2939,6 @@
 }
 
 
-# This takes an array of match objects of type constraints and builds a type
-# representation out of them.
-sub build_type($cons_pt) {
-    # Build the type constraints list for the variable.
-    my $num_types := 0;
-    my $type_cons := PAST::Op.new();
-    for $cons_pt {
-        $type_cons.push( $( $_<typename> ) );
-        $num_types := $num_types + 1;
-    }
-
-    # If there were none, it's Object.
-    if $num_types == 0 {
-        $type_cons.push(PAST::Var.new(
-            :name('Object'),
-            :scope('package')
-        ));
-        $num_types := 1;
-    }
-
-    # Now need to apply the type constraints. How many are there?
-    if $num_types == 1 {
-        # Just the first one.
-        $type_cons := $type_cons[0];
-    }
-    else {
-        # Many; make an and junction of types.
-        $type_cons.pasttype('call');
-        $type_cons.name('all');
-    }
-
-    $type_cons
-}
-
-
 # Takes a block and turns it into a sub.
 sub create_sub($/, $past) {
     $past.blocktype('declaration');

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 21:50:46 2008
@@ -355,10 +355,11 @@
 #### Subroutine and method definitions ####
 
 rule multi_declarator {
-    $<sym>=[multi|proto|only] 
-    [ <routine_declarator> {*}                   #= routine_declarator
-    | <routine_def> {*}                          #= routine_def
+    [
+    | $<sym>=[multi|proto|only] [ <declarator> || <routine_def> ]
+    | <declarator>
     ]
+    {*}
 }
 
 token routine_declarator {
@@ -367,9 +368,13 @@
     | $<sym>='submethod' <method_def> {*}        #= submethod
 }
 
+rule multisig {
+    ':'?'(' ~ ')' <signature>
+    {*}
+}
+
 rule routine_def {
-    <identifier>? <multisig>?
-    <trait>*
+    [ <deflongname> ]? [ <multisig> | <trait> ]*
     <block>
     {*}
 }
@@ -407,28 +412,25 @@
     {*}
 }
 
-rule multisig {
-    '(' <signature> ')'
+token sigterm {
+    ':(' ~ ')' <signature> {*}
 }
 
-token signature {
-    ( <parameter> <.ws> ( ',' <.ws> | ':' <.ws> | ';;' <.ws> | <?before ')' | '{'> ) )* <.ws>
-    {*}
-}
+rule param_sep { [','|':'|';'|';;'] }
 
-token sigterm {
-    ':(' 
-    {{
-        $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
-    }}
+token signature {
+    <.ws>
+    [
+    | <?before '-->' | ')' | ']' | '{' | ':'<!before ':' > >
+    | <parameter>
+    ]
+    [ <param_sep>
+        [
+        | <?before '-->' | ')' | ']' | '{' | ':'<!before ':' > >
+        | <parameter>
+        ]
+    ]*
+    <.ws>
     {*}
 }
 
@@ -445,7 +447,7 @@
 # commented out.
 rule type_constraint {
     [
-    | <typename>
+    | <fulltypename>
     | where <EXPR: 'm='> # XXX <EXPR(%chaining)>
     ]
 }
@@ -454,6 +456,11 @@
     where <EXPR: 'm='> # XXX <EXPR(%chaining)>
 }
 
+token param_var {
+    <sigil> <twigil>? <identifier>
+    {*}
+}
+
 token parameter {
     <type_constraint>*
     [
@@ -472,17 +479,6 @@
     '=' <EXPR: 'i='>
 }
 
-token param_var {
-    <sigil> <twigil>? <identifier>
-    {*}
-}
-
-
-#### Special variables ####
-
-token special_variable {
-    $<sym>=[ '$/' | '$!' | '$¢' ] <!before \w> {*}
-}
 
 #### Terms ####
 
@@ -545,6 +541,7 @@
 # XXX Note that 'self' here should be a term.
 token noun {
     | <fatarrow> {*}                             #= fatarrow
+    | <variable> {*}                             #= variable
     | <package_declarator> {*}                   #= package_declarator
     | <scope_declarator> {*}                     #= scope_declarator
     | <multi_declarator> {*}                     #= multi_declarator
@@ -553,7 +550,6 @@
     | <type_declarator> {*}                      #= type_declarator
     | <enum_declarator> {*}                      #= enum_declarator
     | <circumfix> {*}                            #= circumfix
-    | <variable> {*}                             #= variable
     | <statement_prefix> {*}                     #= statement_prefix
     | <dotty> {*}                                #= dotty
     | <value> {*}                                #= value
@@ -633,8 +629,6 @@
     ]
 }
 
-
-
 rule scope_declarator {
     $<sym>=[my|our|state|constant|has]
     <scoped>
@@ -690,6 +684,10 @@
     ]
 }
 
+token special_variable {
+    $<sym>=[ '$/' | '$!' | '$¢' ] <!before \w> {*}
+}
+
 token circumfix {
     | '(' <statementlist> ')' {*}                #= ( )
     | '[' <statementlist> ']' {*}                #= [ ]
@@ -715,6 +713,18 @@
     | <number> {*}                               #= number
 }
 
+token typename {
+    <?before <.upper> | '::' > <name>
+    {*}
+}
+
+rule fulltypename {
+    <typename>
+#   [ of <fulltypename> ]?
+    {*}
+}
+
+
 ##  Quoting is tricky -- the <quote_concat> subrule is in
 ##  F<src/parser/quote_expression.pir> .
 token quote {
@@ -800,17 +810,6 @@
     {*}
 }
 
-rule fulltypename {
-    <typename>
-#   [ of <fulltypename> ]?
-    {*}
-}
-
-token typename {
-    <?before <.upper> | '::' > <name>
-    {*}
-}
-
 # 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