- Minor refactorings.

- Fixed some bugs.
- Enabled macro-expansion for statements.

2 files changed, 38 insertions, 37 deletions

diff --git a/new-luxc/source/luxc/lang/synthesis/case.lux b/new-luxc/source/luxc/lang/synthesis/case.lux
index 15cb6eca3..e66bbf3a8 100644
--- a/new-luxc/source/luxc/lang/synthesis/case.lux
+++ b/new-luxc/source/luxc/lang/synthesis/case.lux
@@ -2,6 +2,7 @@
   lux
   (lux (data [bool "bool/" Eq<Bool>]
              [text "text/" Eq<Text>]
+             text/format
              [number]
              (coll [list "list/" Fold<List>]))
        (meta [code "code/" Eq<Code>]))
@@ -11,7 +12,7 @@
 (def: #export (path pattern)
   (-> la;Pattern ls;Path)
   (case pattern
-    (^code [(~@ membersP)])
+    (^code ("lux case tuple" [(~@ membersP)]))
     (case (list;reverse membersP)
       #;Nil
       (' ("lux case pop"))
@@ -30,12 +31,16 @@
                                       [(n.dec last-idx)
                                        (` ("lux case tuple right" (~ (code;nat last-idx)) (~ (path lastP))))]
                                       prevsP)]
-        tuple-path))
+        (` ("lux case seq"
+            (~ tuple-path)
+            ("lux case pop")))))
 
-    (^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)))))
+    (^code ("lux case variant" (~ [_ (#;Nat tag)]) (~ [_ (#;Nat num-tags)]) (~ memberP)))
+    (` ("lux case seq"
+        (~ (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 pop")))
 
     _
     pattern))
diff --git a/new-luxc/source/luxc/lang/synthesis/expression.lux b/new-luxc/source/luxc/lang/synthesis/expression.lux
index 05b99923b..531606ba7 100644
--- a/new-luxc/source/luxc/lang/synthesis/expression.lux
+++ b/new-luxc/source/luxc/lang/synthesis/expression.lux
@@ -85,11 +85,11 @@
                                   (|> (synthesize expr)
                                       (~) ("lux case exec")
                                       ("lux case seq" (~ (caseS;path pattern)))
-                                      (`))))]
-        (` ("lux case" (~ inputS)
-            (~ (list/fold caseS;weave
-                          (transform-branch lastP lastA)
-                          (list/map (product;uncurry transform-branch) prevsPA))))))
+                                      (`))))
+            pathS (list/fold caseS;weave
+                             (transform-branch lastP lastA)
+                             (list/map (product;uncurry transform-branch) prevsPA))]
+        (` ("lux case" (~ inputS) (~ pathS))))
 
       _
       (undefined)
@@ -117,46 +117,42 @@
       _
       (call$ funcS argsS))))
 
-(def: #export (synthesize analysis)
+(def: #export (synthesize expressionA)
   (-> la;Analysis ls;Synthesis)
   (loop [outer-arity +0
          resolver init-resolver
          num-locals +0
-         exprA analysis]
-    (case exprA
+         expressionA expressionA]
+    (case expressionA
       (^code [(~ _left) (~ _right)])
-      (` [(~@ (list/map (recur +0 resolver num-locals) (la;unfold-tuple exprA)))])
+      (` [(~@ (list/map (recur outer-arity resolver num-locals) (la;unfold-tuple expressionA)))])
 
       (^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)))
+      (let [[tag last? value] (maybe;assume (la;unfold-variant expressionA))]
+        (variant$ tag last? (recur outer-arity resolver num-locals value)))
 
       (^code ((~ [_ (#;Int var)])))
       (if (variableL;local? var)
-        (let [register (variableL;local-register var)]
-          (if (functionS;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$ (functionS;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))))))
+        (if (functionS;nested? outer-arity)
+          (if (variableL;self? var)
+            (call$ (var$ 0) (|> (list;n.range +1 (n.dec outer-arity))
+                                (list/map (|>. variableL;local code;int (~) () (`)))))
+            (var$ (functionS;adjust-var outer-arity var)))
+          (var$ var))
+        (var$ (maybe;default var (dict;get var resolver))))
 
       (^code ("lux case" (~ inputA) (~ [_ (#;Record branchesA)])))
-      (synthesize-case (recur +0 resolver num-locals) inputA branchesA)
+      (synthesize-case (recur outer-arity resolver num-locals) 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)
-            env-vars (let [env-size (list;size raw-env)]
-                       (: (List Variable)
-                          (case env-size
-                            +0 (list)
-                            _ (list/map variableL;captured (list;n.range +0 (n.dec env-size))))))
+            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)
                         (list/fold (function [[from to] resolver']
                                      (dict;put from to resolver'))
@@ -166,7 +162,7 @@
                                      (dict;put var var resolver'))
                                    init-resolver
                                    env-vars))]
-        (case (recur inner-arity resolver' +0 bodyA)
+        (case (recur inner-arity resolver' 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')))
@@ -175,10 +171,10 @@
           (function$ +1 env (prepare-body inner-arity +1 bodyS))))
 
       (^code ("lux apply" (~@ _)))
-      (synthesize-apply synthesize outer-arity num-locals exprA)
+      (synthesize-apply (recur outer-arity resolver num-locals) outer-arity num-locals expressionA)
 
       (^code ((~ [_ (#;Text name)]) (~@ args)))
-      (procedure$ name (list/map (recur +0 resolver num-locals) args))
+      (procedure$ name (list/map (recur outer-arity resolver num-locals) args))
 
       _
-      exprA)))
+      expressionA)))