diff options
Diffstat (limited to '')
| -rw-r--r-- | new-luxc/source/luxc/lang/synthesis/case.lux | 25 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/synthesis/expression.lux | 8 |
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)]) |