96 lines
3.0 KiB
Scheme
96 lines
3.0 KiB
Scheme
#|procedure:new-cafe
|
|
synopsis:
|
|
(new-cafe [eval])
|
|
description:
|
|
The procedure new-cafe starts a new read-eval-print loop inside
|
|
the current cafe (if one exists). It prompts the user for an
|
|
expression, evaluates it, prints the result back, and repeats the
|
|
process. If new-cafe is called with an argument, eval, then that
|
|
argument must be a procedure that takes a single argument. The
|
|
eval procedure will be used to evaluate the expressions.
|
|
|
|
Every time a new cafe is started, the prompt is changed to reflect
|
|
the depth of the current cafe (i.e. how many eof objects is takes
|
|
to exit the outermost cafe).
|
|
|
|
Input and output performed by the cafe can be changed by the
|
|
console-input-port and console-output-port parameters.
|
|
|
|
If an error occurs during reading, evaluating, or printing an
|
|
expression, then the error is printed to the error-port and the
|
|
operations of the cafe resume as normal.|#
|
|
#|FIXME:new-cafe
|
|
Be specific about what the error-port is |#
|
|
(let ()
|
|
(define with-error-handler
|
|
(lambda (p thunk)
|
|
(let ([old-error-handler (error-handler)])
|
|
(dynamic-wind
|
|
(lambda ()
|
|
(error-handler
|
|
(lambda args
|
|
(error-handler old-error-handler)
|
|
(apply p args)
|
|
(apply error args))))
|
|
thunk
|
|
(lambda ()
|
|
(error-handler old-error-handler))))))
|
|
|
|
(define eval-depth 0)
|
|
|
|
(define display-prompt
|
|
(lambda (i)
|
|
(if (fx= i eval-depth)
|
|
(display " " (console-output-port))
|
|
(begin
|
|
(display ">" (console-output-port))
|
|
(display-prompt (fx+ i 1))))))
|
|
|
|
(define wait
|
|
(lambda (eval escape-k)
|
|
(call/cc
|
|
(lambda (k)
|
|
(with-error-handler
|
|
(lambda args
|
|
(reset-input-port! (console-input-port))
|
|
(apply print-error args)
|
|
(k (void)))
|
|
(lambda ()
|
|
(display-prompt 0)
|
|
(let ([x (read (console-input-port))])
|
|
(cond
|
|
[(eof-object? x)
|
|
(newline (console-output-port))
|
|
(escape-k (void))]
|
|
[else
|
|
(call-with-values
|
|
(lambda () (eval x))
|
|
(lambda v*
|
|
(unless (andmap (lambda (v) (eq? v (void))) v*)
|
|
(for-each
|
|
(lambda (v)
|
|
(write v (console-output-port))
|
|
(newline (console-output-port)))
|
|
v*))))]))))))
|
|
(wait eval escape-k)))
|
|
|
|
(define new-cafe
|
|
(lambda (eval)
|
|
(dynamic-wind
|
|
(lambda () (set! eval-depth (fxadd1 eval-depth)))
|
|
(lambda ()
|
|
(call/cc
|
|
(lambda (k)
|
|
(wait eval k))))
|
|
(lambda () (set! eval-depth (fxsub1 eval-depth))))))
|
|
|
|
(primitive-set! 'new-cafe
|
|
(case-lambda
|
|
[() (new-cafe eval)]
|
|
[(p)
|
|
(unless (procedure? p)
|
|
(error 'new-cafe "~s is not a procedure" p))
|
|
(new-cafe p)]))
|
|
)
|
|
|