[racket] Scribble: Getting BSL error messages

On Apr 14, 2014, at 1:04 PM, Klaus Ostermann <klaus612 at gmail.com> wrote:

> I'm using Scribble to write lecture notes on the "Beginning Student
> Language".
> 
> To this end, I'm using
> 
> @(require (for-label lang/htdp-beginner))
> 
> to get the bindings for the functions defined in BSL.
> 
> However, if I want to illustrate an error, I get the wrong error message.
> 
> For instance,
> 
> @ex[(number->string "asdf")]
> 
> gives the ouput:
> 
>> (number->string "asdf")
> 
> number->string: contract violation
>  expected: number?
>  given: "asdf"
> 
> 
> rather than the expected:
> 
>> (number->string "asdf")
> 
> number->string: expects a number, given "asdf"
> 
> What do I need to do to get the BSL error messages?

;; Here is the code from the shared library in HtDP/2e: 

(require teachpack/2htdp/scribblings/img-eval)

(define-syntax-rule
  (*sl-eval module-lang reader def ...)
  ;; ===>>>
  (let ()
    (define me (parameterize ([sandbox-propagate-exceptions #f])
                 (make-img-eval)))
    (me '(require (only-in racket empty? first rest cons? sqr true false)))
    (me '(require lang/posn))
    (me '(require racket/pretty))
    (me '(current-print pretty-print-handler))
    (me '(pretty-print-columns 65))
    (me 'def)
    ...
    (call-in-sandbox-context me (lambda () (error-print-source-location #f)))
    (call-in-sandbox-context me (lambda () (sandbox-output 'string)))
    (call-in-sandbox-context me (lambda () (sandbox-error-output 'string)))
    (call-in-sandbox-context me (lambda () (sandbox-propagate-exceptions #f)))
    (call-in-sandbox-context me (lambda ()
				  (current-print-convert-hook
				    (let ([prev (current-print-convert-hook)])
				      ;; tell `print-convert' to leave images as themselves:
				      (lambda (v basic sub)
					(if (convertible? v)
					    v
					    (prev v basic sub)))))

				  (pretty-print-size-hook
				    (let ([prev (pretty-print-size-hook)])
				      ;; tell `pretty-print' that we'll handle images specially:
				      (lambda (v w? op)
					(if (convertible? v) 1 (prev v w? op)))))
				  
				  (pretty-print-print-hook
				    (let ([prev (pretty-print-print-hook)])
				      ;; tell `pretty-print' how to handle images, which is
				      ;; by using `write-special':
				      (lambda (v w? op)
					(if (convertible? v) (write-special v op) (prev v w? op)))))

				  ((dynamic-require 'htdp/bsl/runtime 'configure)
				   (dynamic-require reader 'options))))
    (call-in-sandbox-context me (lambda () (namespace-require module-lang)))
    (interaction-eval #:eval me (require 2htdp/image))
    (interaction-eval #:eval me (require 2htdp/batch-io))
    (error-display-handler
     (lambda (msg exn)
       (if (exn? exn)
           (display (get-rewriten-error-message exn) (current-error-port))
           (eprintf "uncaught exception: ~e" exn))))
    me))

(require lang/private/rewrite-error-message)
	
(define-syntax-rule
  (bsl-eval def ...)
  (*sl-eval 'lang/htdp-beginner 'htdp/bsl/lang/reader def ...))

;; Here is how I use this in chapter 1 to get error messages: 

@interaction[#:eval (bsl-eval)
(string-length 42)
]


It's not perfect but it comes reasonably close in most cases. 

-- Matthias