blob: 91f339bdf7d050bf524388eddbb043ea7d7a510c (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
|
(;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])
(synthesizer ["&;" function])))
(def: #export (path pattern)
(-> la;Pattern ls;Path)
(case pattern
(#la;BindP register)
(` ("lux case bind" (~ (code;nat register))))
(^template [<from> <to>]
(<from> value)
(<to> value))
([#la;BoolP code;bool]
[#la;NatP code;nat]
[#la;IntP code;int]
[#la;DegP code;deg]
[#la;FracP code;frac]
[#la;TextP code;text])
(#la;TupleP 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))
(#la;VariantP tag 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)))))))
(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>))))
|
