blob: 724de4473f90660547e69f2968dcfbdf1a8e0e2d (
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
|
require reader.fs
require printer.fs
: args-as-native { argv argc -- entry*argc... }
argc 0 ?do
argv i cells + @ as-native
loop ;
: env-assoc ( map sym-str-addr sym-str-len xt )
-rot MalSymbol. swap MalNativeFn. rot assoc ;
MalMap/Empty
s" +" :noname args-as-native + MalInt. ; env-assoc
s" -" :noname args-as-native - MalInt. ; env-assoc
s" *" :noname args-as-native * MalInt. ; env-assoc
s" /" :noname args-as-native / MalInt. ; env-assoc
constant repl-env
: 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
MalSymbol
extend mal-eval { env sym -- val }
0 sym env get
dup 0= if
drop
." Symbol '"
sym pr-str safe-type
." ' not found." cr
1 throw
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
|
