Commit | Line | Data |
---|---|---|
f5223195 JM |
1 | #!/usr/bin/env racket |
2 | #lang racket | |
3 | ||
4 | (require "readline.rkt" "types.rkt" "reader.rkt" "printer.rkt" | |
5 | "env.rkt" "core.rkt") | |
6 | ||
7 | ;; read | |
8 | (define (READ str) | |
9 | (read_str str)) | |
10 | ||
11 | ;; eval | |
12 | (define (eval-ast ast env) | |
13 | (cond | |
14 | [(symbol? ast) (send env get ast)] | |
15 | [(_sequential? ast) (_map (lambda (x) (EVAL x env)) ast)] | |
16 | [(hash? ast) (make-hash | |
17 | (dict-map ast (lambda (k v) (cons k (EVAL v env)))))] | |
18 | [else ast])) | |
19 | ||
20 | (define (EVAL ast env) | |
21 | (if (not (list? ast)) | |
22 | (eval-ast ast env) | |
23 | ||
24 | (let ([a0 (_nth ast 0)]) | |
25 | (cond | |
26 | [(eq? 'def! a0) | |
27 | (send env set (_nth ast 1) (EVAL (_nth ast 2) env))] | |
28 | [(eq? 'let* a0) | |
29 | (let ([let-env (new Env% [outer env] [binds null] [exprs null])]) | |
30 | (_map (lambda (b_e) | |
31 | (send let-env set (_first b_e) | |
32 | (EVAL (_nth b_e 1) let-env))) | |
33 | (_partition 2 (_to_list (_nth ast 1)))) | |
34 | (EVAL (_nth ast 2) let-env))] | |
35 | [(eq? 'do a0) | |
36 | (eval-ast (drop (drop-right ast 1) 1) env) | |
37 | (EVAL (last ast) env)] | |
38 | [(eq? 'if a0) | |
39 | (let ([cnd (EVAL (_nth ast 1) env)]) | |
40 | (if (or (eq? cnd nil) (eq? cnd #f)) | |
41 | (if (> (length ast) 3) | |
42 | (EVAL (_nth ast 3) env) | |
43 | nil) | |
44 | (EVAL (_nth ast 2) env)))] | |
45 | [(eq? 'fn* a0) | |
46 | (malfunc | |
47 | (lambda args (EVAL (_nth ast 2) | |
48 | (new Env% [outer env] | |
49 | [binds (_nth ast 1)] | |
50 | [exprs args]))) | |
51 | (_nth ast 2) env (_nth ast 1) #f nil)] | |
52 | [else (let* ([el (eval-ast ast env)] | |
53 | [f (first el)] | |
54 | [args (rest el)]) | |
55 | (if (malfunc? f) | |
56 | (EVAL (malfunc-ast f) | |
57 | (new Env% | |
58 | [outer (malfunc-env f)] | |
59 | [binds (malfunc-params f)] | |
60 | [exprs args])) | |
61 | (apply f args)))])))) | |
62 | ||
63 | ||
64 | (define (PRINT exp) | |
65 | (pr_str exp true)) | |
66 | ||
67 | ;; repl | |
68 | (define repl-env | |
69 | (new Env% [outer null] [binds null] [exprs null])) | |
70 | (define (rep str) | |
71 | (PRINT (EVAL (READ str) repl-env))) | |
72 | ||
73 | (for () ;; ignore return values | |
74 | ||
75 | ;; core.rkt: defined using Racket | |
76 | (hash-for-each core_ns (lambda (k v) (send repl-env set k v))) | |
77 | ||
78 | ;; core.mal: defined using the language itself | |
79 | (rep "(def! not (fn* (a) (if a false true)))") | |
80 | ||
81 | ) | |
82 | ||
83 | (define (repl-loop) | |
84 | (let ([line (readline "user> ")]) | |
85 | (when (not (eq? nil line)) | |
86 | (with-handlers | |
87 | ([string? (lambda (exc) (printf "Error: ~a~n" exc))] | |
88 | [blank-exn? (lambda (exc) null)]) | |
89 | (printf "~a~n" (rep line))) | |
90 | (repl-loop)))) | |
91 | (repl-loop) |