author | Tony Garnock-Jones <tonyg@kcbbs.gen.nz> |
Tue, 06 Jan 2009 00:48:48 +1300 | |
changeset 191 | f340b63ce5a7 |
parent 190 | 903b8ad8b6f1 |
child 192 | c5a04feea230 |
permissions | -rw-r--r-- |
190
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1 |
(define-syntax define-global! |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2 |
(syntax-rules () |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
3 |
((_ 'name value) (define name value)))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
4 |
|
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
5 |
(define gensym |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
6 |
(let ((counter 14641)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
7 |
(lambda () |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
8 |
(let ((v (string->symbol (string-append "g" (number->string counter))))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
9 |
(set! counter (+ counter 1)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
10 |
v)))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
11 |
|
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
12 |
(define-global! 'map |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
13 |
(lambda (f l) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
14 |
(if (null? l) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
15 |
'() |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
16 |
(cons (f (car l)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
17 |
(map f (cdr l)))))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
18 |
|
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
19 |
(define-global! 'global-env |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
20 |
(let () |
191
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
21 |
(define (prim0 f) (lambda (arguments k) (k (f)))) |
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
22 |
(define (prim1 f) (lambda (arguments k) (k (f (car arguments))))) |
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
23 |
(define (prim2 f) (lambda (arguments k) (k (f (car arguments) (cadr arguments))))) |
190
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
24 |
(define (munge-entry entry) (cons (car entry) (cons (cadr entry) (box (caddr entry))))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
25 |
(map munge-entry |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
26 |
`((let macro ,(lambda (x env exp) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
27 |
(let ((names (map car (cadr x))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
28 |
(inits (map cadr (cadr x))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
29 |
(exps (cddr x))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
30 |
(exp `((lambda ,names ,@exps) ,@inits))))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
31 |
(cond macro ,(lambda (x env exp) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
32 |
(exp (cond |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
33 |
((null? (cdr x)) `(begin)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
34 |
((eq? (caadr x) 'else) `(begin ,@(cdadr x))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
35 |
(else `(if ,(caadr x) (begin ,@(cdadr x)) (cond ,@(cddr x)))))))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
36 |
(case macro ,(lambda (x env exp) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
37 |
(let ((v (gensym))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
38 |
(exp `(let ((,v ,(cadr x))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
39 |
(cond |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
40 |
,@(map (lambda (clause) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
41 |
(cond |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
42 |
((eq? (car clause) 'else) clause) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
43 |
((null? (cdar clause)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
44 |
`((eq? ,v ',(caar clause)) ,@(cdr clause))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
45 |
(else (12345678 'multi-case-not-supported clause)))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
46 |
(cddr x)))))))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
47 |
(and macro ,(lambda (x env exp) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
48 |
(exp (cond |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
49 |
((null? (cdr x)) `(begin)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
50 |
((null? (cddr x)) (cadr x)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
51 |
(else `(if ,(cadr x) (and ,@(cddr x)) #f)))))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
52 |
(,'quasiquote macro |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
53 |
,(lambda (x env exp) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
54 |
(define (qq exp depth) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
55 |
(cond |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
56 |
((not (pair? exp)) `(quote ,exp)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
57 |
((eq? (car exp) 'quasiquote) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
58 |
`(cons 'quasiquote (cons ,(qq (cadr exp) (+ depth 1)) '()))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
59 |
((eq? (car exp) 'unquote) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
60 |
(if (= depth 1) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
61 |
(cadr exp) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
62 |
`(cons ','unquote (cons ,(qq (cadr exp) (- depth 1)) '())))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
63 |
((and (pair? (car exp)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
64 |
(eq? (caar exp) 'unquote-splicing)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
65 |
(if (= depth 1) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
66 |
`(append ,(cadar exp) ,(qq (cdr exp) depth)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
67 |
`(cons ,(qq (car exp) (- depth 1)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
68 |
,(qq (cdr exp) depth)))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
69 |
(else `(cons ,(qq (car exp) depth) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
70 |
,(qq (cdr exp) depth))))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
71 |
(exp (qq (cadr x) 1)))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
72 |
(define-global! global ,(prim2 |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
73 |
(lambda (name value) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
74 |
;; FIXME: should set if entry already exists! |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
75 |
(set! global-env (cons (munge-entry |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
76 |
(cons name |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
77 |
(cons 'global |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
78 |
(cons value '())))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
79 |
global-env))))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
80 |
|
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
81 |
(cdr global ,(prim1 cdr)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
82 |
(cddr global ,(prim1 cddr)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
83 |
(cddar global ,(prim1 cddar)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
84 |
(cdar global ,(prim1 cdar)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
85 |
(cdadr global ,(prim1 cdadr)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
86 |
(car global ,(prim1 car)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
87 |
(cadr global ,(prim1 cadr)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
88 |
(caddr global ,(prim1 caddr)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
89 |
(cadddr global ,(prim1 cadddr)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
90 |
(cadar global ,(prim1 cadar)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
91 |
(caar global ,(prim1 caar)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
92 |
(caadr global ,(prim1 caadr)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
93 |
|
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
94 |
(box global ,(prim1 box)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
95 |
(unbox global ,(prim1 unbox)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
96 |
(set-box! global ,(prim2 set-box!)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
97 |
|
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
98 |
(append global ,(prim2 append)) |
191
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
99 |
(reverse global ,(prim1 reverse)) |
190
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
100 |
(cons global ,(prim2 cons)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
101 |
(eq? global ,(prim2 eq?)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
102 |
(= global ,(prim2 =)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
103 |
(not global ,(prim1 not)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
104 |
(null? global ,(prim1 null?)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
105 |
(pair? global ,(prim1 pair?)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
106 |
(symbol? global ,(prim1 symbol?)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
107 |
|
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
108 |
(gensym global ,(prim0 gensym)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
109 |
|
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
110 |
)))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
111 |
|
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
112 |
(define-global! 'eval |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
113 |
(let () |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
114 |
(define (error key val) (12345678 'magic-error-procedure key val)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
115 |
(define (undefined) 17) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
116 |
(define (env-null? env) (null? env)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
117 |
(define (env-name env) (caar env)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
118 |
(define (env-kind env) (cadar env)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
119 |
(define (env-value env) (unbox (cddar env))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
120 |
(define (set-env-value! env value) (set-box! (cddar env) value)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
121 |
(define (env-next env) (cdr env)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
122 |
(define (make-env name kind value next) (cons (cons name (cons kind (box value))) next)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
123 |
(define (search-one-env env n k fk) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
124 |
(cond |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
125 |
((env-null? env) (fk)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
126 |
((eq? (env-name env) n) (k (env-kind env) (env-value env) env)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
127 |
(else (search-one-env (env-next env) n k fk)))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
128 |
(define (search-env env n k fk) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
129 |
(search-one-env env n k (lambda () (search-one-env global-env n k fk)))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
130 |
(define (expand x env) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
131 |
(if (and (pair? x) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
132 |
(symbol? (car x))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
133 |
(search-env env (car x) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
134 |
(lambda (kind v cell) (if (eq? kind 'macro) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
135 |
(v x env (lambda (exp) (expand exp env))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
136 |
x)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
137 |
(lambda () x)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
138 |
x)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
139 |
(define (make-recursive-env defs env) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
140 |
(if (null? defs) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
141 |
env |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
142 |
(make-env (caar defs) 'local #f (make-recursive-env (cdr defs) env)))) |
191
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
143 |
(define (e-recursive-definitions defs xs env k) |
190
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
144 |
(let ((new-env (make-recursive-env defs env))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
145 |
(define (fill-init defs pos) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
146 |
(if (null? defs) |
191
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
147 |
(e (cons 'begin xs) new-env k) |
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
148 |
(e (cdar defs) new-env |
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
149 |
(lambda (v) |
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
150 |
(set-env-value! pos v) |
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
151 |
(fill-init (cdr defs) (env-next pos)))))) |
190
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
152 |
(fill-init defs new-env))) |
191
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
153 |
(define (e-body defs xs env k) |
190
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
154 |
(if (null? xs) |
191
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
155 |
(e-recursive-definitions defs xs env k) |
190
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
156 |
(let ((x (expand (car xs) env))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
157 |
(if (not (pair? x)) |
191
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
158 |
(e-recursive-definitions defs (cons x (cdr xs)) env k) |
190
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
159 |
(case (car x) |
191
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
160 |
((begin) (e-body defs (append (cdr x) (cdr xs)) env k)) |
190
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
161 |
((define) (if (pair? (cadr x)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
162 |
(e-body (cons (cons (caadr x) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
163 |
`(lambda ,(cdadr x) ,@(cddr x))) |
191
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
164 |
defs) (cdr xs) env k) |
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
165 |
(e-body (cons (cons (cadr x) (caddr x)) defs) (cdr xs) env k))) |
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
166 |
(else (e-recursive-definitions defs (cons x (cdr xs)) env k))))))) |
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
167 |
(define (extend-env-with-actuals formals actuals env) |
190
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
168 |
(if (null? formals) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
169 |
env |
191
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
170 |
(make-env (car formals) 'local (car actuals) |
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
171 |
(extend-env-with-actuals (cdr formals) (cdr actuals) env)))) |
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
172 |
(define (e-operands operator unevaluated evaluated env k) |
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
173 |
(if (null? unevaluated) |
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
174 |
(operator (reverse evaluated) k) |
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
175 |
(e (car unevaluated) env |
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
176 |
(lambda (newly-evaluated) |
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
177 |
(e-operands operator (cdr unevaluated) (cons newly-evaluated evaluated) env k))))) |
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
178 |
(define (e x env k) |
190
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
179 |
(let ((x (expand x env))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
180 |
(cond |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
181 |
((symbol? x) (search-env env x |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
182 |
(lambda (kind v cell) (if (eq? kind 'macro) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
183 |
(error 'macro-in-variable-position x) |
191
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
184 |
(k v))) |
190
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
185 |
(lambda () (error 'unbound-variable x)))) |
191
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
186 |
((not (pair? x)) (k x)) |
190
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
187 |
(else |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
188 |
(case (car x) |
191
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
189 |
((quote) (k (cadr x))) |
190
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
190 |
((define) (error 'internal-definition-in-invalid-position x)) |
191
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
191 |
((lambda) (k (lambda (actuals k) |
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
192 |
(let ((new-env (extend-env-with-actuals (cadr x) actuals env))) |
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
193 |
(e-body '() (cddr x) new-env k))))) |
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
194 |
((begin) (cond ((null? (cdr x)) (k (undefined))) |
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
195 |
((null? (cddr x)) (e (cadr x) env k)) |
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
196 |
(else (e (cadr x) env |
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
197 |
(lambda (v) |
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
198 |
(e (cons 'begin (cddr x)) env k)))))) |
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
199 |
((if) (e (cadr x) env |
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
200 |
(lambda (v) |
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
201 |
(if v |
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
202 |
(e (caddr x) env k) |
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
203 |
(e (cadddr x) env k))))) |
190
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
204 |
((set!) (search-env env (cadr x) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
205 |
(lambda (kind v cell) (if (eq? kind 'macro) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
206 |
(error 'macro-in-variable-position x) |
191
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
207 |
(e (caddr x) env |
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
208 |
(lambda (v) |
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
209 |
(set-env-value! cell v) |
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
210 |
(k v))))) |
190
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
211 |
(lambda () (error 'unbound-variable x)))) |
191
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
212 |
(else (e (car x) env |
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
213 |
(lambda (operator) |
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
214 |
(e-operands operator (cdr x) '() env k))))))))) |
190
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
215 |
(lambda (x) |
191
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
216 |
(e x '() (lambda (v) v))))) |
190
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
217 |
|
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
218 |
(define (syms x) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
219 |
(cond |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
220 |
((pair? x) (syms (car x)) (syms (cdr x))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
221 |
((null? x)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
222 |
(else (write x) (newline)))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
223 |
|
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
224 |
(define (r) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
225 |
(display ">>> ") |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
226 |
(let ((x (read))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
227 |
(if (eof-object? x) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
228 |
'done |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
229 |
(begin (write (eval x)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
230 |
(newline) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
231 |
(r))))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
232 |
|
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
233 |
(eval `(define-global! 'global-env ',global-env)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
234 |
(r) |