[racket] Metaprogramming with scheme
I want share the my current test code. But this code have one issue.
<file foo.ss>
(define-syntax (baz stx)
(syntax-case stx ()
((_ a b) #'(* a b))))
(define (bar a b)
(list (+ a b)))
(define (foo a b)
(car (bar a b)))
(display (foo 1 2)) ;; can be (foo 1 "2") to produce exception
(display (baz 12 22))
<eof>
<file test.ss>
#lang scheme
(define-namespace-anchor a)
(define ns (namespace-anchor->namespace a))
(define (file->syntax file-name)
;; read the file and convert it to the syntax object
(let* ([in (open-input-file file-name)])
(port-count-lines! in)
(begin0
(let loop ([rs '()]
[r (read-syntax file-name in)])
(if (eof-object? r)
(reverse rs)
(loop (cons r rs) (read-syntax file-name in))))
(close-input-port in)
)))
(with-input-from-file "foo.ss"
(lambda ()
(parameterize ([error-display-handler (lambda (name . stuff)
(begin
(printf "~a\n" name)
(for-each (lambda (e)
(printf
"~a:~a:~a: ~a\n"
(srcloc-source (cdr e))
(srcloc-line (cdr e))
(srcloc-column (cdr e))
(car e))
)
(continuation-mark-set->context (exn-continuation-marks (car stuff))))
))])
(for-each (lambda (e) (eval e ns)) (file->syntax "foo.ss")))))
<eof>
In case if foo.ss will have (display (foo 1 2)) the error message will be
+: expects type <number> as 2nd argument, given: "2"; other arguments
were: 1
foo.ss:6:0: bar
foo.ss:9:0: foo
C:\Racket\collects\racket\private\map.rkt:45:11: for-each
C:\Racket\test.ss:#f:#f: [running body]
C:\Racket\collects\racket\private\more-scheme.rkt:274:2:
call-with-exception-handler
.... etc
Looks not bad. But if error will be at the top level
;(display (foo 1 2))
;(display (baz 12 22))
(+ 1 "2")
Then error message is not informative
+: expects type <number> as 2nd argument, given: "2"; other arguments
were: 1
C:\Racket\collects\racket\private\map.rkt:45:11: for-each
C:\Racket\test.ss:#f:#f: [running body]
.... etc
It does not reffer to the error location. Can it be solved?