aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/synthesis
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/lang/synthesis/case.lux25
-rw-r--r--new-luxc/source/luxc/lang/synthesis/expression.lux8
2 files changed, 21 insertions, 12 deletions
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)])