Implement label definitions

TODO

@@ -27,5 +27,4 @@ For STD difference minimization:
         - TimToady and I seem to both not hate traits
     * Find a compromise on cursor mutability
     * basic multimethods
-    * s///
     * constant %foo = (a => 1, b => 2)

lib/CLRBackend.cs

@@ -539,6 +539,8 @@ class StaticSub {
                     obj = new LexAlias(bl);
                 } else if (type == "stash") {
                     obj = new LexStash(unit, bl);
+                } else if (type == "label") {
+                    obj = new LexLabel(bl);
                 } else {
                     throw new Exception("unknown lex type " + type);
                 }
@@ -631,6 +633,10 @@ class LexSimple : LexVarish {
         }
     }
 
+    class LexLabel : LexVarish {
+        public LexLabel(object[] l) { }
+    }
+
     class LexHint : Lexical {
         public FieldInfo stg;
         public LexHint(object[] l) {}
@@ -916,6 +922,8 @@ sealed class Tokens {
             VarHash.GetMethod("set_Item");
         public static readonly MethodInfo Kernel_MakeSub =
             typeof(Kernel).GetMethod("MakeSub");
+        public static readonly MethodInfo Kernel_NewLabelVar =
+            typeof(Kernel).GetMethod("NewLabelVar");
         public static readonly MethodInfo Kernel_Die =
             typeof(Kernel).GetMethod("Die");
         public static readonly MethodInfo Kernel_SFH =
@@ -2718,6 +2726,10 @@ class NamProcessor {
                 return CpsOp.MethodCall(null, Tokens.Kernel_MakeSub, new CpsOp[]{
                     CpsOp.GetSField(((StaticSub)z[1]).subinfo),
                     CpsOp.CallFrame() }); };
+            handlers["_newlabel"] = delegate(NamProcessor th, object[] z) {
+                return CpsOp.MethodCall(null, Tokens.Kernel_NewLabelVar, new CpsOp[]{
+                    CpsOp.CallFrame(),
+                    CpsOp.StringLiteral(JScalar.S(z[1])) }); };
             handlers["class_ref"] = delegate(NamProcessor th, object[] z) {
                 string kind = FixStr(z[1]);
                 ModuleWithTypeObject m;
@@ -3310,6 +3322,11 @@ class NamProcessor {
                     }
                     frags.Add(new object[] { new JScalar("scopedlex"),
                         new JScalar(kv.Key), bit });
+                } else if (kv.Value is LexLabel) {
+                    frags.Add(new object[] { new JScalar("scopedlex"),
+                        new JScalar(kv.Key),
+                        new object[] { new JScalar("_newlabel"),
+                            new JScalar(kv.Key) } });
                 }
             }
         }

lib/Kernel.cs

