blob: a8a625e68f2bf151937b9bf2c6c3bb1fa39011e1 (
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
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
|
require reader.fs
require printer.fs
require env.fs
: args-as-native { argv argc -- entry*argc... }
argc 0 ?do
argv i cells + @ as-native
loop ;
0 MalEnv. constant repl-env
s" +" MalSymbol. :noname args-as-native + MalInt. ; MalNativeFn. repl-env env/set
s" -" MalSymbol. :noname args-as-native - MalInt. ; MalNativeFn. repl-env env/set
s" *" MalSymbol. :noname args-as-native * MalInt. ; MalNativeFn. repl-env env/set
s" /" MalSymbol. :noname args-as-native / MalInt. ; MalNativeFn. repl-env env/set
: read read-str ;
: eval ( env obj ) mal-eval ;
: print
\ ." Type: " dup mal-type @ type-name safe-type cr
pr-str ;
MalDefault extend mal-eval nip ;; drop \ By default, evalutate to yourself
MalKeyword
extend eval-invoke { env list kw -- val }
0 kw env list MalList/start @ cell+ @ eval get
?dup 0= if
\ compute not-found value
list MalList/count @ 1 > if
env list MalList/start @ 2 cells + @ eval
else
mal-nil
endif
endif ;;
drop
\ eval all but the first item of list
: eval-rest { env list -- argv argc }
list MalList/start @ cell+ { expr-start }
list MalList/count @ 1- { argc }
argc cells allocate throw { target }
argc 0 ?do
env expr-start i cells + @ eval
target i cells + !
loop
target argc ;
MalNativeFn
extend eval-invoke ( env list this -- list )
MalNativeFn/xt @ { xt }
eval-rest ( argv argc )
xt execute ( return-val ) ;;
drop
SpecialOp
extend eval-invoke ( env list this -- list )
SpecialOp/xt @ execute ;;
drop
: install-special ( symbol xt )
SpecialOp. repl-env env/set ;
: defspecial
parse-allot-name MalSymbol.
['] install-special
:noname
;
defspecial quote ( env list -- form )
nip MalList/start @ cell+ @ ;;
defspecial def! { env list -- val }
list MalList/start @ cell+ { arg0 }
arg0 @ ( key )
env arg0 cell+ @ eval dup { val } ( key val )
env env/set val ;;
defspecial let* { old-env list -- val }
old-env MalEnv. { env }
list MalList/start @ cell+ dup { arg0 }
@ to-list
dup MalList/start @ { bindings-start } ( list )
MalList/count @ 0 +do
bindings-start i cells + dup @ swap cell+ @ ( sym expr )
env swap eval
env env/set
2 +loop
env arg0 cell+ @ eval
\ TODO: dec refcount of env
;;
MalSymbol
extend mal-eval { env sym -- val }
sym env env/get-addr
dup 0= if
drop
." Symbol '" sym pr-str safe-type ." ' not found." cr
1 throw
else
@
endif ;;
drop
: eval-ast { env list -- list }
here
list MalList/start @ { expr-start }
list MalList/count @ 0 ?do
env expr-start i cells + @ eval ,
loop
here>MalList ;
MalList
extend mal-eval { env list -- val }
env list MalList/start @ @ eval
env list rot eval-invoke ;;
drop
MalVector
extend mal-eval ( env vector -- vector )
MalVector/list @ eval-ast
MalVector new swap over MalVector/list ! ;;
drop
MalMap
extend mal-eval ( env map -- map )
MalMap/list @ eval-ast
MalMap new swap over MalMap/list ! ;;
drop
: rep ( str-addr str-len -- str-addr str-len )
read
repl-env swap eval
print ;
create buff 128 allot
77777777777 constant stack-leak-detect
: read-lines
begin
." user> "
stack-leak-detect
buff 128 stdin read-line throw
while ( num-bytes-read )
buff swap ( str-addr str-len )
['] rep
\ execute safe-type
catch ?dup 0= if safe-type else ." Caught error " . endif
cr
stack-leak-detect <> if ." --stack leak--" cr endif
repeat ;
read-lines
cr
bye
|
