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) (core) (types))
20 (receive (b e) (unzip2 core.ns)
21 (make-Env #:binds b #:exprs e)))
26 (define (eval_ast ast env)
27 (define (_eval x) (EVAL x env))
30 ((? symbol? sym) (env-has sym env))
31 ((? list? lst) (map _eval lst))
32 ((? vector? vec) (vector-map (lambda (i x) (_eval x)) vec))
34 ;; NOTE: we must allocate a new hashmap here to avoid any side-effects, or
35 ;; there'll be strange bugs!!!
36 (list->hash-map (hash-fold (lambda (k v p) (cons k (cons (_eval v) p))) '() ht)))
39 (define (eval_seq ast env)
42 ((null? (cdr ast)) (EVAL (car ast) env))
45 (eval_seq (cdr ast) env))))
47 (define (EVAL ast env)
49 (let lp((next kvs) (k '()) (v '()))
51 ;; NOTE: reverse is very important here!
52 ((null? next) (values (reverse k) (reverse v)))
54 (throw 'mal-error (format #f "let*: Invalid binding form '~a'" kvs)))
55 (else (lp (cddr next) (cons (car next) k) (cons (cadr next) v))))))
57 ((? non-list?) (eval_ast ast env))
59 (('def! k v) ((env 'set) k (EVAL v env)))
61 (let* ((new-env (make-Env #:outer env))
62 (setter (lambda (k v) ((new-env 'set) k (EVAL v new-env)))))
63 (receive (keys vals) (%unzip2 (->list kvs))
64 (for-each setter keys vals))
68 (('if cnd thn els ...)
70 ((and (not (null? els)) (not (null? (cdr els))))
73 (format #f "if: failed to match any pattern in form '~a'" ast)))
74 ((cond-true? (EVAL cnd env)) (EVAL thn env))
75 (else (if (null? els) nil (EVAL (car els) env)))))
76 (('fn* params body ...) ; function definition
78 (eval_seq body (make-Env #:outer env #:binds (->list params) #:exprs args))))
80 (let ((el (map (lambda (x) (EVAL x env)) ast)))
81 (apply (car el) (cdr el))))))
83 (define (EVAL-string str)
84 (EVAL (read_str str) *toplevel*))
87 (and (not (eof-object? exp))
88 (format #t "~a~%" (pr_str exp #t))))
90 (define (LOOP continue?)
91 (and continue? (REPL)))
95 (let ((line (_readline "user> ")))
97 ((eof-object? line) #f)
98 ((string=? line "") #t)
101 (lambda () (PRINT (EVAL (READ line) *toplevel*)))
103 (format #t "Error: ~a~%" (pr_str (car e) #t)))))))))
105 (EVAL-string "(def! not (fn* (x) (if x false true)))")