Commit | Line | Data |
---|---|---|
6a733491 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)) | |
17 | ||
18 | (define *toplevel* | |
19 | `((+ . ,+) | |
20 | (- . ,-) | |
21 | (* . ,*) | |
22 | (/ . ,/))) | |
23 | ||
24 | (define (READ) | |
94a0943a | 25 | (read_str (_readline "user> "))) |
6a733491 NG |
26 | |
27 | (define (eval_ast ast env) | |
28 | (define (_eval x) (EVAL x env)) | |
29 | (match ast | |
30 | ((? symbol? sym) | |
31 | (or (assoc-ref env sym) | |
1288d9be | 32 | (throw 'mal-error (format #f "'~a' not found" sym)))) |
6a733491 NG |
33 | ((? list? lst) (map _eval lst)) |
34 | ((? vector? vec) (vector-map (lambda (i x) (_eval x)) vec)) | |
35 | ((? hash-table? ht) | |
36 | (hash-for-each (lambda (k v) (hash-set! ht k (_eval v))) ht) | |
37 | ht) | |
38 | (else ast))) | |
39 | ||
40 | (define (eval_func ast env) | |
168cd127 NG |
41 | (define expr (eval_ast ast env)) |
42 | (match expr | |
f7622770 NG |
43 | (((? procedure? proc) args ...) |
44 | (apply proc args)) | |
98cd78e4 | 45 | (else (throw 'mal-error (format #f "'~a' not found" (car expr)))))) |
6a733491 NG |
46 | |
47 | (define (EVAL ast env) | |
48 | (match ast | |
efa2daef | 49 | (() ast) |
6a733491 NG |
50 | ((? list?) (eval_func ast env)) |
51 | (else (eval_ast ast env)))) | |
52 | ||
53 | (define (PRINT exp) | |
54 | (and (not (eof-object? exp)) | |
6a733491 NG |
55 | (format #t "~a~%" (pr_str exp #t)))) |
56 | ||
57 | (define (LOOP continue?) | |
58 | (and continue? (REPL))) | |
59 | ||
60 | (define (REPL) | |
61 | (LOOP | |
62 | (catch 'mal-error | |
63 | (lambda () (PRINT (EVAL (READ) *toplevel*))) | |
64 | (lambda (k . e) | |
f33a3d58 NG |
65 | (if (string=? (car e) "blank line") |
66 | (display "") | |
67 | (format #t "Error: ~a~%" (car e))))))) | |
6a733491 NG |
68 | |
69 | (REPL) |