Add variable support.

src/NQP/Actions.pm

@@ -2,7 +2,15 @@ class NQP::Actions is HLL::Actions;
 
 our @BLOCK := Q:PIR { %r = new ['ResizablePMCArray'] };
 
-method TOP($/) { make $<statementlist>.ast; }
+method TOP($/) { make $<comp_unit>.ast; }
+
+method comp_unit($/) {
+    my $past := $<statementlist>.ast;
+    my $BLOCK := @BLOCK.shift;
+    $BLOCK.push($past);
+    $BLOCK.node($/);
+    make $BLOCK;
+}
 
 method statementlist($/) {
     my $past := PAST::Stmts.new( :node($/) );
@@ -77,6 +85,27 @@ method statement_control:sym<unless>($/) {
 
 ## Terms
 
+method noun:sym<variable>($/) { make $<variable>.ast; }
+method noun:sym<scoped>($/) { make $<scoped>.ast; }
+
+method variable($/) {
+    make PAST::Var.new( :name(~$/) );
+}
+
+method scoped($/) {
+    my $past := $<variable>.ast;
+    my $name := $past.name;
+    if @BLOCK[0].symbol($name) {
+        $/.CURSOR.panic("Redeclaration of symbol ", $name);
+    }
+    my $scope := $<scope_declarator> eq 'our' ?? 'package' !! 'lexical';
+    $past.scope($scope);
+    $past.isdecl(1);
+    $past.viviself('Undef');
+    @BLOCK[0].symbol( $name, :scope($scope) );
+    make $past;
+}
+
 method term:sym<identifier>($/) {
     my $past := $<args>.ast;
     $past.name(~$<identifier>);

src/NQP/Grammar.pm

@@ -1,6 +1,9 @@
 grammar NQP::Grammar is HLL::Grammar;
 
-token TOP { 
+token TOP { <comp_unit> }
+
+token comp_unit { 
+    <.newpad>
     <statementlist> 
     [ $ || <.panic: 'Confused'> ] 
 }
@@ -68,6 +71,22 @@ token statement_control:sym<unless> {
 
 ## Terms
 
+token noun:sym<variable>         { <variable> }
+token noun:sym<scoped>           { <scoped> }
+
+token variable {
+    <sigil> <twigil>? <desigilname=ident>
+}
+
+token sigil { <[$@%&]> }
+
+token twigil { <[*]> }
+
+rule scoped {
+    $<scope_declarator>=[my|our]
+    <variable>
+}
+
 proto token term { <...> }
 
 token term:sym<identifier> {

src/Regex/Cursor.pir

@@ -57,6 +57,7 @@ for the Cursor if one hasn't been created yet.
   match_make:
     match = new ['Regex';'Match']
     setattribute self, '$!match', match
+    setattribute match, '$!cursor', self
     .local pmc target, from, to
     target = getattribute self, '$!target'
     setattribute match, '$!target', target

src/Regex/Match.pir

@@ -17,14 +17,25 @@ This file implements Match objects for the regex engine.
     load_bytecode 'P6object.pbc'
     .local pmc p6meta
     p6meta = new 'P6metaclass'
-    $P0 = p6meta.'new_class'('Regex::Match', 'parent'=>'Capture', 'attr'=>'$!target $!from $!to $!ast')
+    $P0 = p6meta.'new_class'('Regex::Match', 'parent'=>'Capture', 'attr'=>'$!cursor $!target $!from $!to $!ast')
     .return ()
 .end
 
 =head2 Methods
 
 =over 4
 
+=item CURSOR()
+
+Returns the Cursor associated with this match object.
+
+=cut
+
+.sub 'CURSOR' :method
+    $P0 = getattribute self, '$!cursor'
+    .return ($P0)
+.end
+
 =item from()
 
 Returns the offset in the target string of the beginning of the match.

t/nqp/09-var.t

@@ -0,0 +1,76 @@
+#!./parrot nqp.pbc
+
+# check variables
+
+say('1..13');
+
+my $o1 := 'ok 1'; print($o1); say(" # direct binding and scoping");
+
+my $o2; $o2 := 'ok 2'; print($o2); say(" # first scope and declare, then bind");
+
+my $o3 := 'ok 3';
+my $p3 := $o3;
+print($p3); say(" # bind to another variable");
+
+my $o4 := 'ok 4';
+my $p4 := $o4;
+$o4 := 'not ok 4';
+print($p4); say(" # rebind the original, the bound one does not change");
+
+my $r1 := 'not ok 5';
+my $r2 := 'ok 5';
+my $r3;
+$r3 := $r1;
+$r3 := $r2;
+print($r3); say(' # variables can be rebound');
+
+my $b1 := 'ok 7';
+
+{
+    my $b1 := 'ok 6';
+    print($b1); say(' # my scoping works inside a block');
+}
+
+print($b1); say(' # block does not stomp on out scope');
+
+my $b2 := 'ok 8';
+
+{
+    print($b2); say(' # variables scoped outside of block persists inside the block');
+}
+
+my $b3;
+{
+    my $b4 := 'ok 9';
+    $b3 := $b4;
+}
+print($b3); say(' # variable is bound to the value, not the symbol in the block');
+
+my $b5 := '';
+{
+    my $b5 := 'not ';
+}
+print($b5);say('ok 10 # $b5, defined inside block, does not exist outside');
+
+{
+    our $m1 := 'ok 11 ';
+}
+
+our $m1;
+unless $m1 {
+    print('not ');
+}
+say('ok 11 # our variables have package scope, exists outside of block');
+
+our $m2;
+$m2 := 'ok 12';
+{
+    print($m2); say(' # our variables exist inside blocks');
+}
+
+our $m3;
+$m3 := 'not ok 13';
+{
+    $m3 := 'ok 13';
+}
+print($m3); say(' # our variables written inside block keep their values outside');