blob: bc30e3586f9aa199b9ec4566cc1811e97d31a9fc (
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
155
156
157
158
159
160
161
162
163
164
165
166
|
/runlibfile where { pop }{ /runlibfile { run } def } ifelse %
(types.ps) runlibfile
(reader.ps) runlibfile
(printer.ps) runlibfile
(env.ps) runlibfile
(core.ps) runlibfile
% read
/_readline { print flush (%stdin) (r) file 99 string readline } def
/READ {
/str exch def
str read_str
} def
% eval
/eval_ast { 2 dict begin
/env exch def
/ast exch def
%(eval_ast: ) print ast ==
ast _symbol? { %if symbol
env ast env_get
}{ ast _sequential? { %elseif list or vector
[
ast /data get { %forall items
env EVAL
} forall
] ast _list? { _list_from_array }{ _vector_from_array } ifelse
}{ ast _hash_map? { %elseif list or vector
<<
ast /data get { %forall entries
env EVAL
} forall
>> _hash_map_from_dict
}{ % else
ast
} ifelse } ifelse } ifelse
end } def
/EVAL { 13 dict begin
{ %loop (TCO)
/env exch def
/ast exch def
/loop? false def
%(EVAL: ) print ast true _pr_str print (\n) print
ast _list? not { %if not a list
ast env eval_ast
}{ %else apply the list
/a0 ast 0 _nth def
/def! a0 eq { %if def!
/a1 ast 1 _nth def
/a2 ast 2 _nth def
env a1 a2 env EVAL env_set
}{ /let* a0 eq { %if let*
/a1 ast 1 _nth def
/a2 ast 2 _nth def
/let_env env null null env_new def
0 2 a1 _count 1 sub { %for each pair
/idx exch def
let_env
a1 idx _nth
a1 idx 1 add _nth let_env EVAL
env_set
pop % discard the return value
} for
a2
let_env
/loop? true def % loop
}{ /do a0 eq { %if do
ast _count 2 gt { %if ast has more than 2 elements
ast 1 ast _count 2 sub _slice env eval_ast pop
} if
ast ast _count 1 sub _nth % last ast becomes new ast
env
/loop? true def % loop
}{ /if a0 eq { %if if
/a1 ast 1 _nth def
/cond a1 env EVAL def
cond null eq cond false eq or { % if cond is nil or false
ast _count 3 gt { %if false branch with a3
ast 3 _nth env
/loop? true def
}{ % else false branch with no a3
null
} ifelse
}{ % true branch
ast 2 _nth env
/loop? true def
} ifelse
}{ /fn* a0 eq { %if fn*
/a1 ast 1 _nth def
/a2 ast 2 _nth def
a2 env a1 _mal_function
}{
/el ast env eval_ast def
el _rest el _first % stack: ast function
dup _mal_function? { %if user defined function
fload % stack: ast new_env
/loop? true def
}{ dup _function? { %else if builtin function
/data get exec
}{ %else (regular procedure/function)
(cannot apply native proc!\n) print quit
} ifelse } ifelse
} ifelse } ifelse } ifelse } ifelse } ifelse
} ifelse
loop? not { exit } if
} loop % TCO
end } def
% print
/PRINT {
true _pr_str
} def
% repl
/repl_env null null null env_new def
/RE { READ repl_env EVAL } def
/REP { READ repl_env EVAL PRINT } def
% core.ps: defined using postscript
/_ref { repl_env 3 1 roll env_set pop } def
core_ns { _function _ref } forall
(eval) { 0 _nth repl_env EVAL } _function _ref
(*ARGV*) [ ] _list_from_array _ref
% core.mal: defined using the language itself
(\(def! not \(fn* \(a\) \(if a false true\)\)\)) RE pop
(\(def! load-file \(fn* \(f\) \(eval \(read-string \(str "\(do " \(slurp f\) "\)"\)\)\)\)\)) RE pop
userdict /ARGUMENTS known { %if command line arguments
ARGUMENTS length 0 gt { %if more than 0 arguments
(*ARGV*) ARGUMENTS 1 ARGUMENTS length 1 sub getinterval
_list_from_array _ref
ARGUMENTS 0 get
(\(load-file ") exch ("\)) concatenate concatenate RE pop
quit
} if
} if
% repl loop
{ %loop
(user> ) _readline
not { exit } if % exit if EOF
{ %try
REP print (\n) print
} stopped {
(Error: ) print
get_error_data false _pr_str print (\n) print
$error /newerror false put
$error /errorinfo null put
clear
cleardictstack
} if
} bind loop
(\n) print % final newline before exit for cleanliness
quit
|
