[<<][staapl][>>][..]
Tue Apr 21 15:14:40 CEST 2009

expand-to-top-form

(define-syntax (ns stx)
  (syntax-case stx ()
    ((_ (ns ...) expr)
     (let ((prefixed (lambda (n) (ns-prefixed #'(ns ...) n))))

       (if (identifier? #'expr)
           (prefixed #'expr)
           (let ((id=?
                  (lambda (stx symb)
                    (eq? (syntax->datum stx) symb)))
                 (prefixed-list
                  (lambda (stx)
                    (map prefixed (syntax->list stx))))
                 (exp (expand-syntax-to-top-form #'expr)))

             ;; (printf "top: ~a\n" (syntax->datum exp))
             (syntax-case exp ()

               (((form (((n1) (form1 names e ...))) n2) i ...)
                (id=? #'form 'letrec-values)
                #`((form (((n1) (form1 #,(prefixed-list #'names) e ...))) n2) i ...))

               ((form b . e)
                (id=? #'form 'let-values)
                #`(form
                   #,(for/list ((n (syntax->list #'b)))
                       (syntax-case n ()
                         ((names e) #`(#,(prefixed-list #'names) e))))
                   . e))

               ((form names e)
                (or (id=? #'form 'define-values)
                    (id=? #'form 'define-syntaxes))
                #`(form #,(prefixed-list #'names) e))

               )))))))

This doesn't work.. I get undefined references to let-values /
define-values ...

Maybe it's best to not invoke the transformer?

OK.. got it working with an explicit preprocessing macro:

(define-syntax (ns stx)
  (syntax-case stx ()
    ((_ (ns ...) expr)
     (let* ((prefixed
             (lambda (n) (ns-prefixed #'(ns ...) n)))
            (prefixed-list
             (lambda (stx)
               (map prefixed (syntax->list stx))))
            (prefixed-binders
             (lambda (p)
               (lambda (binders)
                 (for/list ((b (syntax->list binders)))
                   (syntax-case b ()
                     ((n e) #`(#,(p #'n) e))))))))

       (if (identifier? #'expr)
           (prefixed #'expr)
           (let ((form?
                  (let ((form (car (syntax->datum #'expr))))
                    ;; (printf "form = ~a\n" form)
                    (lambda (symb) (eq? form symb)))))

             (syntax-case #'expr ()

               ((form (name . a) e)
                (or (form? 'define)
                    (form? 'define-syntax))
                #`(form (#,(prefixed #'name) . a) e))

               ((form name e)
                (or (form? 'define)
                    (form? 'define-syntax))
                #`(form #,(prefixed #'name) e))

               ((form names e)
                (or (form? 'define-values)
                    (form? 'define-syntaxes))
                #`(form #,(prefixed-list #'names) e))

               ((form binders e)
                (or (form? 'let)
                    (form? 'letrec)
                    (form? 'shared))
                #`(form #,((prefixed-binders prefixed) #'binders) e))

               ((form binders e)
                (or (form? 'let-values)
                    (form? 'letrec-values))
                #`(form #,((prefixed-binders prefixed-list) #'binders) e))

               )))))))


Managed to delete a whole lot of code that's no longer used with this
simpler approach.



[Reply][About]
[<<][staapl][>>][..]