Add \$foo and \|$foo parameters

lib/SAFE.setting

@@ -18,14 +18,15 @@ my class Mu {
     }
     method so() { self.Bool }
     method not() { ! self.Bool }
-    method RAWCREATE is rawcall { Q:CgOp {
-        (letn max (poscount)
+    method RAWCREATE(\|$vars) { Q:CgOp {
+        (letn ar  (unbox fvarlist (@ {$vars}))
+              max (fvarlist_length (l ar))
               i   (int 1)
-              obj (obj_newblank (obj_llhow (@ (pos 0))))
+              obj (obj_newblank (obj_llhow (@ (fvarlist_item (i 0) (l ar)))))
           [whileloop 0 0 (< (l i) (l max)) (prog
               [setslot
-                (unbox str (@ (pos (l i)))) (l obj)
-                (nsw (@ (pos (+ (l i) (int 1)))))]
+                (unbox str (@ (fvarlist_item (l i) (l ar)))) (l obj)
+                (nsw (@ (fvarlist_item (+ (l i) (int 1)) (l ar))))]
               [l i (+ (l i) (int 2))])]
           [ns (l obj)])
     } }
@@ -146,15 +147,14 @@ constant True  = Q:CgOp { (box Bool (bool 1)) };
 constant False = Q:CgOp { (box Bool (bool 0)) };
 # }}}
 # Fundamental scalar operators {{{
-# taking a slurpy is wrong for this due to flattening.  I'm not sure what is
-# right, maybe **@foo
-sub infix:<~> is rawcall { Q:CgOp {
+sub infix:<~>(\|$bits) { Q:CgOp {
     (letn buf (strbuf_new)
           i   (int 0)
-          max (poscount)
+          ar  (unbox fvarlist (@ {$bits}))
+          max (fvarlist_length (l ar))
       [whileloop 0 0 (< (l i) (l max)) (prog
           [strbuf_append (l buf)
-            (unbox str (@ (methodcall (pos (l i)) Str)))]
+            (unbox str (@ (methodcall (fvarlist_item (l i) (l ar)) Str)))]
           [l i (+ (l i) (int 1))])]
       [box Str (strbuf_seal (l buf))])
 } }
@@ -251,9 +251,7 @@ sub infix:<~~>($t,$m) { ($m.defined) ?? ($m.ACCEPTS($t)) !! ($t.^does($m)) }
 # coercion makes the elements of a List read-only and maybe fetches them too.
 # Array: mutable list of read-write scalar boxes
 
-sub unitem is rawcall {
-    Q:CgOp { (newrwlistvar (@ (pos 0))) }
-}
+sub unitem is rawcall { Q:CgOp { (newrwlistvar (@ (pos 0))) } }
 
 my class Iterator {
     # subclasses must provide .reify, return parcel
@@ -290,7 +288,7 @@ my class Parcel is Cool {
 
 # Maybe this should be a constant, but constants are currently forced to
 # scalar-nature (TODO)
-sub Nil is rawcall { Q:CgOp { (newrwlistvar (@ (box Parcel (fvarlist_new)))) } }
+sub Nil() { Q:CgOp { (newrwlistvar (@ (box Parcel (fvarlist_new)))) } }
 
 my class List is Cool {
     has @!items;

src/CgOp.pm

@@ -175,6 +175,7 @@ use warnings;
 
     sub fvarlist_length { getfield('Length', $_[0]) }
     sub fvarlist_new { rawnewarr('var', @_) }
+    sub fvarlist_item { getindex($_[0], $_[1]) }
 
     sub vvarlist_from_fvarlist { rawnew('vvarlist', $_[0]) }
     sub vvarlist_new_empty { rawnew('vvarlist') }

src/Niecza/Actions.pm

@@ -1611,12 +1611,13 @@ sub parameter { my ($cl, $M) = @_;
     my $sorry;
     my $slurpy;
     my $optional;
+    my $rwt;
     given ($M->{quant} . ':' . $M->{kind}) {
         when ('**:*') { $sorry = "Slice parameters NYI" }
         when ('*:*')  { $slurpy = 1 }
         when ('|:*')  { $sorry = "Captures NYI" }
-        when ('\\:!') { $sorry = "Simple parcel parameters NYI" }
-        when ('\\:?') { $sorry = "Simple parcel parameters NYI" }
+        when ('\\:!') { $rwt = 1 }
+        when ('\\:?') { $rwt = 1; $optional = 1 }
         when (':!')   { }
         when (':*')   { $optional = 1 }
         when (':?')   { $optional = 1 }
@@ -1631,7 +1632,7 @@ sub parameter { my ($cl, $M) = @_;
 
     $M->{_ast} = Sig::Parameter->new(name => $M->Str, default => $default,
         optional => $optional, slurpy => $slurpy, readonly => !$rw,
-        %{ $p->{_ast} });
+        rwtrans => $rwt, %{ $p->{_ast} });
 }
 
 # signatures exist in several syntactic contexts so just make an object for now
@@ -1642,7 +1643,9 @@ sub signature { my ($cl, $M) = @_;
     }
 
     if ($M->{param_var}) {
-        $M->sorry('\| signatures NYI');
+        $M->{_ast} = Sig->new(params => [ Sig::Parameter->new(
+                name => $M->{param_var}->Str, %{ $M->{param_var}{_ast} },
+                full_parcel => 1) ]);
         return;
     }
 

src/Sig.pm

@@ -9,6 +9,9 @@ use 5.010;
 
     has slot => (is => 'ro', isa => 'Maybe[Str]', required => 1);
     has slurpy => (is => 'ro', isa => 'Bool', default => 0);
+    # rw binding to Mu that does not viv
+    has rwtrans => (is => 'ro', isa => 'Bool', default => 0);
+    has full_parcel => (is => 'ro', isa => 'Bool', default => 0);
     has optional => (is => 'ro', isa => 'Bool', default => 0);
     has default => (is => 'ro', isa => 'Maybe[Op]', default => undef);
     has positional => (is => 'ro', isa => 'Bool', default => 1);
@@ -38,6 +41,14 @@ use 5.010;
                 CgOp::newscalar($do))});
     }
 
+    sub parcel_get {
+        my ($self) = @_;
+        CgOp::prog(
+            CgOp::scopedlex('!ix', CgOp::poscount),
+            CgOp::box('Parcel', CgOp::getfield('pos',
+                    CgOp::callframe)));
+    }
+
     sub _default_get {
         my ($self, $body) = @_;
 
@@ -107,12 +118,14 @@ use 5.010;
     sub binder {
         my ($self, $body) = @_;
 
-        my $get = $self->slurpy ? $self->slurpy_get :
+        my $get = $self->full_parcel ? $self->parcel_get :
+            $self->slurpy ? $self->slurpy_get :
             $self->single_get($body);
 
         if (defined $self->slot) {
             return CgOp::scopedlex($self->slot,
-                CgOp::newboundvar($self->readonly, $self->list, $get));
+                CgOp::newboundvar($self->readonly && !$self->rwtrans,
+                    $self->list, $get));
         } else {
             return CgOp::sink($get);
         }
@@ -121,12 +134,14 @@ use 5.010;
     sub bind_inline {
         my ($self, $body, $posr) = @_;
 
-        my $get = $self->slurpy ? $self->slurpy_get_inline($posr) :
+        my $get = $self->full_parcel ? $self->parcel_get_inline($posr) :
+            $self->slurpy ? $self->slurpy_get_inline($posr) :
             $self->single_get_inline($body, $posr);
 
         if (defined $self->slot) {
             return CgOp::scopedlex($self->slot,
-                CgOp::newboundvar($self->readonly, $self->list, $get));
+                CgOp::newboundvar($self->readonly && !$self->rwtrans,
+                    $self->list, $get));
         } else {
             return CgOp::sink($get);
         }