[plt-scheme] macro question

At Wed, 25 Feb 2004 21:38:41 -0500, "Felix Klock's PLT scheme proxy" wrote:
> The question is, can I write a macro that will create a LET-SYNTAX-like 
> form that also acts like BEGIN, in that it will export any defines at 
> the top-level of the body of the LET-SYNTAX to the context that the 
> LET-SYNTAX appears in (at least, it will do so if the LET-SYNTAX appear 
> at the top level).

See the implementation below.

I had hoped that this macro could be implemented in terms of `package',
but it didn't work out. Still, the macro below is implemented in the
same way as `package' (only much simpler).

Both `package' and the macro below have a limitation. Each macro
binding captures only identifiers that appear literally in the original
`begin-letrec-syntax' body. If the body contains a macro call that
synthesizes an identifier and gives it the source context (via
`datum->syntax-object'), the new identifier will not see any of the
bindings introduced by `begin-letrec-syntax'. I don't yet know how to
fix this problem, but I think it's unlikely to show up in practice.

Matthew

----------------------------------------

(define-syntaxes (begin-letrec-syntax
		  begin-let-syntax)
  (letrec ([mk-introduce 
	    ;;  (list-of (cons id (stx -> stx))) -> (stx -> stx)
	    ;; For every instance in stx of an identifier in
	    ;; introduce-alist, apply the corresponding "introducer"
	    ;; function, so that the identifier acts as if it was
	    ;; introduced by an expansion.
	    (lambda (introduce-alist)
	      (lambda (stx)
		(let loop ([stx stx])
		  (cond
		   [(identifier? stx)
		    (or (ormap (lambda (idi)
				 (and (bound-identifier=? (car idi) stx)
				      ((cdr idi) stx)))
			       introduce-alist)
			stx)]
		   [(pair? stx)
		    (cons (loop (car stx))
			  (loop (cdr stx)))]
		   [(syntax? stx)
		    (datum->syntax-object
		     stx
		     (loop (syntax-e stx))
		     stx
		     stx)]
		   [else stx]))))])
    
    (let ([mk-trans
	   ;; letrec or let macro:
	   (lambda (rec?)
	     (lambda (stx)
	       (syntax-case stx ()
		 [(_ ([id rhs] ...) body ...)
		  (let* ([ids (syntax->list #'(id ...))]
			 ;; Generate an "introducer" for every
			 ;;  macro definition:
			 [introduce (mk-introduce
				     (map
				      (lambda (id)
					(cons id
					      (make-syntax-introducer)))
				      ids))])
		    (with-syntax ([(id ...)
				   (map introduce ids)]
				  [(rhs ...)
				   (if rec?
				       (map introduce
					    (syntax->list #'(rhs ...)))
				       #'(rhs ...))]
				  [(body ...)
				   (map introduce
					(syntax->list #'(body ...)))])
		      ;; The resulting definitions of id ...
		      ;;  will be invisible, since each id has been
		      ;;  "introduced" as if it originated from this
		      ;;  expansion.
		      #'(begin
			  (define-syntax id rhs) ...
			  body ...)))])))])
      (values (mk-trans #t)
	      (mk-trans #f)))))