conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* added a default-cafe-eval procedure that new-cafe calls by default. 

* defailt-cafe-eval calls chi-library-top.
This commit is contained in:
Abdulaziz Ghuloum 2007-05-03 00:38:42 -04:00
parent 35600203f9
commit f6cafc8f40
2 changed files with 11 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
src/ikarus.boot
View File

Binary file not shown.

17
src/libcafe.ss
View File

@ -61,7 +61,7 @@ description:
(read (console-input-port))))) (read (console-input-port)))))
(define wait (define wait
(lambda (eval escape-k) (lambda (eval-proc escape-k)
(call/cc (call/cc
(lambda (k) (lambda (k)
(with-error-handler (with-error-handler
@ -78,28 +78,33 @@ description:
(escape-k (void))] (escape-k (void))]
[else [else
(call-with-values (call-with-values
(lambda () (eval x)) (lambda () (eval-proc x))
(lambda v* (lambda v*
(unless (andmap (lambda (v) (eq? v (void))) v*) (unless (andmap (lambda (v) (eq? v (void))) v*)
(for-each (for-each
(lambda (v) (lambda (v)
(pretty-print v (console-output-port))) (pretty-print v (console-output-port)))
v*))))])))))) v*))))]))))))
(wait eval escape-k))) (wait eval-proc escape-k)))
(define do-new-cafe (define do-new-cafe
(lambda (eval) (lambda (eval-proc)
(dynamic-wind (dynamic-wind
(lambda () (set! eval-depth (fxadd1 eval-depth))) (lambda () (set! eval-depth (fxadd1 eval-depth)))
(lambda () (lambda ()
(call/cc (call/cc
(lambda (k) (lambda (k)
(wait eval k)))) (wait eval-proc k))))
(lambda () (set! eval-depth (fxsub1 eval-depth)))))) (lambda () (set! eval-depth (fxsub1 eval-depth))))))
(define default-cafe-eval
(lambda (x)
(chi-top-library x)
(void)))
(primitive-set! 'new-cafe (primitive-set! 'new-cafe
(case-lambda (case-lambda
[() (do-new-cafe eval)] [() (do-new-cafe default-cafe-eval)]
[(p) [(p)
(unless (procedure? p) (unless (procedure? p)
(error 'new-cafe "~s is not a procedure" p)) (error 'new-cafe "~s is not a procedure" p))