Portable(?) R6RS er-macro-transformer

ChangeLog

2015-10-24
- Changed comment 
- Walk though returning form to wrap. Racket still doesn't work.
- Fixed incorrect example on definition of macro and usage environment.
  Comment of: https://twitter.com/anohana/status/657865512370634753

er-macro-transformer.sls

(library (er-macro-transformer)
    (export er-macro-transformer)
    (import (for (rnrs) run expand))

#|
  Definition of usage or macro env
  These are the envrionments which refer when a macro is being expanded
  or a macro is bound. For example, if the rename uses usage environment
  then the following refers local binding (#t)

  (define foo 'foo)

  (define-syntax bar
    (er-macro-transformer
      (lambda (f r c) (r 'foo))))

  (let ((foo #t))
    (bar))

  If the rename uses macro environment then the above returns 'foo.
  I'm not sure which is *proper*.
|#

#|
  Accoding to the rumour, syntax-case, er macro and syntactic closure have
  the same power and if implementations support one of them then the rest
  can be implemented on top of it. I'm starting wondering is it really
  true? Espesially er or syntactic closure atop syntax-case.
  
  The following is *NOT* R6RS portable implementation. More precisely,
  this doesn't work on Racket (plt-r6rs).

  Let's seem how this works. `er-macro-transformer` takes a procedure
  which takes 3 arguments, form, rename and compare. The procedure
  returns a form which may or may not contain syntax object renamed
  by given rename procedure. The following is an example:
  
    (define-syntax foo
      (er-macro-transformer
        (lambda (f r c)
         `(,(r 'begin)
           (,(r 'display) ',f)
           (,(r 'newline))))))
    (foo)
    ;; (foo) will be
    ;;   (#<syntax begin> (#<syntax display> '(foo)) (#<syntax newline>))

  Then walk through the returning form and wrap with datum->syntax* if
  there's symbol(s). datum->syntax* does the wrapping trick. Which is
  very similar with datum->syntax but it can accept a datum which contains
  syntax object. 
|#

  (define (datum->syntax* k form)
    (define (vector-copy vec len)
      (let ((v (make-vector len)))
        (do ((i 0 (+ i 1)))
            ((= i len) v)
          (vector-set! v i (vector-ref vec i)))))
    (syntax-case form ()
      ((a . d)
       #`(#,(datum->syntax* k #'a) . #,(datum->syntax* k #'d)))
      (v
       (vector? #'v)
       (let ((len (vector-length form)))
         (let loop ((i 0) (vec #f))
           (if (= i len)
               (or vec form)
               (let ((e (datum->syntax* k (vector-ref form i))))
                 (if (eq? e (vector-ref form i))
                     (loop (+ i 1) vec)
                     (let ((v (or vec (vector-copy form len))))
                       (vector-set! v i e)
                       (loop (+ i 1) v))))))))
      (s (symbol? #'s) (datum->syntax k #'s))
      (_ form)))
#|
  ;; this uses macro env for rename
  (define-syntax er-macro-transformer
    (lambda (x)
      (syntax-case x ()
        ((k proc)
         #'(let ((rename (lambda (form) (datum->syntax #'k form)))
                 (compare (lambda (a b) (free-identifier=? a b)))
                 (transformer proc))
             (lambda (stx)
               (syntax-case stx ()
                 ((kk args (... ...))
                  (datum->syntax* #'kk 
                    (transformer (syntax->datum #'(kk args (... ...)))
                                 rename compare))))))))))
|#
  ;; This uses usage env for rename
  (define (er-macro-transformer transformer)
    (lambda (x)
      (syntax-case x ()
        ((k args ...)
         (let ((rename (lambda (form) (datum->syntax #'k form)))
               (compare (lambda (a b) (free-identifier=? a b))))
           (datum->syntax* #'k
             (transformer #'(k args ...) rename compare)))))))
  )

test.scm

(import (rnrs) (for (er-macro-transformer) expand))

(define-syntax foo
  (er-macro-transformer
   (lambda (f r c)
     `(,(r 'begin)
       (,(r 'display) ',f)
       (,(r 'newline))))))

(foo)

#|
OK: Sagittarius, NMosh, Ypsilon, Mosh, Chez, IronScheme (I believe Guile, Larceny, Vicare as well)
NG: Racket

Is 9 out of 10 portable?
|#