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

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

From:
pmichaud
Date:
December 30, 2008 23:41
Subject:
[svn:parrot] r34690 - branches/rvar/languages/perl6/src/parser
Message ID:
20081231074119.C5FE0CB9FA@x12.develooper.com
Author: pmichaud
Date: Tue Dec 30 23:41:19 2008
New Revision: 34690

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

Log:
[rakudo]: STD.pm alignment -- eliminate role_def, package_block


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	Tue Dec 30 23:41:19 2008
@@ -1344,386 +1344,12 @@
 
 
 method package_declarator($/, $key) {
-    our $?CLASS;
-    our @?CLASS;
-    our $?GRAMMAR;
-    our @?GRAMMAR;
-    our $?MODULE;
-    our @?MODULE;
-    our $?PACKAGE;
-    our @?PACKAGE;
-    our $?ROLE;
-    our @?ROLE;
-
+    our @?PKGDECL;
     my $sym := $<sym>;
 
     if $key eq 'open' {
-        # Start of a new package. We create an empty PAST::Stmts node for the
-        # package definition to be stored in and put it onto the current stack
-        # of packages and the stack of its package type.
-        my $decl_past := PAST::Stmts.new();
-
-        if    $sym eq 'package' {
-            @?PACKAGE.unshift($decl_past);
-        }
-        ##  module isa package
-        elsif $sym eq 'module' {
-            @?MODULE.unshift($decl_past);
-            @?PACKAGE.unshift($decl_past);
-        }
-        ##  role isa module isa package
-        elsif $sym eq 'role' {
-            @?ROLE.unshift($decl_past);
-            @?MODULE.unshift($decl_past);
-            @?PACKAGE.unshift($decl_past);
-        }
-        ##  class isa module isa package
-        elsif $sym eq 'class' {
-            @?CLASS.unshift($decl_past);
-            @?MODULE.unshift($decl_past);
-            @?PACKAGE.unshift($decl_past);
-        }
-        ##  grammar isa class isa module isa package
-        elsif $sym eq 'grammar' {
-            @?GRAMMAR.unshift($decl_past);
-            @?CLASS.unshift($decl_past);
-            @?MODULE.unshift($decl_past);
-            @?PACKAGE.unshift($decl_past);
-        }
-    }
-    else {
-        # End of declaration. Our PAST will be that made by the package_def or
-        # role_def.
-        my $past := $( $/{$key} );
-
-        # Set $?PACKAGE at the start of it.
-        $past.unshift(set_package_magical());
-
-        # Restore outer values in @?<magical> arrays
-        if    $sym eq 'package' {
-            @?PACKAGE.shift();
-        }
-        ##  module isa package
-        elsif $sym eq 'module' {
-            @?MODULE.shift();
-            @?PACKAGE.shift();
-        }
-        ##  role isa module isa package
-        elsif $sym eq 'role' {
-            @?ROLE.shift();
-            @?MODULE.shift();
-            @?PACKAGE.shift();
-        }
-        ##  class isa module isa package
-        elsif $sym eq 'class' {
-            @?CLASS.shift();
-            @?MODULE.shift();
-            @?PACKAGE.shift();
-        }
-        ##  grammar isa class isa module isa package
-        elsif $sym eq 'grammar' {
-            @?GRAMMAR.shift();
-            @?CLASS.shift();
-            @?MODULE.shift();
-            @?PACKAGE.shift();
-        }
-        make $past;
+        @?PKGDECL.push( $sym );
     }
-
-    # make sure @?<magical>[0] is always the same as $?<magical>
-    $?CLASS   := @?CLASS[0];
-    $?GRAMMAR := @?GRAMMAR[0];
-    $?MODULE  := @?MODULE[0];
-    $?PACKAGE := @?PACKAGE[0];
-    $?ROLE    := @?ROLE[0];
-}
-
-
-method package_def($/, $key) {
-    our $?CLASS;
-    our $?GRAMMAR;
-    our $?MODULE;
-    our $?NS;
-    our $?PACKAGE;
-    my $name := $<name>;
-
-    if $key eq 'open' {
-        # Start of package definition. Handle class and grammar specially.
-        if $?PACKAGE =:= $?GRAMMAR {
-            # Anonymous grammars not supported.
-            unless $name {
-                $/.panic('Anonymous grammars not supported');
-            }
-
-            # Start of grammar definition. Create grammar class object.
-            $?GRAMMAR.push(
-                PAST::Op.new(
-                    :pasttype('bind'),
-                    PAST::Var.new(
-                        :name('def'),
-                        :scope('register'),
-                        :isdecl(1)
-                    ),
-                    PAST::Op.new(
-                        :pasttype('call'),
-                        :name('!keyword_grammar'),
-                        PAST::Val.new( :value(~$name[0]) )
-                    )
-                )
-            );
-        }
-        elsif $?PACKAGE =:= $?CLASS {
-            my $class_def;
-
-            if !have_trait('also', 'is', $<trait>) {
-                # Start of class definition; make PAST to create class object if
-                # we're creating a new class.
-                $class_def := PAST::Op.new(
-                    :pasttype('bind'),
-                    PAST::Var.new(
-                        :name('def'),
-                        :scope('register'),
-                        :isdecl(1)
-                    ),
-                    PAST::Op.new(
-                        :pasttype('call'),
-                        :name('!keyword_class')
-                    )
-                );
-
-                # Add a name, if we have one.
-                if $name {
-                    $class_def[1].push( PAST::Val.new( :value(~$name[0]) ) );
-                }
-            }
-            else {
-                # We're adding to an existing class. Look up class by name and put
-                # it in $def.
-                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'),
-                    PAST::Var.new(
-                        :name('def'),
-                        :scope('register'),
-                        :isdecl(1)
-                    ),
-                    PAST::Op.new(
-                        :pasttype('callmethod'),
-                        :name('get_parrotclass'),
-                        PAST::Var.new(
-                            :scope('package'),
-                            :name('$!P6META'),
-                            :namespace('Perl6Object')
-                        ),
-                        PAST::Var.new(
-                            :name($short_name),
-                            :namespace(@namespace),
-                            :scope('package')
-                        )
-                    )
-                );
-            }
-
-            $?CLASS.push($class_def);
-        }
-        else {
-            # Anonymous modules not supported.
-            unless $name {
-                $/.panic('Anonymous modules not supported');
-            }
-        }
-
-        # Also store the current namespace, if we're not anonymous.
-        if $name {
-            $?NS := ~$name[0];
-        }
-    }
-    else {
-        # XXX For now, to work around the :load :init not being allowed to be
-        # an outer bug, we will enclose the actual package block inside an
-        # immediate block of its own.
-        my $inner_block := $( $<package_block> );
-        $inner_block.blocktype('immediate');
-        my $past := PAST::Block.new(
-            $inner_block
-        );
-
-        # Declare the namespace and that the result block holds things that we
-        # do "on load".
-        if $name {
-            $past.namespace(Perl6::Compiler.parse_name($<name>[0]));
-        }
-        $past.blocktype('declaration');
-        $past.pirflags(':init :load');
-
-        if $?PACKAGE =:= $?GRAMMAR {
-            # Apply traits.
-            apply_package_traits($?GRAMMAR, $<trait>);
-
-            # Make proto-object for grammar.
-            $?GRAMMAR.push(
-                PAST::Op.new(
-                    :pasttype('call'),
-                    :name('!PROTOINIT'),
-                    PAST::Op.new(
-                        :pasttype('callmethod'),
-                        :name('register'),
-                        PAST::Var.new(
-                            :scope('package'),
-                            :name('$!P6META'),
-                            :namespace('Perl6Object')
-                        ),
-                        PAST::Var.new(
-                            :scope('register'),
-                            :name('def')
-                        ),
-                        PAST::Val.new(
-                            :value('Grammar'),
-                            :named( PAST::Val.new( :value('parent') ) )
-                        )
-                    )
-                )
-            );
-
-            # Attatch grammar declaration to the init code.
-            our @?BLOCK;
-            @?BLOCK[0].loadinit().push( $?GRAMMAR );
-
-            # Clear namespace.
-            $?NS := '';
-        }
-        elsif $?PACKAGE =:= $?CLASS {
-            # Apply traits.
-            apply_package_traits($?CLASS, $<trait>);
-
-            # Check if we have the is also trait - don't re-create
-            # proto-object if so.
-            if !have_trait('also', 'is', $<trait>) {
-                # It's a new class definition. Make proto-object.
-                $?CLASS.push(
-                    PAST::Op.new(
-                        :pasttype('call'),
-                        :name('!PROTOINIT'),
-                        PAST::Op.new(
-                            :pasttype('callmethod'),
-                            :name('register'),
-                            PAST::Var.new(
-                                :scope('package'),
-                                :name('$!P6META'),
-                                :namespace('Perl6Object')
-                            ),
-                            PAST::Var.new(
-                                :scope('register'),
-                                :name('def')
-                            ),
-                            PAST::Val.new(
-                                :value('Any'),
-                                :named( PAST::Val.new( :value('parent') ) )
-                            )
-                        )
-                    )
-                );
-
-                # If this is an anonymous class, the block doesn't want to be a
-                # :init :load, and it's going to contain the class definition, so
-                # we need to declare the lexical $def.
-                unless $name {
-                    $past.pirflags('');
-                    $past.blocktype('immediate');
-                    $past[0].push(PAST::Var.new(
-                        :name('def'),
-                        :scope('register'),
-                        :isdecl(1)
-                    ));
-                }
-            }
-
-            # Attatch any class initialization code to the init code;
-            # note that we skip blocks, which are method accessors that
-            # we want to put under this block so they get the correct
-            # namespace. If it's an anonymous class, everything goes into
-            # this block.
-            for @( $?CLASS ) {
-                if $_.isa(PAST::Block) || !$name {
-                    $past[0].push( $_ );
-                }
-                else {
-                    our @?BLOCK;
-                    @?BLOCK[0].loadinit().push( $_ );
-                }
-            }
-        }
-
-        make $past;
-    }
-}
-
-
-method role_def($/, $key) {
-    our $?ROLE;
-    our $?NS;
-    my $name := ~$<name>;
-
-    if $key eq 'open' {
-        # Start of role definition. Push on code to create a role object.
-        $?ROLE.push(
-            PAST::Op.new(
-                :pasttype('bind'),
-                PAST::Var.new(
-                    :name('def'),
-                    :scope('register'),
-                    :isdecl(1)
-                ),
-                PAST::Op.new(
-                    :pasttype('call'),
-                    :name('!keyword_role'),
-                    PAST::Val.new( :value($name) )
-                )
-            )
-        );
-
-        # Also store the current namespace.
-        $?NS := $name;
-    }
-    else {
-        # Declare the namespace and that the result block holds things that we
-        # do "on load".
-        my $past := $( $<package_block> );
-        $past.namespace( PAST::Compiler.parse_name($name) );
-        $past.blocktype('declaration');
-        $past.pirflags(':init :load');
-
-        # Apply traits.
-        apply_package_traits($?ROLE, $<trait>);
-
-        # Attatch role declaration to the init code, skipping blocks since
-        # those are accessors.
-        for @( $?ROLE ) {
-            if $_.isa(PAST::Block) {
-                $past.push( $_ );
-            }
-            else {
-                our @?BLOCK;
-                @?BLOCK[0].loadinit().push( $_ );
-            }
-        }
-
-        # Clear namespace.
-        $?NS := '';
-
-        make $past;
-    }
-}
-
-
-method package_block($/, $key) {
-    my $past := $( $/{$key} );
-    make $past;
 }
 
 

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	Tue Dec 30 23:41:19 2008
@@ -604,34 +604,24 @@
 }
 
 rule package_declarator {
-    [
-    | $<sym>=[class|grammar|module|package] {*}  #= open
-      <package_def> {*}                          #= package_def
-    | $<sym>=[role] {*}                          #= open
-      <role_def> {*}                             #= role_def
-    ]
+    $<sym>=[class|grammar|module|package|role] {*}       #= open
+    <package_def> {*}                                    #= package_def
 }
 
 
 rule package_def {
-    <name>? <trait>* {*}                         #= open
-    <package_block> {*}                          #= close
-}
-
-
-rule role_def {
-    <name>['['<signature>']']? <trait>* {*}      #= open
-    <package_block> {*}                          #= close
-}
-
-
-rule package_block {
     [
-    || ';' <statement_block> {*}                 #= statement_block
-    || <block> {*}                               #= block
+        <module_name=name>
+    ]? 
+    <trait>*
+    [
+    | ';' <statement_block>
+    | <block>
     ]
+    {*}
 }
 
+
 rule enum_declarator {
     'enum' <name>?
     [



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