Commit | Line | Data |
---|---|---|
fa64b741 JM |
1 | /runlibfile where { pop }{ /runlibfile { run } def } ifelse % |
2 | (types.ps) runlibfile | |
3 | (reader.ps) runlibfile | |
4 | (printer.ps) runlibfile | |
5 | (env.ps) runlibfile | |
6 | (core.ps) runlibfile | |
724ad694 JM |
7 | |
8 | % read | |
406761e7 | 9 | /_readline { print flush (%stdin) (r) file 1024 string readline } def |
950e3c76 | 10 | |
724ad694 JM |
11 | /READ { |
12 | /str exch def | |
13 | str read_str | |
14 | } def | |
15 | ||
16 | ||
17 | % eval | |
18 | /eval_ast { 2 dict begin | |
19 | /env exch def | |
20 | /ast exch def | |
21 | %(eval_ast: ) print ast == | |
8e7e339d | 22 | ast _symbol? { %if symbol |
724ad694 | 23 | env ast env_get |
5ce65382 | 24 | }{ ast _sequential? { %elseif list or vector |
724ad694 | 25 | [ |
5ce65382 | 26 | ast /data get { %forall items |
724ad694 JM |
27 | env EVAL |
28 | } forall | |
5ce65382 JM |
29 | ] ast _list? { _list_from_array }{ _vector_from_array } ifelse |
30 | }{ ast _hash_map? { %elseif list or vector | |
31 | << | |
32 | ast /data get { %forall entries | |
33 | env EVAL | |
34 | } forall | |
35 | >> _hash_map_from_dict | |
724ad694 JM |
36 | }{ % else |
37 | ast | |
5ce65382 | 38 | } ifelse } ifelse } ifelse |
724ad694 JM |
39 | end } def |
40 | ||
41 | /EVAL { 13 dict begin | |
42 | { %loop (TCO) | |
43 | ||
44 | /env exch def | |
45 | /ast exch def | |
46 | /loop? false def | |
47 | ||
3da90d39 | 48 | %(EVAL: ) print ast true _pr_str print (\n) print |
8e7e339d | 49 | ast _list? not { %if not a list |
724ad694 JM |
50 | ast env eval_ast |
51 | }{ %else apply the list | |
5ce65382 | 52 | /a0 ast 0 _nth def |
12e4facd DM |
53 | a0 _nil? { %if () |
54 | ast | |
55 | }{ /def! a0 eq { %if def! | |
5ce65382 JM |
56 | /a1 ast 1 _nth def |
57 | /a2 ast 2 _nth def | |
724ad694 JM |
58 | env a1 a2 env EVAL env_set |
59 | }{ /let* a0 eq { %if let* | |
5ce65382 JM |
60 | /a1 ast 1 _nth def |
61 | /a2 ast 2 _nth def | |
62 | /let_env env null null env_new def | |
63 | 0 2 a1 _count 1 sub { %for each pair | |
724ad694 JM |
64 | /idx exch def |
65 | let_env | |
5ce65382 JM |
66 | a1 idx _nth |
67 | a1 idx 1 add _nth let_env EVAL | |
724ad694 | 68 | env_set |
3da90d39 | 69 | pop % discard the return value |
724ad694 | 70 | } for |
6301e0b6 JM |
71 | a2 |
72 | let_env | |
73 | /loop? true def % loop | |
724ad694 | 74 | }{ /do a0 eq { %if do |
5ce65382 JM |
75 | ast _count 2 gt { %if ast has more than 2 elements |
76 | ast 1 ast _count 2 sub _slice env eval_ast pop | |
724ad694 | 77 | } if |
5ce65382 | 78 | ast ast _count 1 sub _nth % last ast becomes new ast |
724ad694 JM |
79 | env |
80 | /loop? true def % loop | |
81 | }{ /if a0 eq { %if if | |
5ce65382 | 82 | /a1 ast 1 _nth def |
724ad694 JM |
83 | /cond a1 env EVAL def |
84 | cond null eq cond false eq or { % if cond is nil or false | |
5ce65382 JM |
85 | ast _count 3 gt { %if false branch with a3 |
86 | ast 3 _nth env | |
724ad694 | 87 | /loop? true def |
3da90d39 | 88 | }{ % else false branch with no a3 |
724ad694 JM |
89 | null |
90 | } ifelse | |
3da90d39 | 91 | }{ % true branch |
5ce65382 | 92 | ast 2 _nth env |
724ad694 JM |
93 | /loop? true def |
94 | } ifelse | |
95 | }{ /fn* a0 eq { %if fn* | |
5ce65382 JM |
96 | /a1 ast 1 _nth def |
97 | /a2 ast 2 _nth def | |
0027e8fe | 98 | a2 env a1 _mal_function |
724ad694 JM |
99 | }{ |
100 | /el ast env eval_ast def | |
950e3c76 | 101 | el _rest el _first % stack: ast function |
0027e8fe | 102 | dup _mal_function? { %if user defined function |
950e3c76 | 103 | fload % stack: ast new_env |
724ad694 | 104 | /loop? true def |
0027e8fe JM |
105 | }{ dup _function? { %else if builtin function |
106 | /data get exec | |
724ad694 | 107 | }{ %else (regular procedure/function) |
0027e8fe JM |
108 | (cannot apply native proc!\n) print quit |
109 | } ifelse } ifelse | |
12e4facd | 110 | } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse |
724ad694 JM |
111 | } ifelse |
112 | ||
113 | loop? not { exit } if | |
114 | } loop % TCO | |
115 | end } def | |
116 | ||
117 | ||
118 | ||
119 | /PRINT { | |
120 | true _pr_str | |
121 | } def | |
122 | ||
123 | ||
124 | % repl | |
5ce65382 | 125 | /repl_env null null null env_new def |
724ad694 JM |
126 | |
127 | /RE { READ repl_env EVAL } def | |
128 | /REP { READ repl_env EVAL PRINT } def | |
724ad694 | 129 | |
8cb5cda4 | 130 | % core.ps: defined using postscript |
86b689f3 JM |
131 | /_ref { repl_env 3 1 roll env_set pop } def |
132 | core_ns { _function _ref } forall | |
133 | (eval) { 0 _nth repl_env EVAL } _function _ref | |
134 | (*ARGV*) [ ] _list_from_array _ref | |
724ad694 | 135 | |
8cb5cda4 | 136 | % core.mal: defined using the language itself |
724ad694 JM |
137 | (\(def! not \(fn* \(a\) \(if a false true\)\)\)) RE pop |
138 | (\(def! load-file \(fn* \(f\) \(eval \(read-string \(str "\(do " \(slurp f\) "\)"\)\)\)\)\)) RE pop | |
139 | ||
724ad694 | 140 | userdict /ARGUMENTS known { %if command line arguments |
8e7e339d | 141 | ARGUMENTS length 0 gt { %if more than 0 arguments |
86b689f3 JM |
142 | (*ARGV*) ARGUMENTS 1 ARGUMENTS length 1 sub getinterval |
143 | _list_from_array _ref | |
144 | ARGUMENTS 0 get | |
145 | (\(load-file ") exch ("\)) concatenate concatenate RE pop | |
8e7e339d JM |
146 | quit |
147 | } if | |
724ad694 | 148 | } if |
86b689f3 JM |
149 | |
150 | % repl loop | |
151 | { %loop | |
950e3c76 | 152 | (user> ) _readline |
724ad694 JM |
153 | not { exit } if % exit if EOF |
154 | ||
724ad694 JM |
155 | { %try |
156 | REP print (\n) print | |
157 | } stopped { | |
158 | (Error: ) print | |
159 | get_error_data false _pr_str print (\n) print | |
8e7e339d JM |
160 | $error /newerror false put |
161 | $error /errorinfo null put | |
724ad694 | 162 | clear |
950e3c76 | 163 | cleardictstack |
724ad694 JM |
164 | } if |
165 | } bind loop | |
166 | ||
167 | (\n) print % final newline before exit for cleanliness | |
168 | quit |