[WIP] Change from traits to decorators

examples/ff.007

@@ -1,4 +1,5 @@
-macro infix:<ff>(lhs, rhs) is tighter(infix:<=>) {
+@tighter(infix:<=>)
+macro infix:<ff>(lhs, rhs) {
     my active = false;
     return quasi {
         if {{{lhs}}} {
@@ -24,7 +25,8 @@ for values -> v {
 
 say("");
 
-macro infix:<fff>(lhs, rhs) is equiv(infix:<ff>) {
+@equiv(infix:<ff>)
+macro infix:<fff>(lhs, rhs) {
     my active = false;
     return quasi {
         my result = active;

examples/nim-addition.007

@@ -22,7 +22,8 @@ func binfmt(number) {
     return result || "0";
 }
 
-func infix:<⊕>(lhs, rhs) is equiv(infix:<+>) {
+@equiv(infix:<+>)
+func infix:<⊕>(lhs, rhs) {
     my lb = binfmt(lhs);
     my rb = binfmt(rhs);
     lb = padLeft(lb, rb.chars(), "0");

examples/power.007

@@ -1,4 +1,6 @@
-func infix:<**>(x, n) is tighter(infix:<*>) is assoc("right") {
+@tighter(infix:<*>)
+@assoc("right")
+func infix:<**>(x, n) {
     if n == 0 {
         return 1;
     }

examples/x-and-xx.007

@@ -1,10 +1,12 @@
-macro infix:<xx>(left, right) is tighter(infix:<~>) {
+@tighter(infix:<~>)
+macro infix:<xx>(left, right) {
     return quasi {
         (^{{{right}}}).flatMap(func(_) { {{{left}}} })
     }
 }
 
-func infix:<x>(left, right) is equiv(infix:<xx>) {
+@equiv(infix:<xx>)
+func infix:<x>(left, right) {
     return (left xx right).join("");
 }
 

lib/_007/Builtins.pm6

@@ -74,6 +74,10 @@ my @builtins =
         assert-type(:value($type), :type(Val::Type), :operation("assertType (checking the Type parameter)"));
         assert-type(:$value, :type($type.type), :operation<assertType>);
     },
+    tighter => -> $fn, $op { $fn },
+    looser => -> $fn, $op { $fn },
+    equiv => -> $fn, $op { $fn },
+    assoc => -> $fn, $direction { $fn },
 
     # OPERATORS (from loosest to tightest within each category)
 

lib/_007/OpScope.pm6

@@ -2,18 +2,18 @@ use _007::Val;
 use _007::Q;
 use _007::Precedence;
 
-class X::Trait::IllegalValue is Exception {
-    has Str $.trait;
+class X::Decorator::IllegalValue is Exception {
+    has Str $.decorator;
     has Str $.value;
 
-    method message { "The value '$.value' is not compatible with the trait '$.trait'" }
+    method message { "The value '$.value' is not compatible with the trait '$.decorator'" }
 }
 
-class X::Trait::Conflict is Exception {
-    has Str $.trait1;
-    has Str $.trait2;
+class X::Decorator::Conflict is Exception {
+    has Str $.decorator1;
+    has Str $.decorator2;
 
-    method message { "Traits '$.trait1' and '$.trait2' cannot coexist on the same routine" }
+    method message { "Decorators '$.decorator1' and '$.decorator2' cannot coexist on the same routine" }
 }
 
 class X::Precedence::Incompatible is Exception {
@@ -37,7 +37,7 @@ class _007::OpScope {
     has @.prepostfixprec;
     has $.prepostfix-boundary = 0;
 
-    method maybe-install($identname, @trait) {
+    method maybe-install($identname, @decorators) {
         return unless $identname ~~ /^ (\w+) ':' (.+) /;
 
         my $category = ~$0;
@@ -55,10 +55,14 @@ class _007::OpScope {
         my %precedence;
         my @prec-traits = <equiv looser tighter>;
         my $assoc;
-        for @trait -> $trait {
-            my $name = $trait<identifier>.ast.name;
+        for @decorators -> $decorator {
+            # XXX: Shouldn't do lookup by name here, but lexically
+            my $name = $decorator.identifier.name.value;
             if $name eq any @prec-traits {
-                my $identifier = $trait<EXPR>.ast;
+                my $argcount = $decorator.argumentlist.arguments.elements.elems;
+                die X::ParameterMismatch.new(:type("Decorator"), :paramcount(1), :$argcount)
+                    unless $argcount == 1;
+                my $identifier = $decorator.argumentlist.arguments.elements[0];
                 my $prep = $name eq "equiv" ?? "to" !! "than";
                 die "The thing your op is $name $prep must be an identifier"
                     unless $identifier ~~ Q::Identifier;
@@ -71,22 +75,26 @@ class _007::OpScope {
                 %precedence{$name} = $s;
             }
             elsif $name eq "assoc" {
-                my $string = $trait<EXPR>.ast;
+                my $argcount = $decorator.argumentlist.arguments.elements.elems;
+                die X::ParameterMismatch.new(:type("Decorator"), :paramcount(1), :$argcount)
+                    unless $argcount == 1;
+                my $string = $decorator.argumentlist.arguments.elements[0];
                 die "The associativity must be a string"
                     unless $string ~~ Q::Literal::Str;
                 my $value = $string.value.value;
-                die X::Trait::IllegalValue.new(:trait<assoc>, :$value)
+                die X::Decorator::IllegalValue.new(:trait<assoc>, :$value)
                     unless $value eq any "left", "non", "right";
                 $assoc = $value;
             }
             else {
-                die "Unknown trait '$name'";
+                # XXX: should it still do this? we might decorate a function/macro for other reasons than op
+                die "Unknown decorator '$name'";
             }
         }
 
         if %precedence.keys > 1 {
             my ($t1, $t2) = %precedence.keys.sort;
-            die X::Trait::Conflict.new(:$t1, :$t2);
+            die X::Decorator::Conflict.new(:$t1, :$t2);
         }
 
         self.install($category, $op, :%precedence, :$assoc);

lib/_007/Parser/Actions.pm6

@@ -11,10 +11,10 @@ class X::PointyBlock::SinkContext is Exception {
     method message { "Pointy blocks cannot occur on the statement level" }
 }
 
-class X::Trait::Duplicate is Exception {
-    has Str $.trait;
+class X::Decorator::Duplicate is Exception {
+    has Str $.decorator;
 
-    method message { "Trait '$.trait' is used more than once" }
+    method message { "Decorator '$.decorator' is used more than once" }
 }
 
 class X::Macro::Postdeclared is Exception {
@@ -91,7 +91,11 @@ class _007::Parser::Actions {
     }
 
     method statementlist($/) {
-        make Q::StatementList.new(:statements(Val::Array.new(:elements($<statement>».ast))));
+        make Q::StatementList.new(:statements(Val::Array.new(:elements($<possibly-decorated-statement>».ast))));
+    }
+
+    method possibly-decorated-statement($/) {
+        make $<statement>.ast;
     }
 
     method statement:expr ($/) {
@@ -138,7 +142,6 @@ class _007::Parser::Actions {
         my $identifier = $<identifier>.ast;
         my $name = $identifier.name;
         my $parameterlist = $<parameterlist>.ast;
-        my $traitlist = $<traitlist>.ast;
         my $statementlist = $<blockoid>.ast;
 
         my $block = Q::Block.new(:$parameterlist, :$statementlist);
@@ -148,11 +151,11 @@ class _007::Parser::Actions {
         my $outer-frame = $*runtime.current-frame;
         my $val;
         if $<routine> eq "func" {
-            make Q::Statement::Func.new(:$identifier, :$traitlist, :$block);
+            make Q::Statement::Func.new(:$identifier, :$block);
             $val = Val::Func.new(:$name, :$parameterlist, :$statementlist, :$outer-frame, :$static-lexpad);
         }
         elsif $<routine> eq "macro" {
-            make Q::Statement::Macro.new(:$identifier, :$traitlist, :$block);
+            make Q::Statement::Macro.new(:$identifier, :$block);
             $val = Val::Macro.new(:$name, :$parameterlist, :$statementlist, :$outer-frame, :$static-lexpad);
         }
         else {
@@ -161,7 +164,7 @@ class _007::Parser::Actions {
 
         $*runtime.put-var($identifier, $val);
 
-        $*parser.opscope.maybe-install($name, $<traitlist><trait>);
+        $*parser.opscope.maybe-install($name, @*DECORATORS);
     }
 
     method statement:return ($/) {
@@ -208,16 +211,16 @@ class _007::Parser::Actions {
         $*runtime.put-var($identifier, $val);
     }
 
-    method traitlist($/) {
-        my @traits = $<trait>».ast;
-        if bag( @traits.map: *.identifier.name.value ).grep( *.value > 1 )[0] -> $p {
-            my $trait = $p.key;
-            die X::Trait::Duplicate.new(:$trait);
-        }
-        make Q::TraitList.new(:traits(Val::Array.new(:elements(@traits))));
-    }
-    method trait($/) {
-        make Q::Trait.new(:identifier($<identifier>.ast), :expr($<EXPR>.ast));
+    method decorator ($/) {
+        my $identifier = $<identifier>.ast;
+        # XXX: this ought to be not just by string name, but by declaration site of that name
+        my $name = $identifier.name.value;
+        die X::Decorator::Duplicate.new(:decorator($name))
+            if $name eq any(@*DECORATORS).identifier.name.value;
+        my $argumentlist = ast-if-any($<argumentlist>);
+        my $decorator = Q::Decorator.new(:$identifier, :$argumentlist);
+        make $decorator;
+        @*DECORATORS.push($decorator);
     }
 
     method blockoid ($/) {
@@ -608,7 +611,6 @@ class _007::Parser::Actions {
 
     method term:func ($/) {
         my $parameterlist = $<parameterlist>.ast;
-        my $traitlist = $<traitlist>.ast;
         my $statementlist = $<blockoid>.ast;
 
         my $block = Q::Block.new(:$parameterlist, :$statementlist);
@@ -623,7 +625,7 @@ class _007::Parser::Actions {
 
         my $name = $<identifier>.ast.name;
         my $identifier = ast-if-any($<identifier>);
-        make Q::Term::Func.new(:$identifier, :$traitlist, :$block);
+        make Q::Term::Func.new(:$identifier, :$block);
     }
 
     method unquote ($/) {

lib/_007/Parser/Syntax.pm6

@@ -28,7 +28,7 @@ grammar _007::Parser::Syntax {
     } }
 
     rule statementlist {
-        <.semicolon>* [<statement>[<.semicolon>+|<.eat_terminator>] ]*
+        <.semicolon>* [<possibly-decorated-statement>[<.semicolon>+|<.eat_terminator>] ]*
     }
 
     method panic($what) {
@@ -48,7 +48,12 @@ grammar _007::Parser::Syntax {
         @*declstack[*-1]{$symbol} = $decltype;
     }
 
-    proto token statement {*}
+    rule possibly-decorated-statement {
+        :my @*DECORATORS;
+        <decorator> *
+        <statement>}
+
+    proto rule statement {*}
     token statement:expr {
         $<export>=(export \s+)?
         <!before <!before '{{{'> '{'>   # } }}}, you're welcome vim
@@ -65,11 +70,10 @@ grammar _007::Parser::Syntax {
                     $<identifier>.ast.name.value);
         }
         <.newpad>
-        '(' ~ ')' <parameterlist>
-        <traitlist>
         {
-            $*parser.opscope.maybe-install($<identifier>.ast.name, $<traitlist><trait>);
+            $*parser.opscope.maybe-install($<identifier>.ast.name, @*DECORATORS);
         }
+        '(' ~ ')' <parameterlist>
         [<blockoid>|| <.panic("block")>]:!s
         <.finishpad>
     }
@@ -108,11 +112,9 @@ grammar _007::Parser::Syntax {
         <block>
     }
 
-    rule traitlist {
-        <trait> *
-    }
-    token trait {
-        is» <.ws> <identifier> '(' <EXPR> ')'
+    rule decorator {
+        '@'<identifier>
+        ['(' ~ ')' <argumentlist>]?
     }
 
     # requires a <.newpad> before invocation
@@ -227,8 +229,6 @@ grammar _007::Parser::Syntax {
             || "<" <.ws> $<qtype>=["Q.Term.Array"] ">" <.ws> '{' <.ws> <term:array> <.ws> '}'
             || "<" <.ws> $<qtype>=["Q.Term.Dict"] ">" <.ws> '{' <.ws> <term:object> <.ws> '}'
             || "<" <.ws> $<qtype>=["Q.Term.Quasi"] ">" <.ws> '{' <.ws> <term:quasi> <.ws> '}'
-            || "<" <.ws> $<qtype>=["Q.Trait"] ">" <.ws> '{' <.ws> <trait> <.ws> '}'
-            || "<" <.ws> $<qtype>=["Q.TraitList"] ">" <.ws> '{' <.ws> <traitlist> <.ws> '}'
             || "<" <.ws> $<qtype>=["Q.Statement"] ">" <.ws> <block>
             || "<" <.ws> $<qtype>=["Q.StatementList"] ">" <.ws> <block>
             || "<" <.ws> $<qtype>=["Q.Parameter"] ">" <.ws> '{' <.ws> <parameter> <.ws> '}'
@@ -274,7 +274,7 @@ grammar _007::Parser::Syntax {
             }
         }
         '(' ~ ')' <parameterlist>
-        <traitlist>
+        <.ws>
         <blockoid>:!s
         <.finishpad>
     }
@@ -304,7 +304,6 @@ grammar _007::Parser::Syntax {
             <.newpad>
             <parameterlist>
         ]
-        <trait> *
         <blockoid>:!s
         <.finishpad>
     }