- Fixed the tests.

- Fixed a few bugs.
- Can now translate recursion.

2 files changed, 45 insertions, 21 deletions

diff --git a/new-luxc/source/luxc/lang/synthesis/case.lux b/new-luxc/source/luxc/lang/synthesis/case.lux
index 8bc1e43f9..e230e2799 100644
--- a/new-luxc/source/luxc/lang/synthesis/case.lux
+++ b/new-luxc/source/luxc/lang/synthesis/case.lux
@@ -6,8 +6,10 @@
              [number]
              (coll [list "list/" Fold<List>]))
        (meta [code "code/" Eq<Code>]))
-  (luxc (lang ["la" analysis]
-              ["ls" synthesis])))
+  (luxc (lang [";L" variable #+ Variable]
+              ["la" analysis]
+              ["ls" synthesis]
+              (synthesis [";S" function]))))
 
 (def: #export (path outer-arity pattern)
   (-> ls;Arity la;Pattern ls;Path)
@@ -44,8 +46,8 @@
 
     (^code ("lux case bind" (~ [_ (#;Nat register)])))
     (` ("lux case seq"
-        ("lux case bind" (~ (if (n.> +1 outer-arity)
-                              (code;nat (n.+ (n.dec outer-arity) register))
+        ("lux case bind" (~ (if (functionS;nested? outer-arity)
+                              (code;nat (|> register variableL;local (functionS;adjust-var outer-arity) variableL;local-register))
                               (code;nat register))))
         ("lux case pop")))
 
@@ -69,16 +71,16 @@
        ["lux case variant left"]
        ["lux case variant right"])
 
-      (^ [[_ (#;Form (list [_ (#;Text "lux case seq")] left-pre left-post))]
-          [_ (#;Form (list [_ (#;Text "lux case seq")] right-pre right-post))]])
-      (case (weave left-pre right-pre)
-        (^ [_ (#;Form (list [_ (#;Text "lux case alt")] _ _))])
+      (^ [(^code ("lux case seq" (~ preL) (~ postL)))
+          (^code ("lux case seq" (~ preR) (~ postR)))])
+      (case (weave preL preR)
+        (^code ("lux case alt" (~ thenP) (~ elseP)))
         <default>
 
         weavedP
-        (` ("lux case seq" (~ weavedP) (~ (weave left-post right-post)))))
+        (` ("lux case seq" (~ weavedP) (~ (weave postL postR)))))
 
       _
       (if (code/= leftP rightP)
-        leftP
+        rightP
         <default>))))
diff --git a/new-luxc/source/luxc/lang/synthesis/expression.lux b/new-luxc/source/luxc/lang/synthesis/expression.lux
index 9ea397576..f761fb57c 100644
--- a/new-luxc/source/luxc/lang/synthesis/expression.lux
+++ b/new-luxc/source/luxc/lang/synthesis/expression.lux
@@ -23,7 +23,7 @@
 (def: init-resolver (Dict Int Int) (dict;new number;Hash<Int>))
 
 (def: (prepare-body inner-arity arity body)
-  (-> Nat Nat ls;Synthesis ls;Synthesis)
+  (-> ls;Arity ls;Arity ls;Synthesis ls;Synthesis)
   (if (functionS;nested? inner-arity)
     body
     (loopS;reify-recursion arity body)))
@@ -73,7 +73,11 @@
       inputS
 
       (^ (list [(^code ("lux case bind" (~ [_ (#;Nat register)]))) bodyA]))
-      (let$ register inputS (synthesize bodyA))
+      (let$ (if (functionS;nested? outer-arity)
+              (|> register variableL;local (functionS;adjust-var outer-arity) variableL;local-register)
+              register)
+            inputS
+            (synthesize bodyA))
       
       (^or (^ (list [(^code true) thenA] [(^code false) elseA]))
            (^ (list [(^code false) elseA] [(^code true) thenA])))
@@ -121,16 +125,17 @@
   (-> la;Analysis ls;Synthesis)
   (loop [outer-arity +0
          resolver init-resolver
+         direct? false
          num-locals +0
          expressionA expressionA]
     (case expressionA
       (^code [(~ _left) (~ _right)])
-      (` [(~@ (list/map (recur outer-arity resolver num-locals) (la;unfold-tuple expressionA)))])
+      (` [(~@ (list/map (recur outer-arity resolver false num-locals) (la;unfold-tuple expressionA)))])
 
       (^or (^code ("lux sum left" (~ _)))
            (^code ("lux sum right" (~ _))))
       (let [[tag last? value] (maybe;assume (la;unfold-variant expressionA))]
-        (variant$ tag last? (recur outer-arity resolver num-locals value)))
+        (variant$ tag last? (recur outer-arity resolver false num-locals value)))
 
       (^code ((~ [_ (#;Int var)])))
       (if (variableL;local? var)
@@ -143,17 +148,34 @@
         (var$ (maybe;default var (dict;get var resolver))))
 
       (^code ("lux case" (~ inputA) (~ [_ (#;Record branchesA)])))
-      (synthesize-case (recur outer-arity resolver num-locals) outer-arity inputA branchesA)
+      (synthesize-case (recur outer-arity resolver false num-locals) outer-arity inputA branchesA)
 
       (^multi (^code ("lux function" [(~@ scope)] (~ bodyA)))
               [(s;run scope (p;some s;int)) (#e;Success raw-env)])
-      (let [inner-arity (n.inc outer-arity)
-            env (list/map (function [var] (maybe;default var (dict;get var resolver))) raw-env)
+      (let [inner-arity (if direct?
+                          (n.inc outer-arity)
+                          +1)
+            env (list/map (function [closure]
+                            (case (dict;get closure resolver)
+                              (#;Some resolved)
+                              (if (and (variableL;local? resolved)
+                                       (functionS;nested? outer-arity)
+                                       (|> resolved variableL;local-register (n.>= outer-arity)))
+                                (functionS;adjust-var outer-arity resolved)
+                                resolved)
+
+                              #;None
+                              (if (and (variableL;local? closure)
+                                       (functionS;nested? outer-arity))
+                                (functionS;adjust-var outer-arity closure)
+                                closure)))
+                          raw-env)
             env-vars (: (List Variable)
                         (case raw-env
                           #;Nil (list)
                           _ (|> (list;size raw-env) n.dec (list;n.range +0) (list/map variableL;captured))))
-            resolver' (if (functionS;nested? inner-arity)
+            resolver' (if (and (functionS;nested? inner-arity)
+                               direct?)
                         (list/fold (function [[from to] resolver']
                                      (dict;put from to resolver'))
                                    init-resolver
@@ -162,7 +184,7 @@
                                      (dict;put var var resolver'))
                                    init-resolver
                                    env-vars))]
-        (case (recur inner-arity resolver' num-locals bodyA)
+        (case (recur inner-arity resolver' true num-locals bodyA)
           (^ [_ (#;Form (list [_ (#;Text "lux function")] [_ (#;Nat arity')] env' bodyS'))])
           (let [arity (n.inc arity')]
             (function$ arity env (prepare-body inner-arity arity bodyS')))
@@ -171,10 +193,10 @@
           (function$ +1 env (prepare-body inner-arity +1 bodyS))))
 
       (^code ("lux apply" (~@ _)))
-      (synthesize-apply (recur outer-arity resolver num-locals) outer-arity num-locals expressionA)
+      (synthesize-apply (recur outer-arity resolver false num-locals) outer-arity num-locals expressionA)
 
       (^code ((~ [_ (#;Text name)]) (~@ args)))
-      (procedure$ name (list/map (recur outer-arity resolver num-locals) args))
+      (procedure$ name (list/map (recur outer-arity resolver false num-locals) args))
 
       _
       expressionA)))