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