- Migrated the format of synthesis nodes from a custom data-type, to just Code nodes.

4 files changed, 135 insertions, 122 deletions

diff --git a/new-luxc/source/luxc/generator/case.jvm.lux b/new-luxc/source/luxc/generator/case.jvm.lux
index f20c83f6e..a619768bb 100644
--- a/new-luxc/source/luxc/generator/case.jvm.lux
+++ b/new-luxc/source/luxc/generator/case.jvm.lux
@@ -1,8 +1,11 @@
 (;module:
   lux
-  (lux (control [monad #+ do])
+  (lux (control [monad #+ do]
+                ["ex" exception #+ exception:])
+       (data text/format)
        [meta "meta/" Monad<Meta>])
-  (luxc [";L" host]
+  (luxc ["_" base]
+        [";L" host]
         (lang ["ls" synthesis])
         (generator (host ["$" jvm]
                          (jvm ["$t" type]
@@ -49,50 +52,52 @@
                                    (list))
                         false)))
 
-(def: (generate-pattern' generate stack-depth @else @end path)
+(exception: #export Unrecognized-Path)
+
+(def: (generate-path' generate stack-depth @else @end path)
   (-> (-> ls;Synthesis (Meta $;Inst))
       Nat $;Label $;Label ls;Path (Meta $;Inst))
   (case path
-    (#ls;ExecP bodyS)
+    (^ [_ (#;Form (list [_ (#;Text "lux case exec")] bodyS))])
     (do meta;Monad<Meta>
       [bodyI (generate bodyS)]
       (wrap (|>. (pop-altI stack-depth)
                  bodyI
                  ($i;GOTO @end))))
 
-    #ls;UnitP
+    (^ [_ (#;Form (list [_ (#;Text "lux case pop")]))])
     (meta/wrap popI)
 
-    (#ls;BindP register)
+    (^ [_ (#;Form (list [_ (#;Text "lux case bind")] [_ (#;Nat register)]))])
     (meta/wrap (|>. peekI
                     ($i;ASTORE register)
                     popI))
 
-    (#ls;BoolP value)
+    [_ (#;Bool value)]
     (meta/wrap (let [jumpI (if value $i;IFEQ $i;IFNE)]
                  (|>. peekI
                       ($i;unwrap #$;Boolean)
                       (jumpI @else))))
 
     (^template [<tag> <prep>]
-      (<tag> value)
+      [_ (<tag> value)]
       (meta/wrap (|>. peekI
                       ($i;unwrap #$;Long)
                       ($i;long (|> value <prep>))
                       $i;LCMP
                       ($i;IFNE @else))))
-    ([#ls;NatP (:! Int)]
-     [#ls;IntP (: Int)]
-     [#ls;DegP (:! Int)])
+    ([#;Nat (:! Int)]
+     [#;Int (: Int)]
+     [#;Deg (:! Int)])
 
-    (#ls;FracP value)
+    [_ (#;Frac value)]
     (meta/wrap (|>. peekI
                     ($i;unwrap #$;Double)
                     ($i;double value)
                     $i;DCMPL
                     ($i;IFNE @else)))
     
-    (#ls;TextP value)
+    [_ (#;Text value)]
     (meta/wrap (|>. peekI
                     ($i;string value)
                     ($i;INVOKEVIRTUAL "java.lang.Object"
@@ -103,95 +108,88 @@
                                       false)
                     ($i;IFEQ @else)))
 
-    (#ls;TupleP idx subP)
-    (do meta;Monad<Meta>
-      [subI (generate-pattern' generate stack-depth @else @end subP)
-       #let [[idx tail?] (case idx
-                           (#;Left idx)
-                           [idx false]
-
-                           (#;Right idx)
-                           [idx true])]]
-      (wrap (case idx
-              +0
-              (|>. peekI
-                   ($i;CHECKCAST ($t;descriptor ../runtime;$Tuple))
-                   ($i;int 0)
-                   $i;AALOAD
-                   pushI
-                   subI)
-              
-              _
-              (|>. peekI
-                   ($i;CHECKCAST ($t;descriptor ../runtime;$Tuple))
-                   ($i;int (nat-to-int idx))
-                   ($i;INVOKESTATIC hostL;runtime-class
-                                    (if tail? "pm_right" "pm_left")
-                                    ($t;method (list ../runtime;$Tuple $t;int)
-                                               (#;Some $Object)
-                                               (list))
-                                    false)
-                   pushI
-                   subI))))
-
-    (#ls;VariantP idx subP)
-    (do meta;Monad<Meta>
-      [subI (generate-pattern' generate stack-depth @else @end subP)
-       #let [[idx last?] (case idx
-                           (#;Left idx)
-                           [idx false]
-
-                           (#;Right idx)
-                           [idx true])
-             flagI (if last?
-                     ($i;string "")
-                     $i;NULL)]]
-      (wrap (<| $i;with-label (function [@success])
-                $i;with-label (function [@fail])
+    (^template [<special> <method>]
+      (^ [_ (#;Form (list [_ (#;Text <special>)] [_ (#;Nat idx)] subP))])
+      (do meta;Monad<Meta>
+        [subI (generate-path' generate stack-depth @else @end subP)]
+        (wrap (case idx
+                +0
+                (|>. peekI
+                     ($i;CHECKCAST ($t;descriptor ../runtime;$Tuple))
+                     ($i;int 0)
+                     $i;AALOAD
+                     pushI
+                     subI)
+                
+                _
                 (|>. peekI
-                     ($i;CHECKCAST ($t;descriptor ../runtime;$Variant))
+                     ($i;CHECKCAST ($t;descriptor ../runtime;$Tuple))
                      ($i;int (nat-to-int idx))
-                     flagI
-                     ($i;INVOKESTATIC hostL;runtime-class "pm_variant"
-                                      ($t;method (list ../runtime;$Variant ../runtime;$Tag ../runtime;$Flag)
-                                                 (#;Some ../runtime;$Datum)
+                     ($i;INVOKESTATIC hostL;runtime-class
+                                      <method>
+                                      ($t;method (list ../runtime;$Tuple $t;int)
+                                                 (#;Some $Object)
                                                  (list))
                                       false)
-                     $i;DUP
-                     ($i;IFNULL @fail)
-                     ($i;GOTO @success)
-                     ($i;label @fail)
-                     $i;POP
-                     ($i;GOTO @else)
-                     ($i;label @success)
                      pushI
-                     subI))))
-
-    (#ls;SeqP leftP rightP)
+                     subI)))))
+    (["lux case tuple left" "pm_left"]
+     ["lux case tuple right" "pm_right"])
+
+    (^template [<special> <flag>]
+      (^ [_ (#;Form (list [_ (#;Text <special>)] [_ (#;Nat idx)] subP))])
+      (do meta;Monad<Meta>
+        [subI (generate-path' generate stack-depth @else @end subP)]
+        (wrap (<| $i;with-label (function [@success])
+                  $i;with-label (function [@fail])
+                  (|>. peekI
+                       ($i;CHECKCAST ($t;descriptor ../runtime;$Variant))
+                       ($i;int (nat-to-int idx))
+                       <flag>
+                       ($i;INVOKESTATIC hostL;runtime-class "pm_variant"
+                                        ($t;method (list ../runtime;$Variant ../runtime;$Tag ../runtime;$Flag)
+                                                   (#;Some ../runtime;$Datum)
+                                                   (list))
+                                        false)
+                       $i;DUP
+                       ($i;IFNULL @fail)
+                       ($i;GOTO @success)
+                       ($i;label @fail)
+                       $i;POP
+                       ($i;GOTO @else)
+                       ($i;label @success)
+                       pushI
+                       subI)))))
+    (["lux case variant left" $i;NULL]
+     ["lux case variant right" ($i;string "")])
+    
+    (^ [_ (#;Form (list [_ (#;Text "lux case seq")] leftP rightP))])
     (do meta;Monad<Meta>
-      [leftI (generate-pattern' generate stack-depth @else @end leftP)
-       rightI (generate-pattern' generate stack-depth @else @end rightP)]
+      [leftI (generate-path' generate stack-depth @else @end leftP)
+       rightI (generate-path' generate stack-depth @else @end rightP)]
       (wrap (|>. leftI
                  rightI)))
 
-    (#ls;AltP leftP rightP)
+    (^ [_ (#;Form (list [_ (#;Text "lux case alt")] leftP rightP))])
     (do meta;Monad<Meta>
       [@alt-else $i;make-label
-       leftI (generate-pattern' generate (n.inc stack-depth) @alt-else @end leftP)
-       rightI (generate-pattern' generate stack-depth @else @end rightP)]
+       leftI (generate-path' generate (n.inc stack-depth) @alt-else @end leftP)
+       rightI (generate-path' generate stack-depth @else @end rightP)]
       (wrap (|>. $i;DUP
                  leftI
                  ($i;label @alt-else)
                  $i;POP
                  rightI)))
-    ))
 
-(def: (generate-pattern generate path @end)
+    _
+    (_;throw Unrecognized-Path (%code path))))
+
+(def: (generate-path generate path @end)
   (-> (-> ls;Synthesis (Meta $;Inst))
       ls;Path $;Label (Meta $;Inst))
   (do meta;Monad<Meta>
     [@else $i;make-label
-     pathI (generate-pattern' generate +1 @else @end path)]
+     pathI (generate-path' generate +1 @else @end path)]
     (wrap (|>. pathI
                ($i;label @else)
                $i;POP
@@ -208,7 +206,7 @@
   (do meta;Monad<Meta>
     [@end $i;make-label
      valueI (generate valueS)
-     pathI (generate-pattern generate path @end)]
+     pathI (generate-path generate path @end)]
     (wrap (|>. valueI
                $i;NULL
                $i;SWAP
diff --git a/new-luxc/source/luxc/generator/expr.jvm.lux b/new-luxc/source/luxc/generator/expr.jvm.lux
index 685bf2335..b439ff17a 100644
--- a/new-luxc/source/luxc/generator/expr.jvm.lux
+++ b/new-luxc/source/luxc/generator/expr.jvm.lux
@@ -1,9 +1,12 @@
 (;module:
   lux
   (lux (control monad
-                ["ex" exception #+ exception:])
-       (data text/format)
-       [meta #+ Monad<Meta> "Meta/" Monad<Meta>])
+                ["ex" exception #+ exception:]
+                ["p" parser])
+       (data ["e" error]
+             text/format)
+       [meta]
+       (meta ["s" syntax]))
   (luxc ["&" base]
         (lang ["ls" synthesis])
         ["&;" analyser]
@@ -24,48 +27,52 @@
 (def: #export (generate synthesis)
   (-> ls;Synthesis (Meta $;Inst))
   (case synthesis
-    #ls;Unit
+    [_ (#;Tuple #;Nil)]
     &primitive;generate-unit
 
+    (^ [_ (#;Tuple (list singleton))])
+    (generate singleton)
+
     (^template [<tag> <generator>]
-      (<tag> value)
+      [_ (<tag> value)]
       (<generator> value))
-    ([#ls;Bool &primitive;generate-bool]
-     [#ls;Nat  &primitive;generate-nat]
-     [#ls;Int  &primitive;generate-int]
-     [#ls;Deg  &primitive;generate-deg]
-     [#ls;Frac &primitive;generate-frac]
-     [#ls;Text &primitive;generate-text])
+    ([#;Bool &primitive;generate-bool]
+     [#;Nat  &primitive;generate-nat]
+     [#;Int  &primitive;generate-int]
+     [#;Deg  &primitive;generate-deg]
+     [#;Frac &primitive;generate-frac]
+     [#;Text &primitive;generate-text])
 
-    (#ls;Variant tag tail? member)
-    (&structure;generate-variant generate tag tail? member)
+    (^ [_ (#;Form (list [_ (#;Nat tag)] [_ (#;Bool last?)] valueS))])
+    (&structure;generate-variant generate tag last? valueS)
     
-    (#ls;Tuple members)
+    [_ (#;Tuple members)]
     (&structure;generate-tuple generate members)
 
-    (#ls;Variable var)
+    (^ [_ (#;Form (list [_ (#;Int var)]))])
     (if (functionS;captured? var)
       (&reference;generate-captured var)
       (&reference;generate-variable var))
 
-    (#ls;Definition definition)
+    [_ (#;Symbol definition)]
     (&reference;generate-definition definition)
 
-    (#ls;Let register inputS exprS)
+    (^ [_ (#;Form (list [_ (#;Text "lux let")] [_ (#;Nat register)] inputS exprS))])
     (caseG;generate-let generate register inputS exprS)
 
-    (#ls;Case inputS pathPS)
+    (^ [_ (#;Form (list [_ (#;Text "lux case")] inputS pathPS))])
     (caseG;generate-case generate inputS pathPS)
 
-    (#ls;Function arity env body)
-    (&function;generate-function generate env arity body)
+    (^multi (^ [_ (#;Form (list [_ (#;Text "lux function")] [_ (#;Nat arity)] [_ (#;Tuple environment)] bodyS))])
+            [(s;run environment (p;some s;int)) (#e;Success environment)])
+    (&function;generate-function generate environment arity bodyS)
 
-    (#ls;Call args function)
-    (&function;generate-call generate function args)
+    (^ [_ (#;Form (list& [_ (#;Text "lux call")] functionS argsS))])
+    (&function;generate-call generate functionS argsS)
 
-    (#ls;Procedure name args)
-    (&procedure;generate-procedure generate name args)
+    (^ [_ (#;Form (list& [_ (#;Text procedure)] argsS))])
+    (&procedure;generate-procedure generate procedure argsS)
 
     _
-    (&;throw Unrecognized-Synthesis "")
+    (&;throw Unrecognized-Synthesis (%code synthesis))
     ))
diff --git a/new-luxc/source/luxc/generator/procedure/common.jvm.lux b/new-luxc/source/luxc/generator/procedure/common.jvm.lux
index fd76082a6..7ae471c64 100644
--- a/new-luxc/source/luxc/generator/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/generator/procedure/common.jvm.lux
@@ -146,6 +146,10 @@
        ($i;CHECKCAST hostL;function-class)
        ($i;INVOKESTATIC hostL;runtime-class "try" try-method false)))
 
+(def: (lux//noop valueI)
+  Unary
+  valueI)
+
 ## [[Bits]]
 (do-template [<name> <op>]
   [(def: (<name> [inputI maskI])
@@ -536,6 +540,7 @@
 (def: lux-procs
   Bundle
   (|> (dict;new text;Hash<Text>)
+      (install "lux noop" (unary lux//noop))
       (install "lux is" (binary lux//is))
       (install "lux try" (unary lux//try))))
 
diff --git a/new-luxc/source/luxc/generator/procedure/host.jvm.lux b/new-luxc/source/luxc/generator/procedure/host.jvm.lux
index fc6bdd01b..44da5744d 100644
--- a/new-luxc/source/luxc/generator/procedure/host.jvm.lux
+++ b/new-luxc/source/luxc/generator/procedure/host.jvm.lux
@@ -37,6 +37,7 @@
 
   [L2S (|>. $i;L2I $i;I2S)]
   [L2B (|>. $i;L2I $i;I2B)]
+  [L2C (|>. $i;L2I $i;I2C)]
   )
 
 (do-template [<name> <unwrap> <conversion> <wrap>]
@@ -68,6 +69,7 @@
   [convert//long-to-int #$;Long $i;L2I #$;Int]
   [convert//long-to-short #$;Long L2S #$;Short]
   [convert//long-to-byte #$;Long L2B #$;Byte]
+  [convert//long-to-char #$;Long L2C #$;Char]
   [convert//char-to-byte #$;Char $i;I2B #$;Byte]
   [convert//char-to-short #$;Char $i;I2S #$;Short]
   [convert//char-to-int #$;Char $i;NOP #$;Int]
@@ -97,6 +99,7 @@
           (@;install "long-to-int" (@;unary convert//long-to-int))
           (@;install "long-to-short" (@;unary convert//long-to-short))
           (@;install "long-to-byte" (@;unary convert//long-to-byte))
+          (@;install "long-to-char" (@;unary convert//long-to-char))
           (@;install "char-to-byte" (@;unary convert//char-to-byte))
           (@;install "char-to-short" (@;unary convert//char-to-short))
           (@;install "char-to-int" (@;unary convert//char-to-int))
@@ -278,7 +281,7 @@
 (def: (array//new proc generate inputs)
   (-> Text @;Proc)
   (case inputs
-    (^ (list (#ls;Nat level) (#ls;Text class) lengthS))
+    (^ (list [_ (#;Nat level)] [_ (#;Text class)] lengthS))
     (do meta;Monad<Meta>
       [lengthI (generate lengthS)
        #let [arrayJT ($t;array level (case class
@@ -302,7 +305,7 @@
 (def: (array//read proc generate inputs)
   (-> Text @;Proc)
   (case inputs
-    (^ (list (#ls;Text class) idxS arrayS))
+    (^ (list [_ (#;Text class)] idxS arrayS))
     (do meta;Monad<Meta>
       [arrayI (generate arrayS)
        idxI (generate idxS)
@@ -328,7 +331,7 @@
 (def: (array//write proc generate inputs)
   (-> Text @;Proc)
   (case inputs
-    (^ (list (#ls;Text class) idxS valueS arrayS))
+    (^ (list [_ (#;Text class)] idxS valueS arrayS))
     (do meta;Monad<Meta>
       [arrayI (generate arrayS)
        idxI (generate idxS)
@@ -397,7 +400,7 @@
 (def: (object//class proc generate inputs)
   (-> Text @;Proc)
   (case inputs
-    (^ (list (#ls;Text class)))
+    (^ (list [_ (#;Text class)]))
     (do meta;Monad<Meta>
       []
       (wrap (|>. ($i;string class)
@@ -413,7 +416,7 @@
 (def: (object//instance? proc generate inputs)
   (-> Text @;Proc)
   (case inputs
-    (^ (list (#ls;Text class) objectS))
+    (^ (list [_ (#;Text class)] objectS))
     (do meta;Monad<Meta>
       [objectI (generate objectS)]
       (wrap (|>. objectI
@@ -450,7 +453,7 @@
 (def: (static//get proc generate inputs)
   (-> Text @;Proc)
   (case inputs
-    (^ (list (#ls;Text class) (#ls;Text field) (#ls;Text unboxed)))
+    (^ (list [_ (#;Text class)] [_ (#;Text field)] [_ (#;Text unboxed)]))
     (do meta;Monad<Meta>
       []
       (case (dict;get unboxed primitives)
@@ -477,7 +480,7 @@
 (def: (static//put proc generate inputs)
   (-> Text @;Proc)
   (case inputs
-    (^ (list (#ls;Text class) (#ls;Text field) (#ls;Text unboxed) valueS))
+    (^ (list [_ (#;Text class)] [_ (#;Text field)] [_ (#;Text unboxed)] valueS))
     (do meta;Monad<Meta>
       [valueI (generate valueS)]
       (case (dict;get unboxed primitives)
@@ -509,7 +512,7 @@
 (def: (virtual//get proc generate inputs)
   (-> Text @;Proc)
   (case inputs
-    (^ (list (#ls;Text class) (#ls;Text field) (#ls;Text unboxed) objectS))
+    (^ (list [_ (#;Text class)] [_ (#;Text field)] [_ (#;Text unboxed)] objectS))
     (do meta;Monad<Meta>
       [objectI (generate objectS)]
       (case (dict;get unboxed primitives)
@@ -540,7 +543,7 @@
 (def: (virtual//put proc generate inputs)
   (-> Text @;Proc)
   (case inputs
-    (^ (list (#ls;Text class) (#ls;Text field) (#ls;Text unboxed) valueS objectS))
+    (^ (list [_ (#;Text class)] [_ (#;Text field)] [_ (#;Text unboxed)] valueS objectS))
     (do meta;Monad<Meta>
       [valueI (generate valueS)
        objectI (generate objectS)]
@@ -632,7 +635,7 @@
     #;Nil
     (meta/wrap #;Nil)
 
-    (^ (list& [(#ls;Tuple (list (#ls;Text argD) argS))] tail))
+    (^ (list& [_ (#;Tuple (list [_ (#;Text argD)] argS))] tail))
     (do meta;Monad<Meta>
       [argT (generate-type argD)
        argI (:: @ map (prepare-input argT) (generate argS))
@@ -669,8 +672,8 @@
 (def: (invoke//static proc generate inputs)
   (-> Text @;Proc)
   (case inputs
-    (^ (list& (#ls;Text class) (#ls;Text method)
-              (#ls;Text unboxed) argsS))
+    (^ (list& [_ (#;Text class)] [_ (#;Text method)]
+              [_ (#;Text unboxed)] argsS))
     (do meta;Monad<Meta>
       [argsTI (generate-args generate argsS)
        returnT (method-return-type unboxed)
@@ -687,8 +690,8 @@
   [(def: (<name> proc generate inputs)
      (-> Text @;Proc)
      (case inputs
-       (^ (list& (#ls;Text class) (#ls;Text method)
-                 (#ls;Text unboxed) objectS argsS))
+       (^ (list& [_ (#;Text class)] [_ (#;Text method)]
+                 [_ (#;Text unboxed)] objectS argsS))
        (do meta;Monad<Meta>
          [objectI (generate objectS)
           argsTI (generate-args generate argsS)
@@ -712,7 +715,7 @@
 (def: (invoke//constructor proc generate inputs)
   (-> Text @;Proc)
   (case inputs
-    (^ (list& (#ls;Text class) argsS))
+    (^ (list& [_ (#;Text class)] argsS))
     (do meta;Monad<Meta>
       [argsTI (generate-args generate argsS)]
       (wrap (|>. ($i;NEW class)