This will do the trick:
(define (assert-flonum! who x)
(let* ((arguments (call/cc (lambda (return) (cons return x))))
(return (car arguments))
(x (cdr arguments)))
(with-restart
'use-value
"Retry with a flonum."
(lambda (new-value) (return (cons return new-value)))
(lambda ()
(prompt-for-evaluated-expression "New value"))
(lambda ()
(if (flonum? x)
x
(error:wrong-type-argument x "flonum" who))))))
The identifier retry is replaced with return since the former wasn't bound,
and values is replaced as interactor with the
prompt-for-evaluated-expression thunk. I also replaced the unless with an if
so that assert-flonum! would always return a value, although that isn't
necessary.
But this is simpler:
(define (assert-flonum! who x)
(call-with-current-continuation
(lambda (escape)
(with-restart
'retry-flonum
"Prompt for a new flonum value."
(lambda (x*) (escape (assert-flonum! who x*)))
(lambda () (prompt-for-evaluated-expression "New value"))
(lambda ()
(if (flonum? x)
x
(error:wrong-type-argument x "flonum" who)))))))
That still captures a continuation every time around, even when there is no
error. This duplicates a tiny bit of code, but would be faster:
(define (assert-flonum! who x)
(if (flonum? x)
x
(call-with-current-continuation
(lambda (escape)
(with-restart
'retry-flonum
"Prompt for a new flonum value."
(lambda (x*) (escape (assert-flonum! who x*)))
(lambda () (prompt-for-evaluated-expression "New value"))
(lambda ()
(if (flonum? x)
x
(error:wrong-type-argument x "flonum" who))))))))
Here's an example of it in use:
1 ]=> (assert-flonum! 'who 1)
;The object 1, passed as an argument to who, is not a flonum.;To
continue, call RESTART with an option number:; (RESTART 2) => Prompt
for a new flonum value.; (RESTART 1) => Return to read-eval-print
level 1.
2 error> (restart 2)
New value: 'a
;The object a, passed as an argument to who, is not a flonum.;To
continue, call RESTART with an option number:; (RESTART 3) => Prompt
for a new flonum value.; (RESTART 2) => Return to read-eval-print
level 2.; (RESTART 1) => Return to read-eval-print level 1.
3 error> (restart 3)
New value: 1.0
;Value: 1.
1 ]=>
But take all of this with a grain of salt because I'm a novice at using the
restart system.
