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

6 files changed, 107 insertions, 194 deletions

diff --git a/new-luxc/source/luxc/synthesizer.lux b/new-luxc/source/luxc/synthesizer.lux
index e1eb67bd7..e6730c5a3 100644
--- a/new-luxc/source/luxc/synthesizer.lux
+++ b/new-luxc/source/luxc/synthesizer.lux
@@ -12,14 +12,14 @@
              ["s" syntax]))
   (luxc ["&" base]
         (lang ["la" analysis]
-              ["ls" synthesis])
-        (synthesizer ["&&;" structure]
-                     ["&&;" case]
+              ["ls" synthesis]
+              [";L" variable #+ Variable])
+        (synthesizer ["&&;" case]
                      ["&&;" function]
                      ["&&;" loop])
         ))
 
-(def: init-env (List ls;Variable) (list))
+(def: init-env (List Variable) (list))
 (def: init-resolver (Dict Int Int) (dict;new number;Hash<Int>))
 
 (def: (prepare-body inner-arity arity body)
@@ -28,10 +28,6 @@
     body
     (&&loop;reify-recursion arity body)))
 
-(def: (parse-environment env)
-  (-> (List Code) (e;Error (List ls;Variable)))
-  (s;run env (p;some s;int)))
-
 (def: (let$ register inputS bodyS)
   (-> Nat ls;Synthesis ls;Synthesis ls;Synthesis)
   (` ("lux let" (~ (code;nat register)) (~ inputS) (~ bodyS))))
@@ -43,7 +39,7 @@
       (~ elseS))))
 
 (def: (function$ arity environment body)
-  (-> ls;Arity (List ls;Variable) ls;Synthesis ls;Synthesis)
+  (-> ls;Arity (List Variable) ls;Synthesis ls;Synthesis)
   (` ("lux function" (~ (code;nat arity))
       [(~@ (list/map code;int environment))]
       (~ body))))
