Fix does/but confusion/issues with many-roles form.

rakudo · Jul 18, 2015 · 75c5e17 · 75c5e17
1 parent 2cb9230
commit 75c5e17
Show file tree

Hide file tree

Showing 2 changed files with 36 additions and 11 deletions.
diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp
@@ -5677,6 +5677,12 @@ Compilation unit '$file' contained the following violations:
                 }
             }
         }
+        elsif $rhs.isa(QAST::Stmts) && +@($rhs) == 1 &&
+                $rhs[0].isa(QAST::Op) && $rhs[0].name eq '&infix:<,>' {
+            for @($rhs[0]) {
+                $past.push($_);
+            }
+        }
         else {
             $past.push($rhs);
         }

diff --git a/src/core/operators.pm b/src/core/operators.pm
@@ -12,7 +12,7 @@ my class X::Does::TypeObject is Exception {
     method message() { "Cannot use 'does' operator with a type object." }
 }
 
-proto sub infix:<does>(Mu, Mu, *%) { * }
+proto sub infix:<does>(|) { * }
 multi sub infix:<does>(Mu:D \obj, Mu:U \rolish) is rw {
     # XXX Mutability check.
     my $role := rolish.HOW.archetypes.composable() ?? rolish !!
@@ -31,15 +31,20 @@ multi sub infix:<does>(Mu:D \obj, Mu:U \rolish, :$value! is parcel) is rw {
 multi sub infix:<does>(Mu:U \obj, Mu:U \role) is rw {
     X::Does::TypeObject.new(type => obj).throw
 }
-multi sub infix:<does>(Mu:D \obj, @roles) is rw {
+multi sub infix:<does>(Mu:D \obj, **@roles) is rw {
     # XXX Mutability check.
-    obj.^mixin(|@roles).BUILD_LEAST_DERIVED({});
+    my @real-roles := eager @roles.map: -> \rolish {
+        rolish.HOW.archetypes.composable() ?? rolish !!
+            rolish.HOW.archetypes.composalizable() ?? rolish.HOW.composalize(rolish) !!
+            X::Mixin::NotComposable.new(:target(obj), :rolish(rolish)).throw
+    }
+    obj.^mixin(|@real-roles).BUILD_LEAST_DERIVED({});
 }
-multi sub infix:<does>(Mu:U \obj, @roles) is rw {
+multi sub infix:<does>(Mu:U \obj, **@roles) is rw {
     X::Does::TypeObject.new(type => obj).throw
 }
 
-proto sub infix:<but>(Mu, Mu, *%) { * }
+proto sub infix:<but>(|) { * }
 multi sub infix:<but>(Mu:D \obj, Mu:U \rolish) {
     my $role := rolish.HOW.archetypes.composable() ?? rolish !!
                 rolish.HOW.archetypes.composalizable() ?? rolish.HOW.composalize(rolish) !!
@@ -66,21 +71,35 @@ multi sub infix:<but>(Mu:U \obj, Mu:U \rolish) {
                 X::Mixin::NotComposable.new(:target(obj), :rolish(rolish)).throw;
     obj.^mixin($role);
 }
-multi sub infix:<but>(Mu \obj, Mu:D $val) is rw {
+sub GENERATE-ROLE-FROM-VALUE($val) {
     my $role := Metamodel::ParametricRoleHOW.new_type();
     my $meth := method () { $val };
     $meth.set_name($val.^name);
     $role.^add_method($meth.name, $meth);
     $role.^set_body_block(
       -> |c { nqp::list($role, nqp::hash('$?CLASS', c<$?CLASS>)) });
     $role.^compose;
-    obj.clone.^mixin($role);
 }
-multi sub infix:<but>(Mu:D \obj, @roles) {
-    obj.clone.^mixin(|@roles).BUILD_LEAST_DERIVED({});
+multi sub infix:<but>(Mu \obj, Mu:D $val) is rw {
+    obj.clone.^mixin(GENERATE-ROLE-FROM-VALUE($val));
+}
+multi sub infix:<but>(Mu:D \obj, **@roles) {
+    my @real-roles := eager @roles.map: -> \rolish {
+        rolish.DEFINITE ?? GENERATE-ROLE-FROM-VALUE(rolish) !!
+            rolish.HOW.archetypes.composable() ?? rolish !!
+            rolish.HOW.archetypes.composalizable() ?? rolish.HOW.composalize(rolish) !!
+            X::Mixin::NotComposable.new(:target(obj), :rolish(rolish)).throw
+    }
+    obj.clone.^mixin(|@real-roles).BUILD_LEAST_DERIVED({});
 }
-multi sub infix:<but>(Mu:U \obj, @roles) {
-    obj.^mixin(|@roles)
+multi sub infix:<but>(Mu:U \obj, **@roles) {
+    my @real-roles := eager @roles.map: -> \rolish {
+        rolish.DEFINITE ?? GENERATE-ROLE-FROM-VALUE(rolish) !!
+            rolish.HOW.archetypes.composable() ?? rolish !!
+            rolish.HOW.archetypes.composalizable() ?? rolish.HOW.composalize(rolish) !!
+            X::Mixin::NotComposable.new(:target(obj), :rolish(rolish)).throw
+    }
+    obj.^mixin(|@real-roles)
 }
 
 sub SEQUENCE(\left, Mu \right, :$exclude_end) {