author | Tony Garnock-Jones <tonyg@kcbbs.gen.nz> |
Sat, 17 Jan 2009 11:29:29 +1300 | |
changeset 196 | 8a7a9ab12cba |
parent 195 | eacc4e318dae |
child 197 | 49e38e2ead1d |
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))))) |
192
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
24 |
(define (munge-entry entry) (cons (car entry) (cons (box (cadr entry)) (box (caddr entry))))) |
190
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) |
193
51d1e29d5e12
Change 'quasiquote to ','quasiquote -- this lets metacircular compilation work
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
192
diff
changeset
|
58 |
`(cons ','quasiquote (cons ,(qq (cadr exp) (+ depth 1)) '()))) |
190
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 |
|
196
8a7a9ab12cba
Add primitive (length), which I had missed before. It's needed by make-eval now.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
195
diff
changeset
|
98 |
(length global ,(prim1 length)) |
190
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
99 |
(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
|
100 |
(reverse global ,(prim1 reverse)) |
190
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
101 |
(cons global ,(prim2 cons)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
102 |
(eq? global ,(prim2 eq?)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
103 |
(= global ,(prim2 =)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
104 |
(not global ,(prim1 not)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
105 |
(null? global ,(prim1 null?)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
106 |
(pair? global ,(prim1 pair?)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
107 |
(symbol? global ,(prim1 symbol?)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
108 |
|
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
109 |
(gensym global ,(prim0 gensym)) |
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 |
|
192
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
113 |
(define-global! 'make-eval |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
114 |
(lambda ( |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
115 |
error |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
116 |
undefined |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
117 |
allocate-env |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
118 |
update-env |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
119 |
load-env |
194
84461d0a5c25
Add a hook for an unbound global reference, to permit compilation.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
193
diff
changeset
|
120 |
unbound-variable-read |
192
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
121 |
load-literal |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
122 |
load-closure |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
123 |
do-if |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
124 |
push-frame |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
125 |
update-frame |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
126 |
do-call |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
127 |
push-continuation |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
128 |
) |
190
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
129 |
(define (env-null? env) (null? env)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
130 |
(define (env-name env) (caar env)) |
192
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
131 |
(define (env-annotation env) (unbox (cadar env))) |
190
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
132 |
(define (env-value env) (unbox (cddar env))) |
192
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
133 |
(define (set-env-value! env value) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
134 |
(set-box! (cadar env) (update-env (env-name env) (env-annotation env) value)) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
135 |
(set-box! (cddar env) value)) |
190
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
136 |
(define (env-next env) (cdr env)) |
192
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
137 |
(define (make-env name value next) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
138 |
(cons (cons name (cons (box (allocate-env name value)) (box value))) next)) |
190
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
139 |
(define (search-one-env env n k fk) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
140 |
(cond |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
141 |
((env-null? env) (fk)) |
192
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
142 |
((eq? (env-name env) n) (k (env-annotation env) (env-value env) env)) |
190
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
143 |
(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
|
144 |
(define (search-env env n k fk) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
145 |
(search-one-env env n k (lambda () (search-one-env global-env n k fk)))) |
192
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
146 |
;; BUG: not proper expansion-passing-style; need separate expansion phase! |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
147 |
;; (how else to implement macrolet?) |
190
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
148 |
(define (expand x env) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
149 |
(if (and (pair? x) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
150 |
(symbol? (car x))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
151 |
(search-env env (car x) |
192
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
152 |
(lambda (annotation v cell) (if (eq? annotation 'macro) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
153 |
(v x env (lambda (exp) (expand exp env))) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
154 |
x)) |
190
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
155 |
(lambda () x)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
156 |
x)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
157 |
(define (make-recursive-env defs env) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
158 |
(if (null? defs) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
159 |
env |
192
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
160 |
(make-env (caar defs) #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
|
161 |
(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
|
162 |
(let ((new-env (make-recursive-env defs env))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
163 |
(define (fill-init defs pos) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
164 |
(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
|
165 |
(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
|
166 |
(e (cdar defs) new-env |
192
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
167 |
(push-continuation |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
168 |
(lambda (v) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
169 |
(set-env-value! pos v) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
170 |
(fill-init (cdr defs) (env-next pos))))))) |
190
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
171 |
(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
|
172 |
(define (e-body defs xs env k) |
190
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
173 |
(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
|
174 |
(e-recursive-definitions defs xs env k) |
190
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
175 |
(let ((x (expand (car xs) env))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
176 |
(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
|
177 |
(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
|
178 |
(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
|
179 |
((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
|
180 |
((define) (if (pair? (cadr x)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
181 |
(e-body (cons (cons (caadr x) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
182 |
`(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
|
183 |
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
|
184 |
(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
|
185 |
(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
|
186 |
(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
|
187 |
(if (null? formals) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
188 |
env |
192
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
189 |
(make-env (car formals) (car actuals) |
191
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
190 |
(extend-env-with-actuals (cdr formals) (cdr actuals) env)))) |
192
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
191 |
(define (e-operands index unevaluated evaluated env k) |
191
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
192 |
(if (null? unevaluated) |
192
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
193 |
(k (reverse evaluated)) |
191
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
194 |
(e (car unevaluated) env |
192
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
195 |
(push-continuation |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
196 |
(lambda (newly-evaluated) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
197 |
(e-operands (+ index 1) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
198 |
(cdr unevaluated) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
199 |
(cons (update-frame index newly-evaluated) evaluated) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
200 |
env |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
201 |
k)))))) |
191
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
202 |
(define (e x env k) |
190
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
203 |
(let ((x (expand x env))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
204 |
(cond |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
205 |
((symbol? x) (search-env env x |
192
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
206 |
(lambda (annotation v cell) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
207 |
(if (eq? annotation 'macro) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
208 |
(error 'macro-in-variable-position x) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
209 |
(k (load-env x annotation v)))) |
194
84461d0a5c25
Add a hook for an unbound global reference, to permit compilation.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
193
diff
changeset
|
210 |
(lambda () |
84461d0a5c25
Add a hook for an unbound global reference, to permit compilation.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
193
diff
changeset
|
211 |
(k (unbound-variable-read x))))) |
192
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
212 |
((not (pair? x)) (k (load-literal x))) |
190
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
213 |
(else |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
214 |
(case (car x) |
192
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
215 |
((quote) (k (load-literal (cadr x)))) |
190
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
216 |
((define) (error 'internal-definition-in-invalid-position x)) |
192
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
217 |
((lambda) (k (load-closure |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
218 |
(cadr x) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
219 |
(lambda (actuals k) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
220 |
(let ((new-env (extend-env-with-actuals (cadr x) actuals env))) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
221 |
(e-body '() (cddr x) new-env k)))))) |
191
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
222 |
((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
|
223 |
((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
|
224 |
(else (e (cadr x) env |
192
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
225 |
(push-continuation |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
226 |
(lambda (v) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
227 |
(e (cons 'begin (cddr x)) env k))))))) |
191
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
228 |
((if) (e (cadr x) env |
192
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
229 |
(push-continuation |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
230 |
(lambda (v) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
231 |
(do-if v |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
232 |
(lambda () (e (caddr x) env k)) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
233 |
(lambda () (e (cadddr x) env k))))))) |
190
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
234 |
((set!) (search-env env (cadr x) |
192
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
235 |
(lambda (annotation v cell) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
236 |
(if (eq? annotation 'macro) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
237 |
(error 'macro-in-variable-position x) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
238 |
(e (caddr x) env |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
239 |
(push-continuation |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
240 |
(lambda (v) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
241 |
(set-env-value! cell v) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
242 |
(k v)))))) |
190
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
243 |
(lambda () (error 'unbound-variable x)))) |
192
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
244 |
(else (e-operands 0 (cdr x) '() env |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
245 |
(push-frame (length (cdr x)) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
246 |
(lambda (operands) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
247 |
(e (car x) env |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
248 |
(push-continuation |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
249 |
(lambda (operator) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
250 |
(do-call operator operands k))))))))))))) |
190
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
251 |
(lambda (x) |
191
f340b63ce5a7
Convert simple scheme-like evaluator to continuation-passing style.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
190
diff
changeset
|
252 |
(e x '() (lambda (v) v))))) |
190
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
253 |
|
192
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
254 |
(define-global! 'eval |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
255 |
(let () |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
256 |
(define (error key val) (12345678 'magic-error-procedure key val)) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
257 |
(define (undefined) 17) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
258 |
(define (allocate-env name v) 'local) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
259 |
(define (update-env name old-annotation v) old-annotation) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
260 |
(define (load-env name annotation v) v) |
194
84461d0a5c25
Add a hook for an unbound global reference, to permit compilation.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
193
diff
changeset
|
261 |
(define (unbound-variable-read x) (error 'unbound-variable-read x)) |
192
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
262 |
(define (load-literal x) x) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
263 |
(define (load-closure formals f) f) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
264 |
(define (do-if v tk fk) (if v (tk) (fk))) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
265 |
(define (push-frame count k) k) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
266 |
(define (update-frame index v) v) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
267 |
(define (do-call operator operands k) (operator operands k)) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
268 |
(define (push-continuation k) k) |
194
84461d0a5c25
Add a hook for an unbound global reference, to permit compilation.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
193
diff
changeset
|
269 |
(make-eval error undefined allocate-env update-env load-env unbound-variable-read |
84461d0a5c25
Add a hook for an unbound global reference, to permit compilation.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
193
diff
changeset
|
270 |
load-literal load-closure do-if push-frame update-frame do-call push-continuation))) |
192
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
271 |
|
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
272 |
(define-global! 'compile |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
273 |
(lambda (exp) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
274 |
(let ((continuation-depth (make-parameter 0))) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
275 |
(define (error key val) (12345678 'magic-error-procedure key val)) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
276 |
(define (undefined) (load-literal 17)) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
277 |
(define (allocate-env name v) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
278 |
(write `(allocate-env ,name ,v)) (newline) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
279 |
'local) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
280 |
(define (update-env name old-annotation v) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
281 |
(write `(update-env ,name ,old-annotation)) (newline) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
282 |
old-annotation) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
283 |
(define (load-env name annotation v) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
284 |
(write `(load-env ,name ,annotation)) (newline) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
285 |
v) |
194
84461d0a5c25
Add a hook for an unbound global reference, to permit compilation.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
193
diff
changeset
|
286 |
(define (unbound-variable-read name) |
84461d0a5c25
Add a hook for an unbound global reference, to permit compilation.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
193
diff
changeset
|
287 |
(write `(load-implicit-global ,name)) (newline) |
84461d0a5c25
Add a hook for an unbound global reference, to permit compilation.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
193
diff
changeset
|
288 |
'implicit-global-value) |
192
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
289 |
(define (load-literal x) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
290 |
(write `(load-literal ,x)) (newline) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
291 |
x) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
292 |
(define (load-closure formals f) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
293 |
(write `(load-closure ,formals)) (newline) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
294 |
(parameterize ((continuation-depth 0)) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
295 |
(write `(IN================)) (newline) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
296 |
(f formals (lambda (v) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
297 |
(write `(return)) (newline) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
298 |
v)) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
299 |
(write `(OUT===============)) (newline) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
300 |
'closure-result)) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
301 |
(define (do-if v tk fk) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
302 |
(write `(do-if ,v)) (newline) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
303 |
(write `tk) (newline) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
304 |
(tk) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
305 |
(write `fk) (newline) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
306 |
(fk)) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
307 |
(define (push-frame count k) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
308 |
(write `(push-frame ,count)) (newline) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
309 |
k) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
310 |
(define (update-frame index v) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
311 |
(write `(update-frame ,index ,v)) (newline) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
312 |
v) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
313 |
(define (do-call operator operands k) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
314 |
(write `(do-call ,(if (= (continuation-depth) 0) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
315 |
'tailcall |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
316 |
'normalcall) ,operator ,operands)) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
317 |
(newline) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
318 |
(k 'do-call-result)) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
319 |
(define (push-continuation k) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
320 |
;;(write `(push-continuation)) (newline) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
321 |
(continuation-depth (+ (continuation-depth) 1)) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
322 |
(lambda (v) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
323 |
;;(write `(pop-continuation ,v)) (newline) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
324 |
(continuation-depth (- (continuation-depth) 1)) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
325 |
(k v))) |
194
84461d0a5c25
Add a hook for an unbound global reference, to permit compilation.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
193
diff
changeset
|
326 |
((make-eval error undefined allocate-env update-env load-env unbound-variable-read |
84461d0a5c25
Add a hook for an unbound global reference, to permit compilation.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
193
diff
changeset
|
327 |
load-literal load-closure do-if push-frame update-frame do-call push-continuation) |
192
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
328 |
exp)))) |
c5a04feea230
Prepare for conversion to a partial-evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
191
diff
changeset
|
329 |
|
190
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
330 |
(define (syms x) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
331 |
(cond |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
332 |
((pair? x) (syms (car x)) (syms (cdr x))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
333 |
((null? x)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
334 |
(else (write x) (newline)))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
335 |
|
195
eacc4e318dae
Make (r) into (r* repl-eval), to permit (r* compile).
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
194
diff
changeset
|
336 |
(define (r* repl-eval) |
190
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
337 |
(display ">>> ") |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
338 |
(let ((x (read))) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
339 |
(if (eof-object? x) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
340 |
'done |
195
eacc4e318dae
Make (r) into (r* repl-eval), to permit (r* compile).
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
194
diff
changeset
|
341 |
(begin (write (repl-eval x)) |
190
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
342 |
(newline) |
195
eacc4e318dae
Make (r) into (r* repl-eval), to permit (r* compile).
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
194
diff
changeset
|
343 |
(r* repl-eval))))) |
eacc4e318dae
Make (r) into (r* repl-eval), to permit (r* compile).
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
194
diff
changeset
|
344 |
|
eacc4e318dae
Make (r) into (r* repl-eval), to permit (r* compile).
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
194
diff
changeset
|
345 |
(define (r) (r* eval)) |
190
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
346 |
|
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
347 |
(eval `(define-global! 'global-env ',global-env)) |
903b8ad8b6f1
Self-hostable scheme-like evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
348 |
(r) |