blob: 04bb8c60b58faac0cae43a67c4610693ada1bd2a (
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
|
(.module:
[lux #*
[abstract
[monad (#+ do)]
[monoid (#+ Monoid)]]
[control
["." try (#+ Try)]
["." exception (#+ exception:)]]
[data
[number (#+ hex)]
["." binary]
[text
["%" format (#+ format)]]
[format
[".F" binary (#+ Mutation Specification)]]]]
["." // #_
["#." resources (#+ Resources)]
["/#" // #_
[encoding
["#." unsigned (#+ U1 U2)]]]])
(type: #export Environment
{#resources Resources
#stack U2})
(def: #export start
Environment
{#resources //resources.start
#stack (///unsigned.u2 0)})
(type: #export Condition
(-> Environment (Try Environment)))
(structure: #export monoid
(Monoid Condition)
(def: identity (|>> #try.Success))
(def: (compose left right)
(function (_ environment)
(do try.monad
[environment (left environment)]
(right environment)))))
(def: #export (produces amount env)
(-> Nat Condition)
(let [stack (n/+ amount
(///unsigned.nat (get@ #stack env)))
max-stack (n/max stack
(///unsigned.nat (get@ [#resources #//resources.max-stack] env)))]
(|> env
(set@ #stack (///unsigned.u2 stack))
(set@ [#resources #//resources.max-stack] (///unsigned.u2 max-stack))
#try.Success)))
(exception: #export (cannot-pop-stack {stack-size Nat}
{wanted-pops Nat})
(exception.report
["Stack Size" (%.nat stack-size)]
["Wanted Pops" (%.nat wanted-pops)]))
(def: #export (consumes wanted-pops env)
(-> Nat Condition)
(let [stack-size (///unsigned.nat (get@ #stack env))]
(if (n/<= stack-size wanted-pops)
(#try.Success (update@ #stack
(|>> ///unsigned.nat (n/- wanted-pops) ///unsigned.u2)
env))
(exception.throw ..cannot-pop-stack [stack-size wanted-pops]))))
(type: #export Local U1)
(def: #export (has-local local environment)
(-> Local Condition)
(let [max-locals (n/max (///unsigned.nat (get@ [#resources #//resources.max-locals] environment))
(///unsigned.nat local))]
(|> environment
(set@ [#resources #//resources.max-locals]
(///unsigned.u2 max-locals))
#try.Success)))
|