Remove Q::Statement::My in favor of Q::Term::My

See #279 for reasons. In the end this was a smaller change than I feared it would be. Having made it, I'm also more convinced (despite initial misgivings) that it's a simpler model. (In particular, it used to be that assignment semantics resided "inside" the `my` statement semantics. Now it's all on the outside. The `my` term, at runtime, is completely transparent and behaves exactly like the identifier it declares.) It also doesn't hurt that this simpler model is also somewhat richer than the old one. :) Closes #279.
masak · Aug 3, 2018 · 7811d95 · 7811d95
1 parent 86a55b2
commit 7811d95
Show file tree

Hide file tree

Showing 9 changed files with 82 additions and 92 deletions.
diff --git a/lib/_007/Backend/JavaScript.pm6 b/lib/_007/Backend/JavaScript.pm6
@@ -48,20 +48,25 @@ class _007::Backend::JavaScript {
                 @main.push("say({@arguments.join(", ")});");
             }
 
-            die "Cannot handle this type of Q::Statement::Expr yet!";
-        }
+            when $expr ~~ Q::Term::My {
+                my $name = $expr.identifier.name.value;
+                @main.push("let {$name};");
+            }
+
+            when $expr ~~ Q::Infix::Assignment
+                && $expr.lhs ~~ Q::Term::My {
+
+                my $lhs = $expr.lhs;
+                my $name = $lhs.identifier.name.value;
+                my $rhs = $expr.rhs;
 
-        multi emit-stmt(Q::Statement::My $stmt) {
-            my $name = $stmt.identifier.name.value;
-            if $stmt.expr !~~ NONE {
                 die "Cannot handle non-literal-Int rhs just yet!"
-                        unless $stmt.expr ~~ Q::Literal::Int;
-                my $expr = $stmt.expr.value.Str;
-                @main.push("let {$name} = {$expr};");
-            }
-            else {
-                @main.push("let {$name};");
+                        unless $rhs ~~ Q::Literal::Int;
+                my $int = $rhs.value.Str;
+                @main.push("let {$name} = {$int};");
             }
+
+            die "Cannot handle this type of Q::Statement::Expr yet!";
         }
     }
 }
