DISABLE FDs (REMOVE ME).
[jackhill/mal.git] / picolisp / step3_env.l
CommitLineData
f5763ca1
VS
1(de load-relative (Path)
2 (load (pack (car (file)) Path)) )
3
4(load-relative "readline.l")
5(load-relative "types.l")
6(load-relative "reader.l")
7(load-relative "printer.l")
8(load-relative "env.l")
9
10(de READ (String)
11 (read-str String) )
12
0e9990bc
VS
13(def '*ReplEnv (MAL-env NIL))
14(set> *ReplEnv '+ '((A B) (MAL-number (+ (MAL-value A) (MAL-value B)))))
15(set> *ReplEnv '- '((A B) (MAL-number (- (MAL-value A) (MAL-value B)))))
16(set> *ReplEnv '* '((A B) (MAL-number (* (MAL-value A) (MAL-value B)))))
17(set> *ReplEnv '/ '((A B) (MAL-number (/ (MAL-value A) (MAL-value B)))))
f5763ca1
VS
18
19(de EVAL (Ast Env)
20 (if (= (MAL-type Ast) 'list)
21 (if (not (MAL-value Ast))
22 Ast
23 (let (Ast* (MAL-value Ast)
24 A0* (MAL-value (car Ast*))
25 A1* (MAL-value (cadr Ast*))
26 A2 (caddr Ast*))
27 (cond
28 ((= A0* 'def!)
29 (set> Env A1* (EVAL A2 Env)) )
30 ((= A0* 'let*)
31 (let Env* (MAL-env Env)
32 (for (Bindings A1* Bindings)
33 (let (Key (MAL-value (pop 'Bindings))
34 Value (EVAL (pop 'Bindings) Env*))
35 (set> Env* Key Value) ) )
36 (EVAL A2 Env*) ) )
37 (T (let Value (MAL-value (eval-ast Ast Env))
38 (apply (car Value) (cdr Value)) ) ) ) ) )
39 (eval-ast Ast Env) ) )
40
41(de eval-ast (Ast Env)
42 (let Value (MAL-value Ast)
43 (case (MAL-type Ast)
44 (symbol (get> Env Value))
45 (list (MAL-list (mapcar '((Form) (EVAL Form Env)) Value)))
46 (vector (MAL-vector (mapcar '((Form) (EVAL Form Env)) Value)))
47 (map (MAL-map (mapcar '((Form) (EVAL Form Env)) Value)))
48 (T Ast) ) ) )
49
50(de PRINT (Ast)
51 (pr-str Ast T) )
52
872ae9c4
VS
53(de rep (String)
54 (PRINT (EVAL (READ String) *ReplEnv)) )
f5763ca1
VS
55
56(load-history ".mal_history")
57
58(use Eof
59 (until Eof
60 (let Input (readline "user> ")
61 (if (=0 Input)
62 (setq Eof T)
872ae9c4 63 (let Output (catch 'err (rep Input))
f5763ca1
VS
64 (if (isa '+MALError Output)
65 (let Message (MAL-value Output)
1809f9ba
VS
66 (unless (= (MAL-value Message) "end of token stream")
67 (prinl "[error] " (pr-str Message)) ) )
f5763ca1
VS
68 (prinl Output) ) ) ) ) ) )
69
70(prinl)
71(bye)