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 +++++++++++++++++--------
 1 file changed, 17 insertions(+), 8 deletions(-)

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

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)
-- 
cgit v1.2.3