blob: 496311146c79449ef023895055beb97fcd9de567 (
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
|
require reader.fs
require printer.fs
: args-as-native { argv argc -- entry*argc... }
argc 0 ?do
argv i cells + @ as-native
loop ;
MalMap/Empty
s" +" MalSymbol. :noname args-as-native + MalInt. ; MalNativeFn. rot assoc
s" -" MalSymbol. :noname args-as-native - MalInt. ; MalNativeFn. rot assoc
s" *" MalSymbol. :noname args-as-native * MalInt. ; MalNativeFn. rot assoc
s" /" MalSymbol. :noname args-as-native / MalInt. ; MalNativeFn. rot assoc
value repl-env
def-protocol-method mal-eval ( env ast -- val )
def-protocol-method mal-eval-ast ( env ast -- val )
def-protocol-method invoke ( argv argc mal-fn -- ... )
MalDefault extend mal-eval nip ;; drop
MalKeyword
extend invoke { argv argc kw -- val }
argc 1 > if argv cell+ @ else mal-nil endif \ not-found
kw \ key
argv @ \ map
get ;;
drop
MalNativeFn
extend invoke ( ... mal-fn -- ... )
MalNativeFn/xt @ execute ;;
drop
MalSymbol
extend mal-eval { env sym -- val }
0 sym env get
dup 0= if
drop
." Symbol '"
sym as-native safe-type
." ' not found." cr
1 throw
endif ;;
drop
MalList
extend mal-eval { env list -- val }
\ Pass args on dictionary stack (!)
\ TODO: consider allocate and free of a real MalList instead
here { val-start }
list MalList/start @ { expr-start }
list MalList/count @ 0 ?do
env expr-start i cells + @ mal-eval ,
loop
val-start cell+ here val-start - cell / 1- val-start @ ( argv argc MalNativeFn )
invoke
val-start here - allot ;;
extend mal-eval-ast { env list -- list }
here
list MalList/start @ { expr-start }
list MalList/count @ 0 ?do
env expr-start i cells + @ mal-eval ,
loop
here>MalList ;;
drop
MalVector
extend mal-eval ( env vector -- vector )
MalVector/list @ mal-eval-ast
MalVector new swap over MalVector/list ! ;;
drop
MalMap
extend mal-eval ( env map -- map )
MalMap/list @ mal-eval-ast
MalMap new swap over MalMap/list ! ;;
drop
: read read-str ;
: eval ( env obj ) mal-eval ;
: print
\ ." Type: " dup mal-type @ type-name safe-type cr
pr-str ;
: rep ( str -- val )
read
repl-env swap eval
print ;
create buff 128 allot
: read-lines
begin
." user> "
buff 128 stdin read-line throw
while
buff swap
['] rep
\ execute safe-type
catch 0= if safe-type else ." Caught error" endif
cr
repeat ;
read-lines
cr
bye
|
