diff options
-rw-r--r-- | main.scm | 36 |
1 files changed, 27 insertions, 9 deletions
@@ -1,8 +1,10 @@ | |||
1 | (include "prelude/primitives.scm") | 1 | (add-to-load-path ".") |
2 | (include "util/table.scm") | 2 | (add-to-load-path "util/") |
3 | (include "util/alist.scm") | 3 | (add-to-load-path "prelude/") |
4 | 4 | ||
5 | (define (lift-bool expr) (if expr 'true 'false)) | 5 | (use-modules (environment)) |
6 | (use-modules (prelude/primitives)) | ||
7 | (use-modules (util/alist)) | ||
6 | 8 | ||
7 | (define (tagged? expr tag) | 9 | (define (tagged? expr tag) |
8 | (if (pair? expr) | 10 | (if (pair? expr) |
@@ -32,11 +34,7 @@ | |||
32 | (define (operands expr) (cdr expr)) | 34 | (define (operands expr) (cdr expr)) |
33 | (define (no-operands? expr) (null? expr)) | 35 | (define (no-operands? expr) (null? expr)) |
34 | (define (list-of-values ls env) | 36 | (define (list-of-values ls env) |
35 | (if (no-operands? ls) | 37 | (map (lambda (l) (eval-expr l env)) ls)) |
36 | '() | ||
37 | (let ([first (eval-expr (car ls) env)]) | ||
38 | (let ([rest (list-of-values (cdr ls) env)]) | ||
39 | (cons first rest))))) | ||
40 | 38 | ||
41 | ;;; quoted expressions | 39 | ;;; quoted expressions |
42 | (define (quote-form? expr) (tagged? expr 'quote)) | 40 | (define (quote-form? expr) (tagged? expr 'quote)) |
@@ -70,3 +68,23 @@ | |||
70 | (cond | 68 | (cond |
71 | [(primitive? proc) (apply-primitive-proc proc args)] | 69 | [(primitive? proc) (apply-primitive-proc proc args)] |
72 | [else 'false])) | 70 | [else 'false])) |
71 | |||
72 | (define the-global-env (setup-environment)) | ||
73 | (define input-prompt ";;; CIRCLE INPUT ") | ||
74 | (define output-prompt ";;; CIRCLE OUTPUT ") | ||
75 | (define (driver-loop) | ||
76 | (begin | ||
77 | (newline) | ||
78 | (display input-prompt) | ||
79 | (newline) | ||
80 | (let ([input (read)]) | ||
81 | (let ([output (eval-expr input the-global-env)]) | ||
82 | (begin | ||
83 | (display output-prompt) | ||
84 | (newline) | ||
85 | (show-lisp-expr output) | ||
86 | (newline) | ||
87 | (driver-loop)))))) | ||
88 | |||
89 | (define (show-lisp-expr object) | ||
90 | (display object)) | ||