Thanks Jens and Ryan for your answers! I’ll experiment.

— Éric




> On Aug 10, 2020, at 11:13 AM, Ryan Culpepper <rmculpepp...@gmail.com> wrote:
> 
> You can use the functions from macro-debugger/expand to do this (within 
> limits). Here's a very rough example program that reads one term from stdin 
> and shows its expansion with the given hiding policy (discarding hygiene 
> information---beware).
> 
> usage: racket expand.rkt < your-example-file.rkt
> 
> Ryan
> 
> 
> On 8/10/20 3:44 PM, Éric Tanter wrote:
>> 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 racket-users+unsubscr...@googlegroups.com 
>> <mailto:racket-users+unsubscr...@googlegroups.com> 
>> <mailto:racket-users+unsubscr...@googlegroups.com 
>> <mailto:racket-users+unsubscr...@googlegroups.com>>.
>> 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>
>>  
>> <https://groups.google.com/d/msgid/racket-users/94E20736-F1F7-4073-B3FA-505ADD71DB4F%40dcc.uchile.cl?utm_medium=email&utm_source=footer
>>  
>> <https://groups.google.com/d/msgid/racket-users/94E20736-F1F7-4073-B3FA-505ADD71DB4F%40dcc.uchile.cl?utm_medium=email&utm_source=footer>>.
> 
> -- 
> 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 racket-users+unsubscr...@googlegroups.com 
> <mailto:racket-users+unsubscr...@googlegroups.com>.
> To view this discussion on the web visit 
> https://groups.google.com/d/msgid/racket-users/767ebe77-95ed-d9f7-4d00-6391482d15a9%40gmail.com
>  
> <https://groups.google.com/d/msgid/racket-users/767ebe77-95ed-d9f7-4d00-6391482d15a9%40gmail.com>.
> <expand.rkt>

-- 
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 racket-users+unsubscr...@googlegroups.com.
To view this discussion on the web visit 
https://groups.google.com/d/msgid/racket-users/847A9DD6-A5BE-42EA-BE0F-290792023E49%40dcc.uchile.cl.

Reply via email to