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