From fa21fc2fc223fa8b0f1c8cc747718af687cec6ce Mon Sep 17 00:00:00 2001
From: Coke <will@coleda.com>
Date: Mon, 23 Aug 2010 23:14:05 -0400
Subject: [PATCH] Fixup handling of (top level) globals, ala $::tcl_library.
 (gets us slightly further with library/init.tcl)

---
 src/Partcl/Actions.pm | 24 ++++++++++++++----------
 src/Partcl/Grammar.pm |  4 ++--
 2 files changed, 16 insertions(+), 12 deletions(-)

diff --git a/src/Partcl/Actions.pm b/src/Partcl/Actions.pm
index b20fa7d..bf0cadd 100644
--- 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
index 282e9d4..d4b8071 100644
--- 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> }