2 ;; "Mu Lei" known as "NalaGinrut" <NalaGinrut@gmail.com>
3 ;; This file is free software: you can redistribute it and/or modify
4 ;; it under the terms of the GNU General Public License as published by
5 ;; the Free Software Foundation, either version 3 of the License, or
6 ;; (at your option) any later version.
8 ;; This file is distributed in the hope that it will be useful,
9 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
10 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 ;; GNU General Public License for more details.
13 ;; You should have received a copy of the GNU General Public License
14 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
16 (import (readline) (reader) (printer) (ice-9 match) (srfi srfi-43)
17 (srfi srfi-1) (ice-9 receive) (env))
26 (receive (b e) (unzip2 *primitives*)
27 (make-Env #:binds b #:exprs e)))
30 (read_str (_readline "user> ")))
32 (define (eval_ast ast env)
33 (define (_eval x) (EVAL x env))
35 ((? symbol? sym) (env-has sym env))
36 ((? list? lst) (map _eval lst))
37 ((? vector? vec) (vector-map (lambda (i x) (_eval x)) vec))
39 (hash-for-each (lambda (k v) (hash-set! ht k (_eval v))) ht)
43 (define (eval_func ast env)
44 (define expr (eval_ast ast env))
46 (((? procedure? proc) args ...)
48 (else (throw 'mal-error (format #f "'~a' not found" (car expr))))))
50 (define (EVAL ast env)
51 (define (->list kvs) ((if (vector? kvs) vector->list identity) kvs))
53 (let lp((next kvs) (k '()) (v '()))
55 ;; NOTE: reverse is very important here!
56 ((null? next) (values (reverse k) (reverse v)))
57 ((null? (cdr next)) (throw 'mal-error "let*: Invalid binding form" kvs))
58 (else (lp (cddr next) (cons (car next) k) (cons (cadr next) v))))))
60 ((? (lambda (x) (not (list? x)))) (eval_ast ast env))
62 (('def! k v) ((env 'set) k (EVAL v env)))
64 (let* ((new-env (make-Env #:outer env))
65 (setter (lambda (k v) ((new-env 'set) k (EVAL v new-env)))))
66 (receive (keys vals) (%unzip2 (->list kvs))
67 (for-each setter keys vals))
69 (else (eval_func ast env))))
72 (and (not (eof-object? exp))
73 (format #t "~a~%" (pr_str exp #t))))
75 (define (LOOP continue?)
76 (and continue? (REPL)))
81 (lambda () (PRINT (EVAL (READ) *toplevel*)))
83 (if (string=? (car e) "blank line")
85 (format #t "Error: ~a~%" (car e)))))))