@@ -53,7 +49,7 @@
   (` ((~ (code;nat tag)) (~ (code;bool last?)) (~ valueS))))
 
 (def: (var$ var)
-  (-> ls;Variable ls;Synthesis)
+  (-> Variable ls;Synthesis)
   (` ((~ (code;int var)))))
 
 (def: (procedure$ name argsS)
@@ -70,16 +66,17 @@
       ls;Synthesis)
   (let [inputS (synthesize inputA)]
     (case (list;reverse branchesA)
-      (^multi (^ (list [(#la;BindP input-register)
-                        (#la;Variable (#;Local output-register))]))
-              (n.= input-register output-register))
+      (^multi (^ (list [(^code ("lux case bind" (~ [_ (#;Nat input-register)])))
+                        (^code ((~ [_ (#;Int var)])))]))
+              (variableL;local? var)
+              (n.= input-register (int-to-nat var)))
       inputS
 
-      (^ (list [(#la;BindP register) bodyA]))
+      (^ (list [(^code ("lux case bind" (~ [_ (#;Nat register)]))) bodyA]))
       (let$ register inputS (synthesize bodyA))
       
-      (^or (^ (list [(#la;BoolP true) thenA] [(#la;BoolP false) elseA]))
-           (^ (list [(#la;BoolP false) elseA] [(#la;BoolP true) thenA])))
+      (^or (^ (list [(^code true) thenA] [(^code false) elseA]))
+           (^ (list [(^code false) elseA] [(^code true) thenA])))
       (if$ inputS (synthesize thenA) (synthesize elseA))
 
       (#;Cons [lastP lastA] prevsPA)
@@ -98,6 +95,28 @@
       (undefined)
       )))
 
+(def: (synthesize-apply synthesize outer-arity num-locals exprA)
+  (-> (-> la;Analysis ls;Synthesis) ls;Arity Nat la;Analysis ls;Synthesis)
+  (let [[funcA argsA] (&&function;unfold-apply exprA)
+        funcS (synthesize funcA)
+        argsS (list/map synthesize argsA)]
+    (case funcS
+      (^multi (^ [_ (#;Form (list [_ (#;Text "lux function")] [_ (#;Nat _arity)] [_ (#;Tuple _env)] _bodyS))])
+              (and (n.= _arity (list;size argsS))
+                   (not (&&loop;contains-self-reference? _bodyS)))
+              [(s;run _env (p;some s;int)) (#e;Success _env)])
+      (let [register-offset (if (&&function;top? outer-arity)
+                              num-locals
+                              (|> outer-arity n.inc (n.+ num-locals)))]
+        (` ("lux loop" (~ (code;nat register-offset)) [(~@ argsS)]
+            (~ (&&loop;adjust _env register-offset _bodyS)))))
+
+      (^ [_ (#;Form (list& [_ (#;Text "lux call")] funcS' argsS'))])
+      (call$ funcS' (list/compose argsS' argsS))
+
+      _
+      (call$ funcS argsS))))
+
 (def: #export (synthesize analysis)
   (-> la;Analysis ls;Synthesis)
   (loop [outer-arity +0
@@ -105,53 +124,39 @@
          num-locals +0
          exprA analysis]
     (case exprA
-      #la;Unit
-      (' [])
-
-      (^template [<from> <to>]
-        (<from> value)
-        (<to> value))
-      ([#la;Bool       code;bool]
-       [#la;Nat        code;nat]
-       [#la;Int        code;int]
-       [#la;Deg        code;deg]
-       [#la;Frac       code;frac]
-       [#la;Text       code;text]
-       [#la;Definition code;symbol])
-
-      (#la;Product _)
-      (` [(~@ (list/map (recur +0 resolver num-locals) (&&structure;unfold-tuple exprA)))])
-
-      (#la;Sum choice)
-      (let [[tag last? value] (&&structure;unfold-variant choice)]
+      (^code [(~ _left) (~ _right)])
+      (` [(~@ (list/map (recur +0 resolver num-locals) (la;unfold-tuple exprA)))])
+
+      (^or (^code ("lux sum left" (~ _)))
+           (^code ("lux sum right" (~ _))))
+      (let [[tag last? value] (maybe;assume (la;unfold-variant exprA))]
         (variant$ tag last? (recur +0 resolver num-locals value)))
 
-      (#la;Variable ref)
-      (case ref
-        (#;Local register)
-        (if (&&function;nested? outer-arity)
-          (if (n.= +0 register)
-            (call$ (var$ 0) (|> (list;n.range +1 (n.dec outer-arity))
-                                (list/map (|>. &&function;to-local code;int (~) () (`)))))
-            (var$ (&&function;adjust-var outer-arity (&&function;to-local register))))
-          (var$ (&&function;to-local register)))
-        
-        (#;Captured register)
-        (var$ (let [var (&&function;to-captured register)]
-                (maybe;default var (dict;get var resolver)))))
-
-      (#la;Case inputA branchesA)
+      (^code ((~ [_ (#;Int var)])))
+      (if (variableL;local? var)
+        (let [register (variableL;local-register var)]
+          (if (&&function;nested? outer-arity)
+            (if (n.= +0 register)
+              (call$ (var$ 0) (|> (list;n.range +1 (n.dec outer-arity))
+                                  (list/map (|>. variableL;local code;int (~) () (`)))))
+              (var$ (&&function;adjust-var outer-arity (variableL;local register))))
+            (var$ (variableL;local register))))
+        (let [register (variableL;captured-register var)]
+          (var$ (let [var (variableL;captured register)]
+                  (maybe;default var (dict;get var resolver))))))
+
+      (^code ("lux case" (~ inputA) (~ [_ (#;Record branchesA)])))
       (synthesize-case (recur +0 resolver num-locals) inputA branchesA)
-      
-      (#la;Function scope bodyA)
+
+      (^multi (^code ("lux function" [(~@ scope)] (~ bodyA)))
+              [(s;run scope (p;some s;int)) (#e;Success raw-env)])
       (let [inner-arity (n.inc outer-arity)
-            raw-env (&&function;environment scope)
             env (list/map (function [var] (maybe;default var (dict;get var resolver))) raw-env)
             env-vars (let [env-size (list;size raw-env)]
-                       (: (List ls;Variable)
+                       (: (List Variable)
                           (case env-size
                             +0 (list)
-                            _ (list/map &&function;to-captured (list;n.range +0 (n.dec env-size))))))
+                            _ (list/map variableL;captured (list;n.range +0 (n.dec env-size))))))
             resolver' (if (&&function;nested? inner-arity)
                         (list/fold (function [[from to] resolver']
                                      (dict;put from to resolver'))
@@ -169,27 +174,11 @@
           bodyS
           (function$ +1 env (prepare-body inner-arity +1 bodyS))))
 
-      (#la;Apply _)
-      (let [[funcA argsA] (&&function;unfold-apply exprA)
-            funcS (recur +0 resolver num-locals funcA)
-            argsS (list/map (recur +0 resolver num-locals) argsA)]
-        (case funcS
-          (^multi (^ [_ (#;Form (list [_ (#;Text "lux function")] [_ (#;Nat _arity)] [_ (#;Tuple _env)] _bodyS))])
-                  (and (n.= _arity (list;size argsS))
-                       (not (&&loop;contains-self-reference? _bodyS)))
-                  [(parse-environment _env) (#e;Success _env)])
-          (let [register-offset (if (&&function;top? outer-arity)
-                                  num-locals
-                                  (|> outer-arity n.inc (n.+ num-locals)))]
-            (` ("lux loop" (~ (code;nat register-offset)) [(~@ argsS)]
-                (~ (&&loop;adjust _env register-offset _bodyS)))))
-
-          (^ [_ (#;Form (list& [_ (#;Text "lux call")] funcS' argsS'))])
-          (call$ funcS' (list/compose argsS' argsS))
-
-          _
-          (call$ funcS argsS)))
-
-      (#la;Procedure name args)
+      (^code ("lux apply" (~@ _)))
+      (synthesize-apply synthesize outer-arity num-locals exprA)
+
+      (^code ((~ [_ (#;Text name)]) (~@ args)))
       (procedure$ name (list/map (recur +0 resolver num-locals) args))
-      )))
+
+      _
+      exprA)))
diff --git a/new-luxc/source/luxc/synthesizer/case.lux b/new-luxc/source/luxc/synthesizer/case.lux
index 91f339bdf..15cb6eca3 100644
--- a/new-luxc/source/luxc/synthesizer/case.lux
+++ b/new-luxc/source/luxc/synthesizer/case.lux
@@ -6,26 +6,12 @@
              (coll [list "list/" Fold<List>]))
        (meta [code "code/" Eq<Code>]))
   (luxc (lang ["la" analysis]
-              ["ls" synthesis])
-        (synthesizer ["&;" function])))
+              ["ls" synthesis])))
 
 (def: #export (path pattern)
   (-> la;Pattern ls;Path)
   (case pattern
-    (#la;BindP register)
-    (` ("lux case bind" (~ (code;nat register))))
-    
-    (^template [<from> <to>]
-      (<from> value)
-      (<to> value))
-    ([#la;BoolP code;bool]
-     [#la;NatP  code;nat]
-     [#la;IntP  code;int]
-     [#la;DegP  code;deg]
-     [#la;FracP code;frac]
-     [#la;TextP code;text])
-    
-    (#la;TupleP membersP)
+    (^code [(~@ membersP)])
     (case (list;reverse membersP)
       #;Nil
       (' ("lux case pop"))
@@ -45,11 +31,14 @@
                                        (` ("lux case tuple right" (~ (code;nat last-idx)) (~ (path lastP))))]
                                       prevsP)]
         tuple-path))
-    
-    (#la;VariantP tag num-tags memberP)
+
+    (^code ((~ [_ (#;Nat tag)]) (~ [_ (#;Nat num-tags)]) (~ memberP)))
     (if (n.= (n.dec num-tags) tag)
       (` ("lux case variant right" (~ (code;nat tag)) (~ (path memberP))))
-      (` ("lux case variant left" (~ (code;nat tag)) (~ (path memberP)))))))
+      (` ("lux case variant left" (~ (code;nat tag)) (~ (path memberP)))))
+
+    _
+    pattern))
 
 (def: #export (weave leftP rightP)
   (-> ls;Path ls;Path ls;Path)
diff --git a/new-luxc/source/luxc/synthesizer/function.lux b/new-luxc/source/luxc/synthesizer/function.lux
index 4d9970a3f..52aee9a49 100644
--- a/new-luxc/source/luxc/synthesizer/function.lux
+++ b/new-luxc/source/luxc/synthesizer/function.lux
@@ -1,31 +1,8 @@
 (;module:
   lux
-  (lux (data (coll [list "list/" Functor<List>])))
   (luxc (lang ["la" analysis]
-              ["ls" synthesis])))
-
-(def: #export (environment scope)
-  (-> Scope (List ls;Variable))
-  (|> scope
-      (get@ [#;captured #;mappings])
-      (list/map (function [[_ _ ref]]
-                  (case ref
-                    (#;Local idx)
-                    (nat-to-int idx)
-                    
-                    (#;Captured idx)
-                    (|> idx n.inc nat-to-int (i.* -1))
-                    )))))
-
-(do-template [<name> <comp>]
-  [(def: #export (<name> var)
-     (-> ls;Variable Bool)
-     (<comp> 0 var))]
-
-  [self?     i.=]
-  [local?    i.>]
-  [captured? i.<]
-  )
+              ["ls" synthesis]
+              [";L" variable #+ Variable])))
 
 (do-template [<name> <comp> <ref>]
   [(def: #export (<name> arity)
@@ -37,27 +14,15 @@
   )
 
 (def: #export (adjust-var outer var)
-  (-> ls;Arity ls;Variable ls;Variable)
+  (-> ls;Arity Variable Variable)
   (|> outer n.dec nat-to-int (i.+ var)))
 
-(def: #export (to-captured idx)
-  (-> Nat Int)
-  (|> idx n.inc nat-to-int (i.* -1)))
-
-(def: #export (captured-idx idx)
-  (-> Int Nat)
-  (|> idx (i.* -1) int-to-nat n.dec))
-
-(def: #export (to-local idx)
-  (-> Nat Int)
-  (nat-to-int idx))
-
 (def: #export (unfold-apply apply)
   (-> la;Analysis [la;Analysis (List la;Analysis)])
   (loop [apply apply
          args (list)]
     (case apply
-      (#la;Apply arg func)
+      (^code ("lux apply" (~ arg) (~ func)))
       (recur func (#;Cons arg args))
 
       _
diff --git a/new-luxc/source/luxc/synthesizer/loop.lux b/new-luxc/source/luxc/synthesizer/loop.lux
index 8599db981..0070fcd5d 100644
--- a/new-luxc/source/luxc/synthesizer/loop.lux
+++ b/new-luxc/source/luxc/synthesizer/loop.lux
@@ -6,8 +6,8 @@
              (coll [list "list/" Functor<List>]))
        (meta [code]
              [syntax]))
-  (luxc (lang ["ls" synthesis])
-        (synthesizer ["&&;" function])))
+  (luxc (lang ["ls" synthesis]
+              [";L" variable #+ Variable Register])))
 
 (def: #export (contains-self-reference? exprS)
   (-> ls;Synthesis Bool)
@@ -19,7 +19,7 @@
     (list;any? contains-self-reference? membersS)
 
     (^ [_ (#;Form (list [_ (#;Int var)]))])
-    (&&function;self? var)
+    (variableL;self? var)
 
     (^ [_ (#;Form (list [_ (#;Text "lux case")] inputS pathS))])
     (or (contains-self-reference? inputS)
@@ -40,7 +40,7 @@
     (list;any? (function [captured]
                  (case captured
                    (^ [_ (#;Form (list [_ (#;Int var)]))])
-                   (&&function;self? var)
+                   (variableL;self? var)
 
                    _
                    false))
@@ -109,8 +109,8 @@
       )))
 
 (def: #export (adjust env outer-offset exprS)
-  (-> (List ls;Variable) ls;Register ls;Synthesis ls;Synthesis)
-  (let [resolve-captured (: (-> ls;Variable ls;Variable)
+  (-> (List Variable) Register ls;Synthesis ls;Synthesis)
+  (let [resolve-captured (: (-> Variable Variable)
                             (function [var]
                               (let [idx (|> var (i.* -1) int-to-nat n.dec)]
                                 (|> env (list;nth idx) maybe;assume))))]
@@ -161,7 +161,7 @@
         (` ((~ (code;text procedure)) (~@ (list/map recur argsS))))
 
         (^ [_ (#;Form (list [_ (#;Int var)]))])
-        (if (&&function;captured? var)
+        (if (variableL;captured? var)
           (` ((~ (code;int (resolve-captured var)))))
           (` ((~ (code;int (|> outer-offset nat-to-int (i.+ var)))))))
 
diff --git a/new-luxc/source/luxc/synthesizer/structure.lux b/new-luxc/source/luxc/synthesizer/structure.lux
deleted file mode 100644
index 403817c53..000000000
--- a/new-luxc/source/luxc/synthesizer/structure.lux
+++ /dev/null
@@ -1,28 +0,0 @@
-(;module:
-  lux
-  (luxc (lang ["la" analysis])))
-
-(def: #export (unfold-tuple tuple)
-  (-> la;Analysis (List la;Analysis))
-  (case tuple
-    (#la;Product left right)
-    (#;Cons left (unfold-tuple right))
-
-    _
-    (list tuple)))
-
-(def: #export (unfold-variant variant)
-  (-> (Either la;Analysis la;Analysis) [Nat Bool la;Analysis])
-  (loop [so-far +0
-         variantA variant]
-    (case variantA
-      (#;Left valueA)
-      (case valueA
-        (#la;Sum choice)
-        (recur (n.inc so-far) choice)
-
-        _
-        [so-far false valueA])
-      
-      (#;Right valueA)
-      [(n.inc so-far) true valueA])))
diff --git a/new-luxc/source/luxc/synthesizer/variable.lux b/new-luxc/source/luxc/synthesizer/variable.lux
index 01ad101fa..3ce9f2678 100644
--- a/new-luxc/source/luxc/synthesizer/variable.lux
+++ b/new-luxc/source/luxc/synthesizer/variable.lux
@@ -1,22 +1,20 @@
 (;module:
   lux
-  (lux (data [bool "B/" Eq<Bool>]
-             [text "T/" Eq<Text>]
-             [number]
-             (coll [list "L/" Functor<List> Fold<List> Monoid<List>]
+  (lux (data [number]
+             (coll [list "list/" Fold<List> Monoid<List>]
                    ["s" set])))
   (luxc (lang ["la" analysis]
-              ["ls" synthesis])
-        (synthesizer ["&;" function])))
+              ["ls" synthesis]
+              [";L" variable #+ Variable])))
 
 (def: (bound-vars path)
-  (-> ls;Path (List ls;Variable))
+  (-> ls;Path (List Variable))
   (case path
     (#ls;BindP register)
     (list (nat-to-int register))
 
     (^or (#ls;SeqP pre post) (#ls;AltP pre post))
-    (L/compose (bound-vars pre) (bound-vars post))
+    (list/compose (bound-vars pre) (bound-vars post))
     
     _
     (list)))
@@ -31,24 +29,24 @@
     (path-bodies post)
 
     (#ls;AltP pre post)
-    (L/compose (path-bodies pre) (path-bodies post))
+    (list/compose (path-bodies pre) (path-bodies post))
     
     _
     (list)))
 
 (def: (non-arg? arity var)
-  (-> ls;Arity ls;Variable Bool)
-  (and (&function;local? var)
+  (-> ls;Arity Variable Bool)
+  (and (variableL;local? var)
        (n.> arity (int-to-nat var))))
 
-(type: Tracker (s;Set ls;Variable))
+(type: Tracker (s;Set Variable))
 
 (def: init-tracker Tracker (s;new number;Hash<Int>))
 
 (def: (unused-vars current-arity bound exprS)
-  (-> ls;Arity (List ls;Variable) ls;Synthesis (List ls;Variable))
+  (-> ls;Arity (List Variable) ls;Synthesis (List Variable))
   (let [tracker (loop [exprS exprS
-                       tracker (L/fold s;add init-tracker bound)]
+                       tracker (list/fold s;add init-tracker bound)]
                   (case exprS
                     (#ls;Variable var)
                     (if (non-arg? current-arity var)
@@ -59,14 +57,14 @@
                     (recur memberS tracker)
 
                     (#ls;Tuple membersS)
-                    (L/fold recur tracker membersS)
+                    (list/fold recur tracker membersS)
 
                     (#ls;Call funcS argsS)
-                    (L/fold recur (recur funcS tracker) argsS)
+                    (list/fold recur (recur funcS tracker) argsS)
                     
                     (^or (#ls;Recur argsS)
                          (#ls;Procedure name argsS))
-                    (L/fold recur tracker argsS)
+                    (list/fold recur tracker argsS)
 
                     (#ls;Let offset inputS outputS)
                     (|> tracker (recur inputS) (recur outputS))
@@ -75,16 +73,16 @@
                     (|> tracker (recur testS) (recur thenS) (recur elseS))
 
                     (#ls;Loop offset initsS bodyS)
-                    (recur bodyS (L/fold recur tracker initsS))
+                    (recur bodyS (list/fold recur tracker initsS))
 
                     (#ls;Case inputS outputPS)
-                    (let [tracker' (L/fold s;add
-                                           (recur inputS tracker)
-                                           (bound-vars outputPS))]
-                      (L/fold recur tracker' (path-bodies outputPS)))
+                    (let [tracker' (list/fold s;add
+                                              (recur inputS tracker)
+                                              (bound-vars outputPS))]
+                      (list/fold recur tracker' (path-bodies outputPS)))
 
                     (#ls;Function arity env bodyS)
-                    (L/fold s;remove tracker env)
+                    (list/fold s;remove tracker env)
 
                     _
                     tracker