@@ -1574,6 +1574,7 @@ public class Kernel {
         public static IP6 EMPTYP;
         public static IP6 HashP;
         public static IP6 IteratorP;
+        public static readonly DynMetaObject LabelMO;
         public static readonly DynMetaObject AnyMO;
         public static readonly DynMetaObject IteratorMO;
         public static readonly DynMetaObject ScalarMO;
@@ -2280,6 +2281,10 @@ class LastFrameNode {
             SubMO.AddMethod("INVOKE", MakeSub(SubInvokeSubSI, null));
             SubMO.Invalidate();
 
+            LabelMO = new DynMetaObject("Label");
+            LabelMO.FillProtoClass(new string[] { "target", "name" });
+            LabelMO.Invalidate();
+
             BoolMO = new DynMetaObject("Bool");
             BoolMO.loc_Bool = new CtxReturnSelf();
             BoolMO.loc_raw_Bool = new CtxJustUnbox<bool>();
@@ -2472,6 +2477,14 @@ class LastFrameNode {
             return new System.IO.StreamWriter(Console.OpenStandardError(), Console.OutputEncoding);
         }
 
+        public static Variable NewLabelVar(Frame fr, string name) {
+            DynObject dob = new DynObject(LabelMO);
+            fr.MarkSharedChain();
+            dob.slots[0] = fr;
+            dob.slots[1] = name;
+            return NewROScalar(dob);
+        }
+
         private static string DescribeException(int type, Frame tgt,
                 string name, object payload) {
             if (type != SubInfo.ON_DIE)

lib/SAFE.setting

@@ -376,6 +376,11 @@ sub callframe() { Q:CgOp { (ns (frame_caller (callframe))) } }
 
 sub die($msg) { Q:CgOp { (die (@ {$msg})) } }
 
+my class Label {
+    has $!target;
+    has $!name;
+}
+
 # XXX multi dispatch
 sub next() {
     Q:CgOp { (control 1 (null frame) (int -1) (null str) {()}) }

src/Metamodel.pm6

@@ -414,6 +414,11 @@ class Lexical {
     class Hint is Lexical {
     }
 
+    # These store destinations for lexotic control transfers, and clone like
+    # subs to handle recursion properly.
+    class Label is Lexical {
+    }
+
     # our...
     class Common is Lexical {
         has $.path = die "M:L:Common.path required"; # Array of Str
@@ -505,6 +510,10 @@ class StaticSub is RefTarget {
         $.outer.create_static_pad if $.outer;
     }
 
+    method topicalizer() {
+        $.signature && ?( grep { .slot && .slot eq '$_' }, @( $.signature.params ) )
+    }
+
     method find_lex_pkg($name) {
         my $toplex = self.find_lex($name) // return Array;
         if !$toplex.^isa(Metamodel::Lexical::Stash) {
@@ -563,6 +572,10 @@ class StaticSub is RefTarget {
         $.lexicals{$slot} = Metamodel::Lexical::Hint.new;
     }
 
+    method add_label($slot) {
+        $.lexicals{$slot} = Metamodel::Lexical::Label.new;
+    }
+
     method add_common_name($slot, $path, $name) {
         $*unit.create_stash($path);
         $*unit.create_var([ @$path, $name ]);

src/NAMOutput.pm6

@@ -20,6 +20,11 @@ sub nam_sub($s) {
     if $s.topicalizer {
         $code = ::Op::TopicalHook.new(inner => $code);
     }
+    my $lx = $s.lexicals;
+    my @labels = grep { $lx{$_}.^isa(::Metamodel::Lexical::Label) }, $lx.keys;
+    if @labels {
+        $code = ::Op::LabelHook.new(labels => @labels, inner => $code);
+    }
     @*subsnam[$s.xref[1]] = $code.cgop($s);
     if $s.parametric_role_hack {
         for @( $*unit.deref($s.parametric_role_hack).methods ) -> $me {
@@ -298,6 +303,9 @@ augment class Metamodel::Lexical::Alias { #OK exist
 augment class Metamodel::Lexical::Hint { #OK exist
     method to_nam() { ['hint'] }
 }
+augment class Metamodel::Lexical::Label { #OK exist
+    method to_nam() { ['label'] }
+}
 augment class Metamodel::Lexical::SubDef { #OK exist
     method to_nam() { ['sub', @( $.body.xref ) ] }
 }
@@ -315,6 +323,8 @@ sub lex_from_nam(@block) {
                         if $type eq 'alias';
     return ($name, ::Metamodel::Lexical::Hint.new)
                         if $type eq 'hint';
+    return ($name, ::Metamodel::Lexical::Label.new)
+                        if $type eq 'label';
     return ($name, ::Metamodel::Lexical::SubDef.new(body => $*xref[@xtra[1]]))
                         if $type eq 'sub';
     return ($name, ::Metamodel::Lexical::Stash.new(path => @xtra))

src/niecza

@@ -91,10 +91,11 @@ method statement_control:when ($/) {
         body => self.block_to_immediate($/, 'loop', $<xblock>.ast[1]));
 }
 
+method label($/) { }
 method statement($/) {
     if $<label> {
-        $/.CURSOR.sorry("Labels are NYI");
-        make ::Op::StatementList.new;
+        make ::Op::Labelled.new(|node($/), name => ~$<label><identifier>,
+            stmt => $<statement>.ast);
         return Nil;
     }
 
@@ -147,12 +148,6 @@ method statement($/) {
 }
 }
 
-augment class Metamodel::StaticSub { #OK exist
-    method topicalizer() {
-        $.signature && ?( grep { .slot && .slot eq '$_' }, @( $.signature.params ) )
-    }
-}
-
 augment class Op {
 class When is Op {
     has $.match;
@@ -174,6 +169,7 @@ class When is Op {
     }
 }
 
+# These two are created to codegen wrappers in NAMOutput... bad factor
 class TopicalHook is Op {
     has $.inner;
     method zyg() { $.inner }
@@ -186,6 +182,38 @@ class TopicalHook is Op {
             CgOp.span("start$id", "end$id", 0, $.inner.cgop($body)));
     }
 }
+
+class LabelHook is Op {
+    has $.inner;
+    has $.labels;
+    method zyg() { $.inner }
+
+    method code($body) {
+        my $id = ::GLOBAL::NieczaActions.genid;
+
+        CgOp.prog(
+            map({ CgOp.ehspan(8, $_, 0, "start$id", "end$id", "goto_$_") },
+                @$.labels),
+            CgOp.span("start$id", "end$id", 0, $.inner.cgop($body)));
+    }
+}
+
+class Labelled is Op {
+    has $.stmt;
+    has $.name;
+    method zyg() { $.stmt }
+
+    method code($body) {
+        CgOp.prog(CgOp.label("goto_$.name"), $.stmt.cgop($body));
+    }
+}
+}
+
+augment class Op::Labelled { #OK exist
+    method begin() {
+        @*opensubs[*-1].add_label($.name);
+        for self.zyg { $_.begin } # XXX callsame
+    }
 }
 
 augment class Operator {