Fixup handling of (top level) globals, ala $::tcl_library.

(gets us slightly further with library/init.tcl)
partcl · Aug 24, 2010 · fa21fc2 · fa21fc2
1 parent 3f60ff6
commit fa21fc2
Show file tree

Hide file tree

Showing 2 changed files with 16 additions and 12 deletions.
diff --git a/src/Partcl/Actions.pm b/src/Partcl/Actions.pm
@@ -174,13 +174,21 @@ sub concat_atoms(@atoms) {
 ##  the corresponding value.
 
 method variable:sym<normal>($/) {
-    if $<key> {
-        # Array access
-        my $variable := PAST::Var.new( :scope<keyed>,
-            PAST::Var.new( :name<lexpad>, :scope<register> ),
-            ~$<identifier>
-        );
+    my $variable;
+    if $<global> {
+       $variable := PAST::Var.new( :scope<keyed>,
+           PAST::Var.new( :name<%GLOBALS>, :scope<package> ),
+           ~$<identifier>
+       );
+    } else {
+       $variable := PAST::Var.new( :scope<keyed>,
+           PAST::Var.new( :name<lexpad>, :scope<register> ),
+           ~$<identifier>
+       );
+    }
 
+    # Array access
+    if $<key> {
         make PAST::Op.new( :pasttype<if>,
             PAST::Op.new( :pirop<iseq__iss>,
                 PAST::Op.new(  :pirop<typeof__sP>, $variable),
@@ -197,10 +205,6 @@ method variable:sym<normal>($/) {
     }
     else {
         # Scalar
-        my $variable := PAST::Var.new( :scope<keyed>,
-            PAST::Var.new( :name<lexpad>, :scope<register> ),
-            ~$<identifier>
-        );
 
         make PAST::Op.new( :pasttype<unless>,
             PAST::Op.new( :pirop<isnull>, $variable),

diff --git a/src/Partcl/Grammar.pm b/src/Partcl/Grammar.pm
@@ -93,11 +93,11 @@ token list_atom:sym<\\>  { <backslash> }
 token list_atom:sym<chr> { <-[ \\ ]-space>+ }
 
 token colons { ':' ':'+ }
-token identifier { <.colons>? <ident> ** <.colons> }
+token identifier { <ident> ** <.colons> }
 
 proto token variable { <...> }
 # XXX The key here is wrong. It needs to do variable interpolation, and more.
-token variable:sym<normal>  { '$' <identifier> [ '(' $<key>=(<-[)]>+) ')' ]? }
+token variable:sym<normal>  { '$' $<global>=<.colons>? <identifier> [ '(' $<key>=(<-[)]>+) ')' ]? }
 token variable:sym<escaped> { '$' '{' $<identifier>=(<-[ } ]>*) '}' }
 
 rule integer { $<sign>=(<[+\-]>?)<int> }