compat: Add prompts for Mes.
* gash/compat.scm [mes] (make-prompt-tag): Return a fluid. [mes] (abort-to-prompt): New procedure. [mes] (call-with-prompt): New procedure.
This commit is contained in:
parent
52e03d4d22
commit
10ee7d286e
|
@ -92,6 +92,8 @@
|
||||||
the-eof-object
|
the-eof-object
|
||||||
noop
|
noop
|
||||||
make-prompt-tag
|
make-prompt-tag
|
||||||
|
call-with-prompt
|
||||||
|
abort-to-prompt
|
||||||
canonicalize-path
|
canonicalize-path
|
||||||
X_OK
|
X_OK
|
||||||
program-arguments
|
program-arguments
|
||||||
|
@ -152,7 +154,47 @@
|
||||||
(define (noop . args) #f)
|
(define (noop . args) #f)
|
||||||
|
|
||||||
(define* (make-prompt-tag #:optional (stem "prompt"))
|
(define* (make-prompt-tag #:optional (stem "prompt"))
|
||||||
(list stem))
|
(make-fluid (lambda args (error "Abort to unknown prompt"))))
|
||||||
|
|
||||||
|
(define (abort-to-prompt tag . args)
|
||||||
|
(call-with-current-continuation
|
||||||
|
(lambda (cc)
|
||||||
|
(apply (fluid-ref tag) cc args))))
|
||||||
|
|
||||||
|
(define (call-with-prompt tag thunk handler)
|
||||||
|
;; We are going to wrap THUNK and HANDLER so that they both adhere
|
||||||
|
;; to the same interface. They will both return a list, with the
|
||||||
|
;; first element being a procedure to apply to the rest of the
|
||||||
|
;; elements. Then, in the normal case, we will set the first
|
||||||
|
;; element to the identity procedure so that it just passes along
|
||||||
|
;; what THUNK would have returned. In the case where the thunk
|
||||||
|
;; aborts to the prompt, we set the first element to HANDLER so that
|
||||||
|
;; it can be invoked after te stack has been unwound.
|
||||||
|
|
||||||
|
;; XXX: We should handle multiple values, but Mes has some bugs
|
||||||
|
;; which makes this difficult.
|
||||||
|
|
||||||
|
;; This is the normal case: collect the values returned by THUNK,
|
||||||
|
;; and wrap them with a "handler" procedure ('identity'), which will
|
||||||
|
;; just return them as-is.
|
||||||
|
(define (return-normally)
|
||||||
|
(cons identity (list (thunk))))
|
||||||
|
|
||||||
|
;; Here the thunk has aborted to the prompt, so we need to unwind
|
||||||
|
;; the stack (using KONT), and use HANDLER itself as the handler
|
||||||
|
;; procedure.
|
||||||
|
(define (make-handler-return kont)
|
||||||
|
(lambda args
|
||||||
|
(kont (cons handler args))))
|
||||||
|
|
||||||
|
;; This is the part the invokes the handlers described above.
|
||||||
|
(let* ((handler+args (call-with-current-continuation
|
||||||
|
(lambda (kont)
|
||||||
|
(with-fluids ((tag (make-handler-return kont)))
|
||||||
|
(return-normally)))))
|
||||||
|
(handler (car handler+args))
|
||||||
|
(args (cdr handler+args)))
|
||||||
|
(apply handler args)))
|
||||||
|
|
||||||
;; XXX: Actually implement this.
|
;; XXX: Actually implement this.
|
||||||
(define (canonicalize-path path) path)
|
(define (canonicalize-path path) path)
|
||||||
|
|
Loading…
Reference in New Issue