From cab9451961fa25fd6683c1c7bd836941bd84e48b Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Mon, 6 Nov 2017 18:34:51 -0400
Subject: - Fixed some bugs.

---
 new-luxc/source/luxc/lang/synthesis/case.lux       | 25 +++++++++++++++-------
 new-luxc/source/luxc/lang/synthesis/expression.lux |  8 +++----
 2 files changed, 21 insertions(+), 12 deletions(-)

(limited to 'new-luxc/source/luxc/lang/synthesis')

diff --git a/new-luxc/source/luxc/lang/synthesis/case.lux b/new-luxc/source/luxc/lang/synthesis/case.lux
index e66bbf3a8..8bc1e43f9 100644
--- a/new-luxc/source/luxc/lang/synthesis/case.lux
+++ b/new-luxc/source/luxc/lang/synthesis/case.lux
@@ -9,8 +9,8 @@
   (luxc (lang ["la" analysis]
               ["ls" synthesis])))
 
-(def: #export (path pattern)
-  (-> la;Pattern ls;Path)
+(def: #export (path outer-arity pattern)
+  (-> ls;Arity la;Pattern ls;Path)
   (case pattern
     (^code ("lux case tuple" [(~@ membersP)]))
     (case (list;reverse membersP)
@@ -18,7 +18,7 @@
       (' ("lux case pop"))
 
       (#;Cons singletonP #;Nil)
-      (path singletonP)
+      (path outer-arity singletonP)
 
       (#;Cons lastP prevsP)
       (let [length (list;size membersP)
@@ -26,10 +26,10 @@
             [_ tuple-path] (list/fold (function [current-pattern [current-idx next-path]]
                                         [(n.dec current-idx)
                                          (` ("lux case seq"
-                                             ("lux case tuple left" (~ (code;nat current-idx)) (~ (path current-pattern)))
+                                             ("lux case tuple left" (~ (code;nat current-idx)) (~ (path outer-arity current-pattern)))
                                              (~ next-path)))])
                                       [(n.dec last-idx)
-                                       (` ("lux case tuple right" (~ (code;nat last-idx)) (~ (path lastP))))]
+                                       (` ("lux case tuple right" (~ (code;nat last-idx)) (~ (path outer-arity lastP))))]
                                       prevsP)]
         (` ("lux case seq"
             (~ tuple-path)
@@ -38,12 +38,21 @@
     (^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 variant right" (~ (code;nat tag)) (~ (path outer-arity memberP))))
+             (` ("lux case variant left" (~ (code;nat tag)) (~ (path outer-arity memberP))))))
+        ("lux case pop")))
+
+    (^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))
+                              (code;nat register))))
         ("lux case pop")))
 
     _
-    pattern))
+    (` ("lux case seq"
+        (~ pattern)
+        ("lux case pop")))))
 
 (def: #export (weave leftP rightP)
   (-> ls;Path ls;Path ls;Path)
diff --git a/new-luxc/source/luxc/lang/synthesis/expression.lux b/new-luxc/source/luxc/lang/synthesis/expression.lux
index 531606ba7..9ea397576 100644
--- a/new-luxc/source/luxc/lang/synthesis/expression.lux
+++ b/new-luxc/source/luxc/lang/synthesis/expression.lux
@@ -60,9 +60,9 @@
   (-> ls;Synthesis (List ls;Synthesis) ls;Synthesis)
   (` ("lux call" (~ funcS) (~@ argsS))))
 
-(def: (synthesize-case synthesize inputA branchesA)
+(def: (synthesize-case synthesize outer-arity inputA branchesA)
   (-> (-> la;Analysis ls;Synthesis)
-      la;Analysis (List [la;Pattern la;Analysis])
+      ls;Arity la;Analysis (List [la;Pattern la;Analysis])
       ls;Synthesis)
   (let [inputS (synthesize inputA)]
     (case (list;reverse branchesA)
@@ -84,7 +84,7 @@
                                 (function [pattern expr]
                                   (|> (synthesize expr)
                                       (~) ("lux case exec")
-                                      ("lux case seq" (~ (caseS;path pattern)))
+                                      ("lux case seq" (~ (caseS;path outer-arity pattern)))
                                       (`))))
             pathS (list/fold caseS;weave
                              (transform-branch lastP lastA)
@@ -143,7 +143,7 @@
         (var$ (maybe;default var (dict;get var resolver))))
 
       (^code ("lux case" (~ inputA) (~ [_ (#;Record branchesA)])))
-      (synthesize-case (recur outer-arity resolver num-locals) inputA branchesA)
+      (synthesize-case (recur outer-arity resolver num-locals) outer-arity inputA branchesA)
 
       (^multi (^code ("lux function" [(~@ scope)] (~ bodyA)))
               [(s;run scope (p;some s;int)) (#e;Success raw-env)])
-- 
cgit v1.2.3