Refactor signature handling to better support named parameters &c

Body.pm

@@ -69,7 +69,7 @@ use CgOp ();
         my ($self) = @_;
         my @enter;
         push @enter, map { $_->enter_code($self) } @{ $self->decls };
-        push @enter, $self->signature->binder if $self->signature;
+        push @enter, $self->signature->binder($self->name) if $self->signature;
         # TODO: Bind a return value here to catch non-ro sub use
         $self->cgoptree(CgOp::prog(@enter,
                 CgOp::return($self->do->cgop($self))));

CgOp.pm

@@ -564,11 +564,20 @@ use warnings;
             zyg => [$stuff]);
     }
 
+    sub die {
+        my ($msg) = @_;
+        $msg = fetch(string_var($msg)) unless blessed($msg);
+        rawccall(rawnew('Niecza.FatalException', $msg), 'SearchForHandler');
+    }
+
     sub letn {
         my (@stuff) = @_;
         if (blessed($stuff[0])) {
             @stuff;
         } else {
+            if (!@stuff) {
+                Carp::confess "Invalid letn protocol";
+            }
             my ($name, $value) = splice @stuff, 0, 2;
             CgOp::Let->new(name => $name, zyg => [ $value, letn(@stuff) ]);
         }

CodeGen.pm

@@ -59,6 +59,10 @@ use 5.010;
               ExecutingLine=> [m => 'Int32'],
               ExecutingFile=> [m => 'String'],
               LexicalFind  => [m => 'Variable'] },
+        'Niecza.FatalException' =>
+            { SearchForHandler => [c => 'Void'] },
+        'Niecza.LexoticControlException' =>
+            { SearchForHandler => [c => 'Void'] },
 
         'Kernel.ContextHelper' => [m => 'Variable'],
         'Kernel.StrP'          => [f => 'IP6'],
@@ -68,6 +72,8 @@ use 5.010;
         'Kernel.PackageLookup' => [m => 'Variable'],
         'Kernel.SlurpyHelper'  => [m => 'List<Variable>'],
         'Kernel.Bind'          => [c => 'Void'],
+        'Kernel.BindNewScalar' => [c => 'Variable'],
+        'Kernel.BindNewList'   => [c => 'Variable'],
         'Kernel.Assign'        => [c => 'Void'],
         'Kernel.Fetch'         => [c => 'IP6'],
         'Kernel.DefaultNew'    => [m => 'Variable'],
@@ -189,6 +195,7 @@ use 5.010;
         $self->lineinfo->[$n] = $line;
         $self->fileinfo->[$n] = $file;
         push @{ $self->buffer }, "case $n:\n";
+        die "Broken call $expr" if !defined($rt);
         $self->resulttype($rt);
     }
 
@@ -348,7 +355,7 @@ use 5.010;
         my @args = reverse map { ($self->_popn(1))[0] }
                 (1 .. $numargs + 1);  # invocant LV
         my ($inv) = $self->_popn(1);
