aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/synthesizer/case.lux
diff options
context:
space:
mode:
authorEduardo Julian2017-11-01 00:04:43 -0400
committerEduardo Julian2017-11-01 00:04:43 -0400
commit71d7a4c7206155e09f3e1e1d8699561ea6967382 (patch)
tree866b104d1552fe71ff52b0241f7e2fd260ff77bf /new-luxc/source/luxc/synthesizer/case.lux
parent7cc935bd3d2e716bfeb006badeeaa8bb05927d11 (diff)
- Re-organized synthesis.
Diffstat (limited to 'new-luxc/source/luxc/synthesizer/case.lux')
-rw-r--r--new-luxc/source/luxc/synthesizer/case.lux70
1 files changed, 0 insertions, 70 deletions
diff --git a/new-luxc/source/luxc/synthesizer/case.lux b/new-luxc/source/luxc/synthesizer/case.lux
deleted file mode 100644
index 15cb6eca3..000000000
--- a/new-luxc/source/luxc/synthesizer/case.lux
+++ /dev/null
@@ -1,70 +0,0 @@
-(;module:
- lux
- (lux (data [bool "bool/" Eq<Bool>]
- [text "text/" Eq<Text>]
- [number]
- (coll [list "list/" Fold<List>]))
- (meta [code "code/" Eq<Code>]))
- (luxc (lang ["la" analysis]
- ["ls" synthesis])))
-
-(def: #export (path pattern)
- (-> la;Pattern ls;Path)
- (case pattern
- (^code [(~@ membersP)])
- (case (list;reverse membersP)
- #;Nil
- (' ("lux case pop"))
-
- (#;Cons singletonP #;Nil)
- (path singletonP)
-
- (#;Cons lastP prevsP)
- (let [length (list;size membersP)
- last-idx (n.dec length)
- [_ 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)))
- (~ next-path)))])
- [(n.dec last-idx)
- (` ("lux case tuple right" (~ (code;nat last-idx)) (~ (path lastP))))]
- prevsP)]
- tuple-path))
-
- (^code ((~ [_ (#;Nat tag)]) (~ [_ (#;Nat num-tags)]) (~ memberP)))
- (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)))))
-
- _
- pattern))
-
-(def: #export (weave leftP rightP)
- (-> ls;Path ls;Path ls;Path)
- (with-expansions [<default> (as-is (` ("lux case alt" (~ leftP) (~ rightP))))]
- (case [leftP rightP]
- (^template [<special>]
- (^ [[_ (#;Form (list [_ (#;Text <special>)] [_ (#;Nat left-idx)] left-then))]
- [_ (#;Form (list [_ (#;Text <special>)] [_ (#;Nat right-idx)] right-then))]])
- (if (n.= left-idx right-idx)
- (` (<special> (~ (code;nat left-idx)) (~ (weave left-then right-then))))
- <default>))
- (["lux case tuple left"]
- ["lux case tuple right"]
- ["lux case variant left"]
- ["lux case variant right"])
-
- (^ [[_ (#;Form (list [_ (#;Text "lux case seq")] left-pre left-post))]
- [_ (#;Form (list [_ (#;Text "lux case seq")] right-pre right-post))]])
- (case (weave left-pre right-pre)
- (^ [_ (#;Form (list [_ (#;Text "lux case alt")] _ _))])
- <default>
-
- weavedP
- (` ("lux case seq" (~ weavedP) (~ (weave left-post right-post)))))
-
- _
- (if (code/= leftP rightP)
- leftP
- <default>))))