Commit | Line | Data |
---|---|---|
46669c86 JM |
1 | (types.ps) run |
2 | (reader.ps) run | |
3 | ||
4 | % read | |
950e3c76 JM |
5 | /_readline { print flush (%stdin) (r) file 99 string readline } def |
6 | ||
46669c86 JM |
7 | /READ { |
8 | /str exch def | |
9 | str read_str | |
10 | } def | |
11 | ||
12 | ||
13 | % eval | |
14 | /eval_ast { 2 dict begin | |
15 | /env exch def | |
16 | /ast exch def | |
17 | %(eval_ast: ) print ast == | |
8e7e339d | 18 | ast _symbol? { %if symbol |
46669c86 | 19 | env ast env_get |
8e7e339d | 20 | }{ ast _list? { %elseif list |
46669c86 JM |
21 | [ |
22 | ast { | |
23 | env EVAL | |
24 | } forall | |
25 | ] | |
26 | }{ % else | |
27 | ast | |
28 | } ifelse } ifelse | |
29 | end } def | |
30 | ||
31 | /EVAL { 13 dict begin | |
32 | { %loop (TCO) | |
33 | ||
34 | /env exch def | |
35 | /ast exch def | |
36 | /loop? false def | |
37 | ||
3da90d39 | 38 | %(EVAL: ) print ast true _pr_str print (\n) print |
8e7e339d | 39 | ast _list? not { %if not a list |
46669c86 JM |
40 | ast env eval_ast |
41 | }{ %else apply the list | |
42 | /a0 ast 0 get def | |
43 | /def! a0 eq { %if def! | |
44 | /a1 ast 1 get def | |
45 | /a2 ast 2 get def | |
46 | env a1 a2 env EVAL env_set | |
47 | }{ /let* a0 eq { %if let* | |
48 | /a1 ast 1 get def | |
49 | /a2 ast 2 get def | |
50 | /let_env env [ ] [ ] env_new def | |
51 | 0 2 a1 length 1 sub { %for each pair | |
52 | /idx exch def | |
53 | let_env | |
54 | a1 idx get | |
55 | a1 idx 1 add get let_env EVAL | |
56 | env_set | |
3da90d39 | 57 | pop % discard the return value |
46669c86 JM |
58 | } for |
59 | a2 let_env EVAL | |
60 | }{ /do a0 eq { %if do | |
3da90d39 JM |
61 | ast length 2 gt { %if ast has more than 2 elements |
62 | ast 1 ast length 2 sub getinterval env eval_ast pop | |
46669c86 JM |
63 | } if |
64 | ast ast length 1 sub get % last ast becomes new ast | |
65 | env | |
66 | /loop? true def % loop | |
67 | }{ /if a0 eq { %if if | |
68 | /a1 ast 1 get def | |
69 | /cond a1 env EVAL def | |
70 | cond null eq cond false eq or { % if cond is nil or false | |
3da90d39 JM |
71 | ast length 3 gt { %if false branch with a3 |
72 | ast 3 get env | |
46669c86 | 73 | /loop? true def |
3da90d39 | 74 | }{ % else false branch with no a3 |
46669c86 JM |
75 | null |
76 | } ifelse | |
3da90d39 JM |
77 | }{ % true branch |
78 | ast 2 get env | |
46669c86 JM |
79 | /loop? true def |
80 | } ifelse | |
81 | }{ /fn* a0 eq { %if fn* | |
82 | /a1 ast 1 get def | |
83 | /a2 ast 2 get def | |
3da90d39 JM |
84 | << |
85 | /type /_maltype_function % user defined function | |
86 | /params null % close over parameters | |
87 | /ast null % close over ast | |
88 | /env null % close over environment | |
950e3c76 | 89 | /data { __self__ fload EVAL } |
3da90d39 JM |
90 | >> |
91 | dup length dict copy % make an actual copy/new instance | |
92 | dup /params a1 put % insert closed over a1 into position 2 | |
93 | dup /ast a2 put % insert closed over a2 into position 3 | |
94 | dup /env env put % insert closed over env into position 4 | |
950e3c76 | 95 | dup dup /data get exch 0 exch put % insert self reference |
46669c86 JM |
96 | }{ |
97 | /el ast env eval_ast def | |
950e3c76 JM |
98 | el _rest el _first % stack: ast function |
99 | dup _mal_function? { % if user defined function | |
100 | fload % stack: ast new_env | |
46669c86 JM |
101 | /loop? true def |
102 | }{ %else (regular procedure/function) | |
950e3c76 | 103 | exec % apply function to args |
46669c86 JM |
104 | } ifelse |
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 | |
120 | /repl_env null [ ] [ ] env_new def | |
121 | ||
122 | /RE { READ repl_env EVAL } def | |
123 | /REP { READ repl_env EVAL PRINT } def | |
124 | /_ref { repl_env 3 1 roll env_set pop } def | |
125 | ||
126 | types_ns { _ref } forall | |
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 |