123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215 |
- (define-syntax replace-result-placeholder
- (syntax-rules (<?> replace-result-placeholder)
- "Iterate through the parts of an expression, search for the
- placeholder and replace the placeholder with the
- result-identifier."
- ;; Transform trivial cases, base cases.
- [(_ result-identifier <?>)
- result-identifier]
- [(_ result-identifier (<?>))
- (result-identifier)]
- [(_ result-identifier (op))
- (op)]
- ;; If there already is such a list of transformed args
- ;; and there are still arguments not transformed.
- [(_ res-id-outer
- (op arg
- args* ...
- (list
- ;; Must match a compound expression here, to
- ;; avoid matching of other lists, like lists of
- ;; arguments in a lambda expression or
- ;; similar. Here we must only match a list of
- ;; arguments, which are yet to be transformed.
- (replace-result-placeholder res-id-inner arg-to-transform)
- other-args* ...)))
- (replace-result-placeholder
- res-id-outer
- (op args* ...
- (list (replace-result-placeholder res-id-outer arg-to-transform)
- other-args* ...
- (replace-result-placeholder res-id-inner arg))))]
- ;; If there already is such a list of transformed args
- ;; and there are no arguments not yet transformed.
- [(_ res-id-outer
- (op (list
- (replace-result-placeholder res-id-inner arg-to-transform)
- other-args* ...)))
- ((replace-result-placeholder res-id-outer op)
- (replace-result-placeholder res-id-inner arg-to-transform)
- other-args* ...)]
- ;; Create list of transformed args, if it does not yet
- ;; exist.
- [(_ result-identifier (op arg args* ...))
- (replace-result-placeholder
- result-identifier
- (op args* ...
- (list
- (replace-result-placeholder result-identifier arg))))]
- ;; Must place this trivial case last, to avoid
- ;; accidental matching of compound expressions.
- [(_ result-identifier op)
- op]
- ;; Catch all.
- [(_ other* ...)
- (syntax-error "unrecognized form in macro call:"
- (quote
- (replace-result-placeholder other* ...)))]
- ))
- (define-syntax test1
- (syntax-rules (lambda)
- [(_ (lambda (args1* ...) (op args2* ...)))
- (let ([d 4])
- (lambda (args1* ...) (op args2* ... d)))]))
- (define-syntax test2
- (syntax-rules ()
- [(_ (blub (args1* ...) (op args2* ...)))
- (let ([d 4])
- (lambda (args1* ...) (op args2* ... d)))]))
- (define-syntax test3
- (syntax-rules ()
- [(_ (blub args1 (op args2* ...)))
- (let ([d 4])
- (lambda args1 (op args2* ... d)))]))
- (define-syntax test3
- (syntax-rules ()
- [(_ (blub args1 (op args2* ...)))
- (let ([d 4])
- (blub args1 (op args2* ... d)))]))
- (define-syntax test4
- (syntax-rules ()
- [(_ (blub args1 (op args2* ...)))
- (let ([d 4])
- (blub args1 (op args2* ... d)))]))
- ;; Why does the following produce ((a)), instead of (a) as argument
- ;; list?
- (define-syntax test
- (syntax-rules (lambda)
- ;; s-expression
- [(_ (op args body* ...))
- ((test op) (test args) (test body* ...))]
- ;; multiple things
- [(_ thing1 thing2 things* ...)
- ((test thing1) (test thing2 things* ...))]
- ;; list of one thing (?)
- [(_ (thing))
- (thing)]
- ;; thing without anything else
- [(_ thing)
- thing]))
- (test (lambda (a) (+ a 1)))
- ;; -->
- ;; While compiling expression:
- ;; Syntax error:
- ;; unknown file:798:0: lambda: invalid argument list in subform ((a)) of (test (a))
- ;; By: Maxime Devos
- ;; This does not recurse into #(...).
- ;; Also, such a construct does not nest well, you can't put a replace-result-placeholder inside a replace-result-placeholder meaningfully,
- ;; so I'm wondering why you're doing this, maybe your goal can be accomplished more robustly with a different method.
- (eval-when (expand load eval)
- (define (replace-placeholder new code)
- (syntax-case code (<?>)
- [<?> new]
- [(x . y)
- #`(#,(replace-placeholder new #'x) . #,(replace-placeholder new #'y))]
- [rest #'rest])))
- ;; Reminder:
- ;; #' = syntax -- what you write is just syntax -- pattern variables still inserted
- ;; #` = quasisyntax -- for when you need Scheme to calculate parts of the template
- ;; #, = unsyntax -- counterpart to quasisyntax -- evaluate expr inside an #` expr
- ;; #,@ = unsyntax-splicing -- evaluate and splice
- ;; "[...] syntax-case does not define a syntax transformer itself –
- ;; instead, syntax-case expressions provide a way to destructure a
- ;; syntax object, and to rebuild syntax objects as output." --
- ;; https://www.gnu.org/software/guile/manual/html_node/Syntax-Case.html
- ;; "[...] the lambda wrapper is simply a leaky implementation detail,
- ;; that syntax transformers are just functions that transform syntax
- ;; to syntax." --
- ;; https://www.gnu.org/software/guile/manual/html_node/Syntax-Case.html
- (eval-when (expand load eval)
- (define-syntax replace-placeholder
- (λ (new code)
- (syntax-case code (<?>)
- [(_ replacement <?>)
- (syntax replacement)]
- [(x . y)
- ;; Create an expression, which is only syntax, no
- ;; calculations in Scheme yet. It serves for creating the
- ;; structure of the expression. Also pattern variables can be
- ;; expanded in a syntax expression.
- (quasisyntax
- ;; The structure is a pair, just like what was matched.
- (
- ;; Within the expression, create a subexpression, which is
- ;; calculated using Scheme. -- Q: Why is this needed?
- (unsyntax
- (replace-placeholder
- new
- ;; To insert the pattern variable, put it inside a syntax
- ;; expression. This will attach information to the x,
- ;; which comes from the current context. The current
- ;; context is the scope in which (x . y) was matched, so
- ;; x will carry all information resulting from that
- ;; matching. This will result in x referring to the same
- ;; thing, which it referred to in the matched expression.
- (syntax x)))
- .
- (unsyntax
- (replace-placeholder new (syntax y)))))]))))
- (define-syntax replace-placeholder
- (λ (stx)
- (syntax-case stx (<?>)
- [(_ replacement <?>)
- (syntax replacement)]
- [(_ replacement (car-elem . cdr-elem))
- (quasisyntax
- ((unsyntax (replace-placeholder #'replacement #'car-elem)) .
- (unsyntax (replace-placeholder #'replacement #'cdr-elem))))]
- [(_ replacement other)
- (syntax other)])))
- (define-syntax add1
- (lambda (x)
- (syntax-case x ()
- ((_ exp)
- (syntax (+ exp 1))))))
- (display (replace-placeholder
- list
- (<?> bar)))
|