blob: 8405c7152179ef3ff0743255746344d45ffdc7da (
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
|
(.using
[library
[lux "*"
[data
[collection
["[0]" list ("[1]#[0]" mix)]]]
[math
[number
["n" nat]]]
[meta
["[0]" location]]]]
[//
[functor {"+" Functor}]])
(type: .public (CoMonad w)
(Interface
(: (Functor w)
&functor)
(: (All (_ a)
(-> (w a) a))
out)
(: (All (_ a)
(-> (w a) (w (w a))))
disjoint)))
(macro: .public (be tokens state)
(case (: (Maybe [(Maybe Text) Code (List Code) Code])
(case tokens
(^ (list [_ {.#Tuple (list [_ {.#Symbol ["" name]}] comonad)}] [_ {.#Tuple bindings}] body))
{.#Some [{.#Some name} comonad bindings body]}
(^ (list comonad [_ {.#Tuple bindings}] body))
{.#Some [{.#None} comonad bindings body]}
_
{.#None}))
{.#Some [?name comonad bindings body]}
(case (list.pairs bindings)
{.#Some bindings}
(let [[module short] (symbol ..be)
symbol (: (-> Text Code)
(|>> ($_ "lux text concat" module " " short " ") [""] {.#Symbol} [location.dummy]))
g!_ (symbol "_")
g!each (symbol "each")
g!disjoint (symbol "disjoint")
body' (list#mix (: (-> [Code Code] Code Code)
(function (_ binding body')
(with_expansions [<default> (` (|> (~ value) (~ g!disjoint) ((~ g!each) (function ((~ g!_) (~ var)) (~ body')))))]
(let [[var value] binding]
(case var
[_ {.#Symbol ["" _]}]
<default>
[_ {.#Symbol _}]
(` ((~ var) (~ value) (~ body')))
_
<default>)))))
body
(list.reversed bindings))]
{.#Right [state (list (case ?name
{.#Some name}
(let [name [location.dummy {.#Symbol ["" name]}]]
(` (.case (~ comonad)
(~ name)
(.case (~ name)
[(~ g!each) (~' out) (~ g!disjoint)]
(~ body')))))
{.#None}
(` (.case (~ comonad)
[(~ g!each) (~' out) (~ g!disjoint)]
(~ body')))))]})
{.#None}
{.#Left "'be' bindings must have an even number of parts."})
{.#None}
{.#Left "Wrong syntax for 'be'"}))
|
