[Larceny-users] Explicit renaming library

[AndrevanTonder]

I have written a simple explicit renaming library compatible with my
r6rs macro expander and library implementation (which is based
on a fancy sort of explicit renaming behind the scenes).  I may include
this library in future versions of my expander, but first I thought
I would go to the source, as it were, and see if anyone had comments
or suggestions for improvement.

There are slight differences with traditional explicit renaming.
Mainly, raw symbols are forbidden, bound-identifier=? must be used
instead of eqv?, and hygiene-breaking is a bit more controlled and
modular.  See comments and examples below.

Andre

    ;;; Explicit renaming library:
    ;;;
    ;;; Exports:
    ;;;
    ;;;    er-transformer     (syntax)
    ;;;    bound-identifier=? (procedure)
    ;;;    datum->syntax      (procedure)
    ;;;
    ;;; Differences with traditional explicit renaming:
    ;;;
    ;;; - The renaming procedure has signature <symbol> -> <identifier>,
    ;;;   where the <identifier> type is disjoint from the <symbol> type.
    ;;;
    ;;; - The renaming procedure acts as a mathematical function in the sense that
    ;;;   the identifiers obtained from any two calls with the same argument will
    ;;;   be the same in the sense of bound-identifier=?, not eqv?
    ;;;
    ;;; - The output may not contain raw symbols, so implicit identifiers must
    ;;;   be introduced using datum->syntax.
    ;;;
    ;;; - Breaking hygiene with datum->syntax allows more modular macro
    ;;;   programming than traditional explicit renaming.
    ;;;   See in particular the example of while in terms of loop below.
    ;;;
    ;;; - The renaming procedure is aware of the transformer environment,
    ;;;   so that identifiers not bound at the usage site will resolve to
    ;;;   the r6rs library-local bindings at the transformer site.
    ;;;   More precisely, they will be resolved in the lexical environment
    ;;;   of the er-transformer keyword.
    ;;;
    ;;; - Fully compatible with my r6rs syntax-case macro system.
    ;;;
    ;;; Portability and complexity note:
    ;;;
    ;;;   This library is not r6rs-portable, since it assumes that the input
    ;;;   to a transformer is always an unwrapped syntax object, which is
    ;;;   allowed but not required by r6rs, and is currently only true for my
    ;;;   implementation.  The library could be ported to other implementations
    ;;;   by inserting a step that unwrapped the input to the transformer.
    ;;;   However, that would adversely modify the complexity class of
    ;;;   er-transformer macros in those implementations.

    (library (explicit-renaming helper)
      (export er-transformer)
      (import (rnrs))
      (define-syntax er-transformer
        (lambda (exp)
          (syntax-case exp ()
            ((k proc)
             (syntax
              (lambda (form)
                (proc form
                      (lambda (symbol) (datum->syntax (syntax k) symbol))
                      free-identifier=?))))))))

    (library (explicit-renaming)
      (export er-transformer identifier? bound-identifier=? datum->syntax)
      (import (explicit-renaming helper)
              (rnrs syntax-case)))

    ;;; Tests and examples:

    (program

     (import (for (rnrs base)         expand run)
             (for (explicit-renaming) expand)
             (rnrs io simple))

     (define-syntax swap!
       (er-transformer
        (lambda (exp rename compare)
          (let ((a (cadr exp))
                (b (caddr exp)))
            `(,(rename 'let) ((,(rename 'temp) ,a))
              (,(rename 'set!) ,a ,b)
              (,(rename 'set!) ,b ,(rename 'temp)))))))

     (let ((temp 1)
           (set! 2))
       (swap! set! temp)
       (values temp set!))   ;==> 2 1

     ;; IMPLICIT IDENTIFIERS:

     ;; Datum->syntax must be used for implicit identifiers.
     ;; The old trick of inserting a raw symbol to break hygiene
     ;; will not work since the output must be a syntax object
     ;; and may therefore not contain symbols.
     ;; The old way of using raw symbols was unmodular anyway.
     ;; To understand this, note that the syntax-rules
     ;; definition of while below, which uses loop, would
     ;; not have worked with the traditional way of using
     ;; a raw symbol for exit.  In other words, all macros
     ;; depending on loop would have had to be defined using
     ;; syntactic closures.  This is not necessary any more.
     ;; So datum->syntax gives better modularity.

     (define-syntax loop
       (er-transformer
        (lambda (x r c)
          (let ((k    (car x))
                (body (cdr x)))
            `(,(r 'call-with-current-continuation)
              (,(r 'lambda) (,(datum->syntax k 'exit))
               (,(r 'let) ,(r 'f) () , at body (,(r 'f)))))))))

     (let ((x 5))
       (loop (if (zero? x)
                 (exit #f))
             (display x)
             (set! x (- x 1))))  ;==> 54321

     (define-syntax while
       (syntax-rules ()
         ((while test body ...)
          (loop (if (not test) (exit #f))
                body ...))))

     (let ((x 5))
       (while (> x 0)
         (display x)
         (set! x (- x 1))))   ;==> 54321

     ;; TEST COMPARE PROCEDURE FOR LITERALS:

     ;; Note the last line differs from the paper, which uses
     ;; the raw symbol simple-cond instead of (rename 'simple-cond).
     ;; We may not have raw symbols in the output.

     (define-syntax simple-cond
       (er-transformer
        (lambda (exp rename compare)
          (let ((clauses (cdr exp)))
            (if (null? clauses)
                `(,(rename 'quote) unspecified)
                (let* ((first (car clauses))
                      (rest   (cdr clauses))
                      (test   (car first)))
                  (cond ((and (identifier? test)
                              (compare test (rename 'else)))
                         `(,(rename 'begin) ,@(cdr first)))
                        (else `(,(rename 'if)
                                ,test
                                (,(rename 'begin) ,@(cdr first))
                                (,(rename 'simple-cond) , at rest))))))))))

     (simple-cond (#f 1)
                  (else 2))  ;==> 2

     ) ; program