blob: 222bd7c0e3a22caa0508672758de448013c71dc0 (
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
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
|
(.using
[library
[lux {"-" Type static has}
[abstract
[monad {"+" do}]
[monoid {"+" Monoid}]]
[control
["[0]" try {"+" Try}]
["[0]" exception {"+" exception:}]]]]
[/
["/[0]" limit {"+" Limit}
["/[0]" stack {"+" Stack}]
["/[0]" registry {"+" Registry}]]
[///
[encoding
[unsigned {"+" U2}]]
[type {"+" Type}
[category {"+" Method}]]]])
(type: .public Environment
(Record
[#limit Limit
#stack (Maybe Stack)]))
(template [<name> <limit>]
[(def: .public (<name> type)
(-> (Type Method) (Try Environment))
(do try.monad
[limit (<limit> type)]
(in [#limit limit
#stack {.#Some /stack.empty}])))]
[static /limit.static]
[virtual /limit.virtual]
)
(type: .public Condition
(-> Environment (Try Environment)))
(implementation: .public monoid
(Monoid Condition)
(def: identity
(|>> {try.#Success}))
(def: (composite left right)
(function (_ environment)
(do try.monad
[environment (left environment)]
(right environment)))))
(exception: .public discontinuity)
(def: .public (stack environment)
(-> Environment (Try Stack))
(case (the ..#stack environment)
{.#Some stack}
{try.#Success stack}
{.#None}
(exception.except ..discontinuity [])))
(def: .public discontinue
(-> Environment Environment)
(.has ..#stack {.#None}))
(exception: .public (mismatched_stacks [expected Stack
actual Stack])
(exception.report
["Expected" (/stack.format expected)]
["Actual" (/stack.format actual)]))
(def: .public (continue expected environment)
(-> Stack Environment (Try [Stack Environment]))
(case (the ..#stack environment)
{.#Some actual}
(if (# /stack.equivalence = expected actual)
{try.#Success [actual environment]}
(exception.except ..mismatched_stacks [expected actual]))
{.#None}
{try.#Success [expected (.has ..#stack {.#Some expected} environment)]}))
(def: .public (consumes amount)
(-> U2 Condition)
... TODO: Revisit this definition once lenses/optics have been implemented,
... since it can probably be simplified with them.
(function (_ environment)
(do try.monad
[previous (..stack environment)
current (/stack.pop amount previous)]
(in (.has ..#stack {.#Some current} environment)))))
(def: .public (produces amount)
(-> U2 Condition)
(function (_ environment)
(do try.monad
[previous (..stack environment)
current (/stack.push amount previous)
.let [limit (|> environment
(the [..#limit /limit.#stack])
(/stack.max current))]]
(in (|> environment
(.has ..#stack {.#Some current})
(.has [..#limit /limit.#stack] limit))))))
(def: .public (has registry)
(-> Registry Condition)
(|>> (revised [..#limit /limit.#registry] (/registry.has registry))
{try.#Success}))
|