-        $self->_cpscall(($nv ? 'Variable' : undef),
+        $self->_cpscall(($nv ? 'Variable' : 'Void'),
             "$inv.InvokeMethod(th, " . qm($name) . ", new LValue[" .
             scalar(@args) . "] { " . join(", ", map { "$_.lv" } @args) .
             " }, null)");
@@ -358,7 +365,7 @@ use 5.010;
         my ($self, $nv, $numargs) = @_;
         my @args = reverse map { ($self->_popn(1))[0] } (1 .. $numargs);
         my ($inv) = $self->_popn(1);
-        $self->_cpscall(($nv ? 'Variable' : undef),
+        $self->_cpscall(($nv ? 'Variable' : 'Void'),
             "$inv.Invoke(th, new LValue[" . scalar(@args) . "] { " .
             join(", ", map { "$_.lv" } @args) . " }, null)");
     }
@@ -476,7 +483,7 @@ use 5.010;
         my ($cl, $rt) = $self->_typedata('cm', $name);
         my @args = reverse map { ($self->_popn(1))[0] } 1 .. $nargs;
         if ($cl eq 'c') {
-            $self->_cpscall(($rt eq 'Void' ? undef : $rt),
+            $self->_cpscall($rt,
                 "$name(" . join(", ", "th", @args) . ")");
         } elsif ($rt ne 'Void') {
             $self->_push($rt, "$name(" . join(", ", @args) . ")");
@@ -491,7 +498,7 @@ use 5.010;
         my ($cl, $rt) = $self->_typedata('cm', $self->stacktype->[-1], $name);
         my ($inv) = $self->_popn(1);
         if ($cl eq 'c') {
-            $self->_cpscall(($rt eq 'Void' ? undef : $rt),
+            $self->_cpscall($rt,
                 "$inv.$name(" . join(", ", "th", @args) . ")");
         } elsif ($rt ne 'Void') {
             $self->_push($rt, "$inv.$name(" . join(", ", @args) . ")");

Decl.pm

@@ -93,6 +93,7 @@ use CgOp;
     has list     => (isa => 'Bool', is => 'ro', default => 0);
     has shared   => (isa => 'Bool', is => 'ro', default => 0);
     has zeroinit => (isa => 'Bool', is => 'ro', default => 0);
+    has noenter  => (isa => 'Bool', is => 'ro', default => 0);
 
     sub used_slots {
         $_[0]->slot, 'Variable';
@@ -115,6 +116,8 @@ use CgOp;
     sub enter_code {
         my ($self, $body) = @_;
 
+        return CgOp::noop if $self->noenter;
+
         ($body->mainline || $self->shared) ?
             CgOp::share_lex($self->slot) :
             CgOp::scopedlex($self->slot, $self->list ?

Kernel.cs

@@ -380,8 +380,12 @@ public class CLRImportObject : IP6 {
     public class Kernel {
         public static DynBlockDelegate MainlineContinuation;
 
+        private static object UnboxDO(DynObject o) {
+            return o.slots["value"];
+        }
+
         private static Frame SCFetch(DynObject th, Frame caller) {
-            caller.resultSlot = th.slots["value"];
+            caller.resultSlot = UnboxDO(th);
             return caller;
         }
 
@@ -472,7 +476,7 @@ public class Kernel {
 
         public static object UnboxAny(IP6 o) {
             // TODO: Check for compatibility?
-            return ((DynObject)o).slots["value"];
+            return UnboxDO((DynObject)o);
         }
 
         public static IP6 MakeSC(IP6 inside) {
@@ -496,6 +500,41 @@ public class Kernel {
             }
         }
 
+        public static Frame BindNewScalar(Frame th, Variable rhs, bool ro,
+                bool forcerw) {
+            IP6 cont;
+            bool contrw;
+            if (rhs.lv.islist) {
+                cont = MakeSC(rhs.lv.container);
+                contrw = false;
+            } else {
+                cont = rhs.lv.container;
+                contrw = rhs.lv.rw;
+            }
+            th.resultSlot = new Variable(false, Variable.Context.Scalar,
+                    new LValue(!ro && contrw, false, cont)); // TODO forcerw
+            return th;
+        }
+
+        public static Frame BindNewList(Frame th, Variable rhs,
+                bool ro, bool forcerw) {
+            Frame n;
+            Variable lhs = new Variable(false, Variable.Context.List,
+                    new LValue(true, true, null));
+            th.resultSlot = lhs;
+            if (rhs.lv.islist) {
+                lhs.lv = rhs.lv;
+                if (ro) { lhs.lv.rw = false; }
+                return th;
+            } else {
+                n = new Frame(th, null,
+                        new DynBlockDelegate(BindListizeC));
+                n.lex["o"] = rhs.lv;
+                n.lex["c"] = lhs;
+                return n;
+            }
+        }
+
         public static Frame Bind(Frame th, Variable lhs, LValue rhs,
                 bool ro, bool forcerw) {
             // TODO: need exceptions for forcerw to be used

Niecza/Actions.pm

@@ -852,7 +852,7 @@ sub variable { my ($cl, $M) = @_;
 
 sub param_sep {}
 
-# :: Sig::Target
+# :: { list : Bool, slot : Maybe[Str] }
 sub param_var { my ($cl, $M) = @_;
     if ($M->{signature}) {
         $M->sorry('Sub-signatures NYI');
@@ -864,8 +864,8 @@ sub param_var { my ($cl, $M) = @_;
         $M->sorry('Non bare scalar targets NYI');
         return;
     }
-    $M->{_ast} = Sig::Target->new(list => ($sigil eq '@'), slot =>
-        $M->{name}[0] ? ($sigil . $M->{name}[0]->Str) : undef);
+    $M->{_ast} = { list => ($sigil eq '@'), slot =>
+        $M->{name}[0] ? ($sigil . $M->{name}[0]->Str) : undef };
 }
 
 # :: Sig::Parameter
@@ -900,8 +900,8 @@ sub parameter { my ($cl, $M) = @_;
         return;
     }
 
-    $M->{_ast} = Sig::Parameter->new(target => $M->{param_var}{_ast},
-        slurpy => ($M->{quant} eq '*'));
+    $M->{_ast} = Sig::Parameter->new(name => $M->Str,
+        slurpy => ($M->{quant} eq '*'), %{ $M->{param_var}{_ast} });
 }
 
 # signatures exist in several syntactic contexts so just make an object for now
@@ -1497,13 +1497,13 @@ sub get_placeholder_sig { my ($cl, $M) = @_;
     for (@things) {
         if ($_ =~ /^\$_ is ref/) {
             push @parms, Sig::Parameter->new(optional => 1,
-                target => Sig::Target->new(slot => '$_'));
+                slot => '$_', name => '$_');
         } elsif ($_ eq '*@_') {
-            push @parms, Sig::Parameter->new(slurpy => 1,
-                target => Sig::Target->new(slot => '@_', list => 1));
+            push @parms, Sig::Parameter->new(slurpy => 1, slot => '@_',
+                list => 1, name => '*@_');
         } elsif ($_ =~ /^([@\$])/) {
-            push @parms, Sig::Parameter->new(
-                target => Sig::Target->new(slot => $_), list => ($1 eq '@'));
+            push @parms, Sig::Parameter->new(slot => $_, name => $_,
+                list => ($1 eq '@'));
         } else {
             $M->sorry('Named placeholder parameters NYI');
             return;
@@ -1667,8 +1667,8 @@ sub comp_unit { my ($cl, $M) = @_;
             type => 'mainline',
             name => 'install',
             signature => Sig->new(params => [
-                    Sig::Parameter->new(target => Sig::Target->new(
-                            slot => '!mainline', zeroinit => 1))]),
+                    Sig::Parameter->new(name => '!mainline',
+                        slot => '!mainline', zeroinit => 1)]),
             do => Op::CallSub->new(node($M),
                 invocant => Op::CgOp->new(op => CgOp::newscalar(
                         CgOp::rawsget($::SETTINGNAME . ".Installer"))),

RxOp.pm

@@ -1,6 +1,7 @@
 use strict;
 use warnings;
 use 5.010;
+use utf8;
 
 use CgOp;
 
@@ -16,8 +17,7 @@ use CgOp;
         Op::SubDef->new(var => 'rx!' . ($i++), body =>
             Body->new(
                 type      => 'regex',
-                signature => Sig->new(params => [ Sig::Parameter->new(
-                    target => Sig::Target->new(slot => '$¢'))]),
+                signature => Sig->simple('$¢'),
                 do        => $op));
     }