diff options
author | Eduardo Julian | 2017-11-06 18:34:51 -0400 |
---|---|---|
committer | Eduardo Julian | 2017-11-06 18:34:51 -0400 |
commit | cab9451961fa25fd6683c1c7bd836941bd84e48b (patch) | |
tree | a03e681579ecc34a84881a2efd8efacea2420e9f /new-luxc/source/luxc/lang/synthesis/case.lux | |
parent | 4e932a33ac56bb3cb1d7b49771e770e8c373bf8e (diff) |
- Fixed some bugs.
Diffstat (limited to 'new-luxc/source/luxc/lang/synthesis/case.lux')
-rw-r--r-- | new-luxc/source/luxc/lang/synthesis/case.lux | 25 |
1 files changed, 17 insertions, 8 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) |