Commit | Line | Data |
---|---|---|
168cd127 NG |
1 | ;; Copyright (C) 2015 |
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. | |
7 | ||
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. | |
12 | ||
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/>. | |
15 | ||
16 | (import (readline) (reader) (printer) (ice-9 match) (srfi srfi-43) | |
bea6f6b2 | 17 | (srfi srfi-1) (ice-9 receive) (env)) |
168cd127 NG |
18 | |
19 | (define *primitives* | |
bea6f6b2 NG |
20 | `((+ ,+) |
21 | (- ,-) | |
22 | (* ,*) | |
23 | (/ ,/))) | |
168cd127 NG |
24 | |
25 | (define *toplevel* | |
bea6f6b2 NG |
26 | (receive (b e) (unzip2 *primitives*) |
27 | (make-Env #:binds b #:exprs e))) | |
168cd127 | 28 | |
dd7a4f55 JM |
29 | (define (READ str) |
30 | (read_str str)) | |
168cd127 NG |
31 | |
32 | (define (eval_ast ast env) | |
33 | (define (_eval x) (EVAL x env)) | |
34 | (match ast | |
ecba6e97 | 35 | ((? symbol? sym) (env-has sym env)) |
168cd127 NG |
36 | ((? list? lst) (map _eval lst)) |
37 | ((? vector? vec) (vector-map (lambda (i x) (_eval x)) vec)) | |
38 | ((? hash-table? ht) | |
dd7a4f55 JM |
39 | ;; NOTE: we must allocate a new hashmap here to avoid any side-effects, or |
40 | ;; there'll be strange bugs!!! | |
41 | (list->hash-map (hash-fold (lambda (k v p) (cons k (cons (_eval v) p))) '() ht))) | |
168cd127 NG |
42 | (else ast))) |
43 | ||
168cd127 NG |
44 | (define (EVAL ast env) |
45 | (define (->list kvs) ((if (vector? kvs) vector->list identity) kvs)) | |
46 | (define (%unzip2 kvs) | |
47 | (let lp((next kvs) (k '()) (v '())) | |
48 | (cond | |
49 | ;; NOTE: reverse is very important here! | |
50 | ((null? next) (values (reverse k) (reverse v))) | |
dd7a4f55 JM |
51 | ((null? (cdr next)) |
52 | (throw 'mal-error (format #f "let*: Invalid binding form '~a'" kvs))) | |
168cd127 NG |
53 | (else (lp (cddr next) (cons (car next) k) (cons (cadr next) v)))))) |
54 | (match ast | |
0d9fb576 | 55 | ((? (lambda (x) (not (list? x)))) (eval_ast ast env)) |
81eabb99 | 56 | (() ast) |
168cd127 NG |
57 | (('def! k v) ((env 'set) k (EVAL v env))) |
58 | (('let* kvs body) | |
59 | (let* ((new-env (make-Env #:outer env)) | |
60 | (setter (lambda (k v) ((new-env 'set) k (EVAL v new-env))))) | |
61 | (receive (keys vals) (%unzip2 (->list kvs)) | |
62 | (for-each setter keys vals)) | |
63 | (EVAL body new-env))) | |
dd7a4f55 JM |
64 | (else |
65 | (let ((el (eval_ast ast env))) | |
66 | (apply (car el) (cdr el)))))) | |
168cd127 NG |
67 | |
68 | (define (PRINT exp) | |
69 | (and (not (eof-object? exp)) | |
168cd127 NG |
70 | (format #t "~a~%" (pr_str exp #t)))) |
71 | ||
72 | (define (LOOP continue?) | |
73 | (and continue? (REPL))) | |
74 | ||
75 | (define (REPL) | |
76 | (LOOP | |
dd7a4f55 JM |
77 | (let ((line (_readline "user> "))) |
78 | (cond | |
79 | ((eof-object? line) #f) | |
80 | ((string=? line "") #t) | |
81 | (else | |
82 | (catch 'mal-error | |
83 | (lambda () (PRINT (EVAL (READ line) *toplevel*))) | |
84 | (lambda (k . e) | |
85 | (format #t "Error: ~a~%" (pr_str (car e) #t))))))))) | |
168cd127 NG |
86 | |
87 | (REPL) |