Hi Éric, This is a nice idea - I pondered the concept before, but today I got a little further. I am unsure whether the approach scales. You could look at nanopass too. Anyways, here is a little experiment.
/Jens Axel https://racket-stories.com #lang racket (require (for-syntax syntax/parse racket/syntax syntax/stx)) ;;; ;;; Expansion Example ;;; ; This example shows how to use Racket's expander for non-Racket languages. ; The expansion is done by our-expand, which expands an expression in the ; input language L1 to the output language L2. ; The forms in the input language are: ; (:let ([id expr] ...) body ...) ; let bindings ; (:set! id expr) ; assignment ; (expr ...) ; application ; The output language is: ; (let ([id expr] ...) body ...) ; let bindings ; (set! id expr) ; assignment ; (#%app expr ...) ; application ; The idea is to use `local-expand` with a list of stop-ids ; determined by our output language. (begin-for-syntax (define usual-stop-ids (syntax->list #'(begin quote set! #%plain-lambda case-lambda let-values letrec-values if begin0 with-continuation-mark letrec-syntaxes+values #%plain-app #%expression #%top #%variable-reference))) (define our-stop-ids (syntax->list #'(let set!))) (define stop-ids (append our-stop-ids usual-stop-ids))) ; We can now expand an expression using `local-expand`: ; SYNTAX (our-expand form) ; expand form into the output language (define-syntax (our-expand stx) (syntax-parse stx [(_our-expand s) (with-syntax ([expansion (local-expand #'s 'expression stop-ids)]) (syntax/loc stx 'expansion))])) ; We need to specify how the contstructs in the input language are to ; be expanded. ; In an assignment the expression needs to be expanded. (define-syntax (:set! stx) (syntax-parse stx [(_set! x e) (define (le s) (local-expand s 'expression stop-ids)) (with-syntax ([e (le #'e)]) (syntax/loc stx (set! x e)))])) ; In a let binding both the expressions and the body ; must be expanded. The body needs to be expanded in an internal definition ; context (at least if we allow internal defines in the body - otherwise ; an expression context can be used instead). (define-syntax (:let stx) (syntax-parse stx [(_let ([x e] ...) b ...) ; The expressions e ... are expanding in an expression context (define (le s) (local-expand s 'expression stop-ids)) ; The body b ... is expanded in a new internal definition context (define ctx (list (gensym))) (define ictx (syntax-local-make-definition-context)) (define (ile b) (local-expand b ctx stop-ids ictx)) ; The expressions and body are now locally expanded (with-syntax ([(e ...) (stx-map le #'(e ...))] [(b ...) (stx-map ile #'(b ...))]) ; assemble the results (syntax/loc stx (let ([x e] ...) b ...)))])) ; Let's see if we can define macros that expand ; into our input language. (define-syntax-rule (swap x y) (:let ([tmp x]) (:set! x y) (:set! y tmp))) (define a 10) (define b 20) (our-expand (swap a b)) (our-expand (:let ([x (+ 1 2)] [y 4]) (swap x y) y)) ; The output becomes: '(let ((tmp a)) (set! a b) (set! b tmp)) '(let ((x (#%app + 1 2)) (y '4)) (let ((tmp x)) (set! x y) (set! y tmp)) y) Den man. 10. aug. 2020 kl. 15.44 skrev Éric Tanter <[email protected]>: > Hi, > > I’d like to use the Racket macro expander to translate programs from a > given source language to a target language (both scheme-ish). > > However, the expansion that `raco expand` does is too violent for my > purposes---I would need a way to specify macro hiding (as in the macro > stepper), in order to control the level of abstraction of the expanded > code. Is that possible? > [see example below] > > Thanks, > > — Éric > > ; test.rkt > (define-syntax-rule (swap x y) > (let ([tmp x]) > (set! x y) > (set! y tmp))) > > (define a 10) > (define b 20) > (swap a b) > > ; I’d like to obtain: > > …prelude… > (define a 10) > (define b 20) > (let ([tmp a]) > (set! a b) > (set! b tmp))) > > ; but raco expand gives me the full story: > > (module test play > (#%module-begin > (module configure-runtime '#%kernel > (#%module-begin (#%require racket/runtime-config) (#%app configure > '#f))) > (#%provide b swap a) > (define-syntaxes > (swap) > (lambda (user-stx) > (let-values (((arg) user-stx)) > (let-values (((rslt) > (#%app > (lambda (e) > (if (#%app stx-pair? e) > (if (#%app (lambda (e) null) (#%app stx-car e)) > (#%app > (lambda (e) > (if (#%app stx-pair? e) > (#%app > cons/#f > (#%app stx-car e) > (#%app > (lambda (e) > (if (#%app stx-pair? e) > (let-values (((mh) (#%app stx-car > e))) > (if mh > (if (#%app > stx-null/#f > (#%app stx-cdr e)) > mh > '#f) > '#f)) > '#f)) > (#%app stx-cdr e))) > '#f)) > (#%app stx-cdr e)) > '#f) > '#f)) > arg))) > (if rslt > (let-values (((sc1) (#%app unsafe-car rslt)) > ((sc2) (#%app unsafe-cdr rslt))) > (let-values () > (#%app > syntax-protect > (let-values (((loc) (#%app check-loc 'syntax/loc > user-stx))) > (#%app > t-subst > loc > (quote-syntax (let _ (set! _ _) (set! _ tmp))) > '(1 recur 2 recur 3) > (#%app > t-resyntax > '#f > (quote-syntax STX) > (#%app > t-list > (#%app t-subst '#f (quote-syntax (tmp _)) '(1) sc1))) > (#%app list '(1 2) sc1 sc2) > (#%app list '(1) sc2)))))) > (let-values (((rslt) (#%app (lambda (e) null) arg))) > (if rslt > (let-values () > (let-values () (#%app pattern-failure user-stx '(x y)))) > (#%app raise-syntax-error '#f '"bad syntax" arg)))))))) > (define-values (a) '10) > (define-values (b) '20) > (#%app > call-with-values > (lambda () (let-values (((tmp) a)) (set! a b) (set! b tmp))) > print-values))) > > -- > You received this message because you are subscribed to the Google Groups > "Racket Users" group. > To unsubscribe from this group and stop receiving emails from it, send an > email to [email protected]. > To view this discussion on the web visit > https://groups.google.com/d/msgid/racket-users/94E20736-F1F7-4073-B3FA-505ADD71DB4F%40dcc.uchile.cl > <https://groups.google.com/d/msgid/racket-users/94E20736-F1F7-4073-B3FA-505ADD71DB4F%40dcc.uchile.cl?utm_medium=email&utm_source=footer> > . > -- -- Jens Axel Søgaard -- You received this message because you are subscribed to the Google Groups "Racket Users" group. To unsubscribe from this group and stop receiving emails from it, send an email to [email protected]. To view this discussion on the web visit https://groups.google.com/d/msgid/racket-users/CABefVgxMiOCUJkBwJhXOMzFu5gRaK%2BfefE-gkvSfXSkiuMT4vw%40mail.gmail.com.
