2 (import (scheme write))
3 (import (scheme process-context))
15 (define (eval-ast ast env)
16 (let ((type (and (mal-object? ast) (mal-type ast)))
17 (value (and (mal-object? ast) (mal-value ast))))
19 ((symbol) (env-get env value))
20 ((list) (mal-list (map (lambda (item) (EVAL item env)) value)))
21 ((vector) (mal-vector (vector-map (lambda (item) (EVAL item env)) value)))
22 ((map) (mal-map (alist-map (lambda (key value) (cons key (EVAL value env))) value)))
25 (define (EVAL ast env)
26 (let ((type (and (mal-object? ast) (mal-type ast))))
27 (if (not (eq? type 'list))
29 (let ((items (mal-value ast)))
32 (let ((a0 (car items)))
33 (case (and (mal-object? a0) (mal-value a0))
35 (let ((symbol (mal-value (cadr items)))
36 (value (EVAL (list-ref items 2) env)))
37 (env-set env symbol value)
40 (let ((env* (make-env env))
41 (binds (->list (mal-value (cadr items))))
42 (form (list-ref items 2)))
43 (let loop ((binds binds))
45 (let ((key (mal-value (car binds))))
46 (when (null? (cdr binds))
47 (error "unbalanced list"))
48 (let ((value (EVAL (cadr binds) env*)))
49 (env-set env* key value)
50 (loop (cddr binds))))))
51 (EVAL form env*))) ; TCO
53 (let ((forms (cdr items)))
56 ;; the evaluation order of map is unspecified
57 (let loop ((forms forms))
58 (let ((form (car forms))
66 (let* ((condition (EVAL (cadr items) env))
67 (type (and (mal-object? condition)
68 (mal-type condition))))
69 (if (memq type '(false nil))
70 (if (< (length items) 4)
72 (EVAL (list-ref items 3) env)) ; TCO
73 (EVAL (list-ref items 2) env)))) ; TCO
75 (let* ((binds (->list (mal-value (cadr items))))
76 (binds (map mal-value binds))
77 (body (list-ref items 2))
79 (let ((env* (make-env env binds args)))
81 (make-func body binds env fn)))
83 (let* ((items (mal-value (eval-ast ast env)))
87 (let* ((outer (func-env op))
88 (binds (func-params op))
89 (env* (make-env outer binds ops)))
90 (EVAL (func-ast op) env*)) ; TCO
91 (apply op ops)))))))))))
96 (define repl-env (make-env #f))
97 (for-each (lambda (kv) (env-set repl-env (car kv) (cdr kv))) ns)
100 (PRINT (EVAL (READ input) repl-env)))
102 (define args (cdr (command-line)))
104 (env-set repl-env 'eval (lambda (ast) (EVAL ast repl-env)))
105 (env-set repl-env '*ARGV* (mal-list (map mal-string (cdr-safe args))))
107 (rep "(def! not (fn* (a) (if a false true)))")
108 (rep "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))")
112 (let ((input (readline "user> ")))
115 (ex ((error-object? ex)
116 (when (not (memv 'empty-input (error-object-irritants ex)))
118 (display (error-object-message ex))
120 ((and (pair? ex) (eq? (car ex) 'user-error))
122 (display (pr-str (cdr ex) #t))
124 (display (rep input))
131 (rep (string-append "(load-file \"" (car args) "\")")))