Commit | Line | Data |
---|---|---|
4eb88ef2 DM |
1 | load "../logo/readline.lg |
2 | load "../logo/reader.lg | |
3 | load "../logo/printer.lg | |
4 | load "../logo/types.lg | |
5 | load "../logo/env.lg | |
6 | load "../logo/core.lg | |
7 | ||
8 | to _read :str | |
9 | output read_str :str | |
10 | end | |
11 | ||
12 | to pairp :obj | |
13 | output and sequentialp :obj ((_count :obj) > 0) | |
14 | end | |
15 | ||
16 | to quasiquote :ast | |
17 | if not pairp :ast [output (mal_list symbol_new "quote :ast)] | |
18 | localmake "a0 nth :ast 0 | |
19 | if symbolnamedp "unquote :a0 [output nth :ast 1] | |
20 | if pairp :a0 [ | |
21 | localmake "a00 nth :a0 0 | |
22 | if symbolnamedp "splice-unquote :a00 [ | |
23 | localmake "a01 nth :a0 1 | |
24 | output (mal_list symbol_new "concat :a01 (mal_list symbol_new "quasiquote rest :ast)) | |
25 | ] | |
26 | ] | |
27 | output (mal_list symbol_new "cons (mal_list symbol_new "quasiquote :a0) (mal_list symbol_new "quasiquote rest :ast)) | |
28 | end | |
29 | ||
30 | to eval_ast :ast :env | |
31 | output case (obj_type :ast) [ | |
32 | [[symbol] env_get :env :ast] | |
33 | [[list] obj_new "list map [_eval ? :env] obj_val :ast] | |
34 | [[vector] obj_new "vector map [_eval ? :env] obj_val :ast] | |
35 | [[hashmap] obj_new "hashmap map [_eval ? :env] obj_val :ast] | |
36 | [else :ast] | |
37 | ] | |
38 | end | |
39 | ||
40 | to _eval :a_ast :a_env | |
41 | localmake "ast :a_ast | |
42 | localmake "env :a_env | |
43 | forever [ | |
44 | if (obj_type :ast) <> "list [output eval_ast :ast :env] | |
45 | if emptyp obj_val :ast [output :ast] | |
46 | localmake "a0 nth :ast 0 | |
47 | case list obj_type :a0 obj_val :a0 [ | |
48 | [[[symbol def!]] | |
49 | localmake "a1 nth :ast 1 | |
50 | localmake "a2 nth :ast 2 | |
51 | output env_set :env :a1 _eval :a2 :env ] | |
52 | ||
53 | [[[symbol let*]] | |
54 | localmake "a1 nth :ast 1 | |
55 | localmake "letenv env_new :env [] [] | |
56 | localmake "i 0 | |
57 | while [:i < _count :a1] [ | |
58 | ignore env_set :letenv nth :a1 :i _eval nth :a1 (:i + 1) :letenv | |
59 | make "i (:i + 2) | |
60 | ] | |
61 | make "env :letenv | |
62 | make "ast nth :ast 2 ] ; TCO | |
63 | ||
64 | [[[symbol quote]] | |
65 | output nth :ast 1 ] | |
66 | ||
67 | [[[symbol quasiquote]] | |
68 | make "ast quasiquote nth :ast 1 ] ; TCO | |
69 | ||
70 | [[[symbol do]] | |
71 | localmake "i 1 | |
72 | while [:i < ((_count :ast) - 1)] [ | |
73 | ignore _eval nth :ast :i :env | |
74 | make "i (:i + 1) | |
75 | ] | |
76 | make "ast last obj_val :ast ] ; TCO | |
77 | ||
78 | [[[symbol if]] | |
79 | localmake "a1 nth :ast 1 | |
80 | localmake "cond _eval :a1 :env | |
81 | case obj_type :cond [ | |
82 | [[nil false] ifelse (_count :ast) > 3 [ | |
83 | make "ast nth :ast 3 ; TCO | |
84 | ] [ | |
85 | output nil_new | |
86 | ]] | |
87 | [else make "ast nth :ast 2] ; TCO | |
88 | ]] | |
89 | ||
90 | [[[symbol fn*]] | |
91 | output fn_new nth :ast 1 :env nth :ast 2 ] | |
92 | ||
93 | [else | |
94 | localmake "el eval_ast :ast :env | |
95 | localmake "f nth :el 0 | |
96 | case obj_type :f [ | |
97 | [[nativefn] | |
98 | output apply obj_val :f butfirst obj_val :el ] | |
99 | [[fn] | |
100 | make "env env_new fn_env :f fn_args :f rest :el | |
101 | make "ast fn_body :f ] ; TCO | |
102 | [else | |
103 | (throw "error [Wrong type for apply])] | |
104 | ] ] | |
105 | ] | |
106 | ] | |
107 | end | |
108 | ||
109 | to _print :exp | |
110 | output pr_str :exp "true | |
111 | end | |
112 | ||
113 | to re :str | |
114 | output _eval _read :str :repl_env | |
115 | end | |
116 | ||
117 | to rep :str | |
118 | output _print re :str | |
119 | end | |
120 | ||
121 | to print_exception :exception | |
122 | if not emptyp :exception [ | |
123 | localmake "e first butfirst :exception | |
124 | ifelse :e = "_mal_exception_ [ | |
125 | (print "Error: pr_str :global_exception "false) | |
126 | ] [ | |
127 | (print "Error: :e) | |
128 | ] | |
129 | ] | |
130 | end | |
131 | ||
132 | to repl | |
133 | localmake "running "true | |
134 | while [:running] [ | |
135 | localmake "line readline word "user> :space_char | |
136 | ifelse :line=[] [ | |
137 | print " | |
138 | make "running "false | |
139 | ] [ | |
140 | if not emptyp :line [ | |
141 | catch "error [print rep :line] | |
142 | localmake "exception error | |
143 | if not emptyp :exception [ | |
144 | (print "Error: first butfirst :exception) | |
145 | ] | |
146 | ] | |
147 | ] | |
148 | ] | |
149 | end | |
150 | ||
151 | to mal_eval :a | |
152 | output _eval :a :repl_env | |
153 | end | |
154 | ||
155 | to argv_list | |
156 | localmake "argv ifelse emptyp :command.line [[]] [butfirst :command.line] | |
157 | output obj_new "list map [obj_new "string ?] :argv | |
158 | end | |
159 | ||
160 | make "repl_env env_new [] [] [] | |
161 | foreach :core_ns [ | |
162 | ignore env_set :repl_env first ? first butfirst ? | |
163 | ] | |
164 | ignore env_set :repl_env [symbol eval] [nativefn mal_eval] | |
165 | ignore env_set :repl_env [symbol *ARGV*] argv_list | |
166 | ||
167 | ; core.mal: defined using the language itself | |
168 | ignore re "|(def! not (fn* (a) (if a false true)))| | |
169 | ignore re "|(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))| | |
170 | ||
171 | if not emptyp :command.line [ | |
172 | catch "error [ignore re (word "\(load-file :space_char "\" first :command.line "\"\) )] | |
173 | print_exception error | |
174 | bye | |
175 | ] | |
176 | ||
177 | repl | |
178 | bye |