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 <etan...@dcc.uchile.cl>:

> 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.
> 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 racket-users+unsubscr...@googlegroups.com.
To view this discussion on the web visit 
https://groups.google.com/d/msgid/racket-users/CABefVgxMiOCUJkBwJhXOMzFu5gRaK%2BfefE-gkvSfXSkiuMT4vw%40mail.gmail.com.

Reply via email to