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