diff --git a/lib/_007/Linter.pm6 b/lib/_007/Linter.pm6
@@ -118,34 +118,31 @@ class _007::Linter {
             multi traverse(Q::Term $term) {
             }
 
-            multi traverse(Q::Statement::For $for) {
-                traverse($for.expr);
-                traverse($for.block);
-            }
-
-            multi traverse(Q::Statement::My $my) {
+            multi traverse(Q::Term::My $my) {
                 my $name = $my.identifier.name;
                 my $ref = "{@blocks[*-1].WHICH.Str}|$name";
                 %declared{$ref} = L::VariableNotUsed;
-                if $my.expr !~~ NONE {
-                    traverse($my.expr);
-                    %assigned{$ref} = True;
-                    if $my.expr ~~ Q::Identifier && $my.expr.name eq $name {
-                        @complaints.push: L::RedundantAssignment.new(:$name);
-                        %readbeforeassigned{$ref} :delete;
-                    }
-                }
+            }
+
+            multi traverse(Q::Statement::For $for) {
+                traverse($for.expr);
+                traverse($for.block);
             }
 
             multi traverse(Q::Infix::Assignment $infix) {
                 traverse($infix.rhs);
+                my $lhs = $infix.lhs;
+                if $lhs ~~ Q::Term::My {
+                    $lhs = $lhs.identifier;
+                }
                 die "LHS was not an identifier"
-                    unless $infix.lhs ~~ Q::Identifier;
-                my $name = $infix.lhs.name.value;
+                    unless $lhs ~~ Q::Identifier;
+                my $name = $lhs.name.value;
                 if $infix.rhs ~~ Q::Identifier && $infix.rhs.name eq $name {
                     @complaints.push: L::RedundantAssignment.new(:$name);
                 }
                 %assigned{ref $name} = True;
+                traverse($infix.lhs);
             }
 
             multi traverse(Q::Infix::Addition $infix) {

diff --git a/lib/_007/Parser/Actions.pm6 b/lib/_007/Parser/Actions.pm6
@@ -77,17 +77,6 @@ class _007::Parser::Actions {
         make Q::StatementList.new(:statements(Val::Array.new(:elements($<statement>».ast))));
     }
 
-    method statement:my ($/) {
-        my $identifier = $<identifier>.ast;
-        my $name = $identifier.name;
-
-        make Q::Statement::My.new(
-            :identifier($identifier),
-            :expr($<EXPR> ?? $<EXPR>.ast !! NONE));
-
-        $*parser.opscope.maybe-install($name, []);
-    }
-
     method statement:expr ($/) {
         # XXX: this is a special case for macros that have been expanded at the
         #      top level of an expression statement, but it could happen anywhere
@@ -234,10 +223,6 @@ class _007::Parser::Actions {
     sub expand($macro, @arguments, &unexpanded-callback:()) {
         my $expansion = $*runtime.call($macro, @arguments);
 
-        if $expansion ~~ Q::Statement::My {
-            _007::Parser::Syntax::declare(Q::Statement::My, $expansion.identifier.name.value);
-        }
-
         if $*unexpanded {
             return &unexpanded-callback();
         }
@@ -663,6 +648,15 @@ class _007::Parser::Actions {
             :propertylist($<propertylist>.ast));
     }
 
+    method term:my ($/) {
+        my $identifier = $<identifier>.ast;
+        my $name = $identifier.name;
+
+        make Q::Term::My.new(:identifier($identifier));
+
+        $*parser.opscope.maybe-install($name, []);
+    }
+
     method propertylist ($/) {
         my %seen;
         for $<property>».ast -> Q::Property $p {
@@ -783,10 +777,9 @@ sub check(Q::Block $ast, $runtime) is export {
     # a bunch of nodes we don't care about descending into
     multi handle(Q::ParameterList $) {}
     multi handle(Q::Statement::Return $) {}
-    multi handle(Q::Statement::Expr $) {}
     multi handle(Q::Statement::BEGIN $) {}
     multi handle(Q::Literal $) {}
-    multi handle(Q::Term $) {} # except Q::Term::Object, see below
+    multi handle(Q::Term $) {} # with two exceptions, see below
     multi handle(Q::Postfix $) {}
 
     multi handle(Q::StatementList $statementlist) {
@@ -795,27 +788,17 @@ sub check(Q::Block $ast, $runtime) is export {
         }
     }
 
-    multi handle(Q::Statement::My $my) {
-        my $symbol = $my.identifier.name.value;
-        my $block = $runtime.current-frame();
-        die X::Redeclaration.new(:$symbol)
-            if $runtime.declared-locally($symbol);
-        die X::Redeclaration::Outer.new(:$symbol)
-            if %*assigned{$block ~ $symbol};
-        $runtime.declare-var($my.identifier);
-
-        if $my.expr !~~ Val::NoneType {
-            handle($my.expr);
-        }
-    }
-
     multi handle(Q::Statement::Block $block) {
         $runtime.enter($runtime.current-frame, $block.block.static-lexpad, $block.block.statementlist);
         handle($block.block.statementlist);
         $block.block.static-lexpad = $runtime.current-frame.properties<pad>;
         $runtime.leave();
     }
 
+    multi handle(Q::Statement::Expr $expr) {
+        handle($expr.expr);
+    }
+
     multi handle(Q::Statement::Func $func) {
         my $outer-frame = $runtime.current-frame;
         my $name = $func.identifier.name;
@@ -870,6 +853,16 @@ sub check(Q::Block $ast, $runtime) is export {
         handle($object.propertylist);
     }
 
+    multi handle(Q::Term::My $my) {
+        my $symbol = $my.identifier.name.value;
+        my $block = $runtime.current-frame();
+        die X::Redeclaration.new(:$symbol)
+            if $runtime.declared-locally($symbol);
+        die X::Redeclaration::Outer.new(:$symbol)
+            if %*assigned{$block ~ $symbol};
+        $runtime.declare-var($my.identifier);
+    }
+
     multi handle(Q::PropertyList $propertylist) {
         my %seen;
         for $propertylist.properties.elements -> Q::Property $p {
@@ -878,4 +871,9 @@ sub check(Q::Block $ast, $runtime) is export {
                 if %seen{$property}++;
         }
     }
+
+    multi handle(Q::Infix $infix) {
+        handle($infix.lhs);
+        handle($infix.rhs);
+    }
 }
diff --git a/lib/_007/Parser/Syntax.pm6 b/lib/_007/Parser/Syntax.pm6
@@ -49,11 +49,6 @@ grammar _007::Parser::Syntax {
     }
 
     proto token statement {*}
-    rule statement:my {
-        my [<identifier> || <.panic("identifier")>]
-        { declare(Q::Statement::My, $<identifier>.ast.name.value); }
-        ['=' <EXPR>]?
-    }
     token statement:expr {
         <!before <!before '{{{'> '{'>   # } }}}, you're welcome vim
         <EXPR>
@@ -264,6 +259,11 @@ grammar _007::Parser::Syntax {
         <blockoid>:!s
         <.finishpad>
     }
+    token term:my {
+        my» <.ws> [<identifier> || <.panic("identifier")>]
+        { declare(Q::Term::My, $<identifier>.ast.name.value); }
+    }
+
 
     token propertylist { [<.ws> <property>]* %% [\h* ','] <.ws> }
 

diff --git a/lib/_007/Q.pm6 b/lib/_007/Q.pm6
@@ -892,22 +892,20 @@ class Q::ArgumentList does Q {
 role Q::Statement does Q {
 }
 
-### ### Q::Statement::My
+### ### Q::Term::My
 ###
-### A `my` variable declaration statement.
+### A `my` variable declaration.
 ###
-class Q::Statement::My does Q::Statement does Q::Declaration {
+class Q::Term::My does Q::Term does Q::Declaration {
     has $.identifier;
-    has $.expr = NONE;
-
-    method attribute-order { <identifier expr> }
 
     method is-assignable { True }
 
-    method run($runtime) {
-        return
-            unless $.expr !~~ Val::NoneType;
-        my $value = $.expr.eval($runtime);
+    method eval($runtime) {
+        return $.identifier.eval($runtime);
+    }
+
+    method put-value($value, $runtime) {
         $.identifier.put-value($value, $runtime);
     }
 }

diff --git a/lib/_007/Val.pm6 b/lib/_007/Val.pm6
@@ -37,13 +37,11 @@ role Val {
 ###     say(noreturn());    # --> `None`
 ###
 ### Finally, it's found in various places in the Q hierarchy to indicate that
-### a certain child element is not present. For example, a `my` declaration
-### can have an assignment attached to it, in which case its `expr` property
-### is a `Q::Expr` &mdash; but if no assignment is present, the `expr`
-### property is the value `None`.
+### a certain child element is not present. For example, an `if` statement
+### doesn't always have an `else` statement. When it doesn't, the `.else`
+### property is set to `None`.
 ###
-###     say(type((quasi @ Q::Statement { my x = 2 }).expr)); # --> `<type Q::Literal::Int>`
-###     say(type((quasi @ Q::Statement { my x; }).expr));    # --> `<type NoneType>`
+###     say(type((quasi @ Q::Statement { if 1 {} }).else)); # --> `<type NoneType>`
 ###
 ### The value `None` is falsy, stringifies to `None`, and doesn't numify.
 ###

diff --git a/t/features/q.t b/t/features/q.t
@@ -2,18 +2,6 @@ use v6;
 use Test;
 use _007::Test;
 
-{
-    my $program = q:to/./;
-        my q = new Q::Statement::My { identifier: new Q::Identifier { name: "foo" } };
-        say(q.expr);
-        .
-
-    outputs
-        $program,
-        "None\n",
-        "Q::Statement::My can be constructed without an 'expr' property (#84)";
-}
-
 {
     my $program = q:to/./;
         my q = new Q::Statement::Return {};

diff --git a/t/linter/variable-declaration-assignment.t b/t/linter/variable-declaration-assignment.t
@@ -36,7 +36,7 @@ use _007::Linter;
 {
     my $program = 'my x = x';
     my @complaints = _007.linter.lint($program);
-    ok @complaints ~~ [L::RedundantAssignment], "assigning to self in declaration is redundant";
+    ok @complaints ~~ [L::RedundantAssignment, L::VariableReadBeforeAssigned], "assigning to self in declaration is redundant";
 }
 
 {

diff --git a/t/linter/variable-not-used.t b/t/linter/variable-not-used.t
@@ -9,6 +9,12 @@ use _007::Linter;
     ok @complaints ~~ [L::VariableNotUsed], "variable not used";
 }
 
+{
+    my $program = 'my x = 7';
+    my @complaints = _007.linter.lint($program);
+    ok @complaints ~~ [L::VariableNotUsed], "variable assigned but not used";
+}
+
 {
     my $program = 'my x = 7; say(x)';
     my @complaints = _007.linter.lint($program);