[racket] Metaprogramming with scheme

From: Valeriya Pudova (valery at digitalchile.net)
Date: Wed Jun 23 08:44:16 EDT 2010

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?




Posted on the users mailing list.