correctly autogen prefix and postfix hypers too

rakudo · Oct 30, 2015 · 74ff317 · 74ff317
1 parent c34e750
commit 74ff317
Show file tree

Hide file tree

Showing 3 changed files with 25 additions and 12 deletions.
diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp
@@ -6219,11 +6219,13 @@ Compilation unit '$file' contained the following violations:
 
     method prefixish($/) {
         if $<prefix_postfix_meta_operator> {
-            make QAST::Op.new( :node($/),
+            make QAST::Op.new( :node($/), :op<call>,
+                QAST::Op.new( :node($/),
                      :name<&METAOP_HYPER_PREFIX>,
                      :op<call>,
                      QAST::Var.new( :name('&prefix:' ~ $*W.canonicalize_opname($<OPER>.Str)),
-                                    :scope<lexical> ));
+                                    :scope<lexical> ))
+            );
         }
     }
 
@@ -6371,7 +6373,7 @@ Compilation unit '$file' contained the following violations:
                                     ?? QAST::Var.new( :name($past.name), :scope<lexical>)
                                     !! $past[0];
                     $past.push($basepast);
-                    $past.name('&METAOP_HYPER_POSTFIX');
+                    $past.name('&METAOP_HYPER_POSTFIX_ARGS');
                 }
             }
             make $past;

diff --git a/src/Perl6/Grammar.nqp b/src/Perl6/Grammar.nqp
@@ -367,7 +367,10 @@ role STD {
                             $match<postfix_prefix_meta_operator> ||
                             $match<op>)
                         {
-                            my $META := $match.ast[0];
+                            my $META := $match.ast;
+                            $META := $META[0] unless $META.name;
+                            $META.name('&METAOP_HYPER_POSTFIX') if $META.name eq '&METAOP_HYPER_POSTFIX_ARGS';
+                            # nqp::printfh(nqp::getstderr(), $META.dump);
                             my $fun := $*W.compile_time_evaluate($var,$META);
                             $*W.install_lexical_symbol($*W.cur_lexpad(),$name,$fun);
                         }

diff --git a/src/core/metaops.pm b/src/core/metaops.pm
@@ -394,26 +394,34 @@ sub METAOP_HYPER(\op, *%opt) {
 }
 
 proto sub METAOP_HYPER_POSTFIX(|) {*}
-multi sub METAOP_HYPER_POSTFIX(\obj, \op) {
-    op.?nodal      # rarely true for prefixes
+multi sub METAOP_HYPER_POSTFIX(\op) {
+    op.?nodal
+        ?? (-> \obj { nodemap(op, obj) })
+        !! (-> \obj { deepmap(op, obj) })
+}
+
+# no indirection for subscripts and such
+proto sub METAOP_HYPER_POSTFIX_ARGS(|) {*}
+multi sub METAOP_HYPER_POSTFIX_ARGS(\obj,\op) {
+    op.?nodal
         ?? nodemap(op, obj)
-        !! deepmap(op, obj);
+        !! deepmap(op, obj)
 }
-multi sub METAOP_HYPER_POSTFIX(\obj, @args, \op) {
+multi sub METAOP_HYPER_POSTFIX_ARGS(\obj, @args, \op) {
     op.?nodal
         ?? nodemap( -> \o { op.(o,@args) }, obj )
         !! deepmap( -> \o { op.(o,@args) }, obj );
 }
-multi sub METAOP_HYPER_POSTFIX(\obj, \args, \op) {
+multi sub METAOP_HYPER_POSTFIX_ARGS(\obj, \args, \op) {
     op.?nodal
         ?? nodemap( -> \o { op.(o,|args) }, obj )
         !! deepmap( -> \o { op.(o,|args) }, obj );
 }
 
-sub METAOP_HYPER_PREFIX(\op, \obj) {
+sub METAOP_HYPER_PREFIX(\op) {
     op.?nodal      # rarely true for prefixes
-        ?? nodemap(op, obj)
-        !! deepmap(op, obj);
+        ?? (-> \obj { nodemap(op, obj) })
+        !! (-> \obj { deepmap(op, obj) })
 }
 
 sub METAOP_HYPER_CALL(\list, |args) { deepmap(-> $c { $c(|args) }, list) }