blob: 9fd4d7250efb3ca0197878226cfc13f1b4fd94a2 (
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
|
(.require
[library
[lux (.except Type static has)
[abstract
[monad (.only do)]
[monoid (.only Monoid)]]
[control
["[0]" try (.only Try)]
["[0]" exception (.only Exception)]]]]
[/
["/[0]" limit (.only Limit)
["/[0]" stack (.only Stack)]
["/[0]" registry (.only Registry)]]
[///
[encoding
[unsigned (.only U2)]]
[type (.only Type)
[category (.only Method)]]]])
(type .public Environment
(Record
[#limit Limit
#stack (Maybe Stack)]))
(with_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)))
(def .public monoid
(Monoid Condition)
(implementation
(def identity
(|>> {try.#Success}))
(def (composite left right)
(function (_ environment)
(do try.monad
[environment (left environment)]
(right environment))))))
(exception.def .public discontinuity)
(def .public (stack environment)
(-> Environment (Try Stack))
(when (the ..#stack environment)
{.#Some stack}
{try.#Success stack}
{.#None}
(exception.except ..discontinuity [])))
(def .public discontinue
(-> Environment Environment)
(.has ..#stack {.#None}))
(exception.def .public (mismatched_stacks [expected actual])
(Exception [Stack Stack])
(exception.report
(list ["Expected" (/stack.text expected)]
["Actual" (/stack.text actual)])))
(def .public (continue expected environment)
(-> Stack Environment (Try [Stack Environment]))
(when (the ..#stack environment)
{.#Some actual}
(if (of /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}))
|
