testfile.scm 6.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215
  1. (define-syntax replace-result-placeholder
  2. (syntax-rules (<?> replace-result-placeholder)
  3. "Iterate through the parts of an expression, search for the
  4. placeholder and replace the placeholder with the
  5. result-identifier."
  6. ;; Transform trivial cases, base cases.
  7. [(_ result-identifier <?>)
  8. result-identifier]
  9. [(_ result-identifier (<?>))
  10. (result-identifier)]
  11. [(_ result-identifier (op))
  12. (op)]
  13. ;; If there already is such a list of transformed args
  14. ;; and there are still arguments not transformed.
  15. [(_ res-id-outer
  16. (op arg
  17. args* ...
  18. (list
  19. ;; Must match a compound expression here, to
  20. ;; avoid matching of other lists, like lists of
  21. ;; arguments in a lambda expression or
  22. ;; similar. Here we must only match a list of
  23. ;; arguments, which are yet to be transformed.
  24. (replace-result-placeholder res-id-inner arg-to-transform)
  25. other-args* ...)))
  26. (replace-result-placeholder
  27. res-id-outer
  28. (op args* ...
  29. (list (replace-result-placeholder res-id-outer arg-to-transform)
  30. other-args* ...
  31. (replace-result-placeholder res-id-inner arg))))]
  32. ;; If there already is such a list of transformed args
  33. ;; and there are no arguments not yet transformed.
  34. [(_ res-id-outer
  35. (op (list
  36. (replace-result-placeholder res-id-inner arg-to-transform)
  37. other-args* ...)))
  38. ((replace-result-placeholder res-id-outer op)
  39. (replace-result-placeholder res-id-inner arg-to-transform)
  40. other-args* ...)]
  41. ;; Create list of transformed args, if it does not yet
  42. ;; exist.
  43. [(_ result-identifier (op arg args* ...))
  44. (replace-result-placeholder
  45. result-identifier
  46. (op args* ...
  47. (list
  48. (replace-result-placeholder result-identifier arg))))]
  49. ;; Must place this trivial case last, to avoid
  50. ;; accidental matching of compound expressions.
  51. [(_ result-identifier op)
  52. op]
  53. ;; Catch all.
  54. [(_ other* ...)
  55. (syntax-error "unrecognized form in macro call:"
  56. (quote
  57. (replace-result-placeholder other* ...)))]
  58. ))
  59. (define-syntax test1
  60. (syntax-rules (lambda)
  61. [(_ (lambda (args1* ...) (op args2* ...)))
  62. (let ([d 4])
  63. (lambda (args1* ...) (op args2* ... d)))]))
  64. (define-syntax test2
  65. (syntax-rules ()
  66. [(_ (blub (args1* ...) (op args2* ...)))
  67. (let ([d 4])
  68. (lambda (args1* ...) (op args2* ... d)))]))
  69. (define-syntax test3
  70. (syntax-rules ()
  71. [(_ (blub args1 (op args2* ...)))
  72. (let ([d 4])
  73. (lambda args1 (op args2* ... d)))]))
  74. (define-syntax test3
  75. (syntax-rules ()
  76. [(_ (blub args1 (op args2* ...)))
  77. (let ([d 4])
  78. (blub args1 (op args2* ... d)))]))
  79. (define-syntax test4
  80. (syntax-rules ()
  81. [(_ (blub args1 (op args2* ...)))
  82. (let ([d 4])
  83. (blub args1 (op args2* ... d)))]))
  84. ;; Why does the following produce ((a)), instead of (a) as argument
  85. ;; list?
  86. (define-syntax test
  87. (syntax-rules (lambda)
  88. ;; s-expression
  89. [(_ (op args body* ...))
  90. ((test op) (test args) (test body* ...))]
  91. ;; multiple things
  92. [(_ thing1 thing2 things* ...)
  93. ((test thing1) (test thing2 things* ...))]
  94. ;; list of one thing (?)
  95. [(_ (thing))
  96. (thing)]
  97. ;; thing without anything else
  98. [(_ thing)
  99. thing]))
  100. (test (lambda (a) (+ a 1)))
  101. ;; -->
  102. ;; While compiling expression:
  103. ;; Syntax error:
  104. ;; unknown file:798:0: lambda: invalid argument list in subform ((a)) of (test (a))
  105. ;; By: Maxime Devos
  106. ;; This does not recurse into #(...).
  107. ;; Also, such a construct does not nest well, you can't put a replace-result-placeholder inside a replace-result-placeholder meaningfully,
  108. ;; so I'm wondering why you're doing this, maybe your goal can be accomplished more robustly with a different method.
  109. (eval-when (expand load eval)
  110. (define (replace-placeholder new code)
  111. (syntax-case code (<?>)
  112. [<?> new]
  113. [(x . y)
  114. #`(#,(replace-placeholder new #'x) . #,(replace-placeholder new #'y))]
  115. [rest #'rest])))
  116. ;; Reminder:
  117. ;; #' = syntax -- what you write is just syntax -- pattern variables still inserted
  118. ;; #` = quasisyntax -- for when you need Scheme to calculate parts of the template
  119. ;; #, = unsyntax -- counterpart to quasisyntax -- evaluate expr inside an #` expr
  120. ;; #,@ = unsyntax-splicing -- evaluate and splice
  121. ;; "[...] syntax-case does not define a syntax transformer itself –
  122. ;; instead, syntax-case expressions provide a way to destructure a
  123. ;; syntax object, and to rebuild syntax objects as output." --
  124. ;; https://www.gnu.org/software/guile/manual/html_node/Syntax-Case.html
  125. ;; "[...] the lambda wrapper is simply a leaky implementation detail,
  126. ;; that syntax transformers are just functions that transform syntax
  127. ;; to syntax." --
  128. ;; https://www.gnu.org/software/guile/manual/html_node/Syntax-Case.html
  129. (eval-when (expand load eval)
  130. (define-syntax replace-placeholder
  131. (λ (new code)
  132. (syntax-case code (<?>)
  133. [(_ replacement <?>)
  134. (syntax replacement)]
  135. [(x . y)
  136. ;; Create an expression, which is only syntax, no
  137. ;; calculations in Scheme yet. It serves for creating the
  138. ;; structure of the expression. Also pattern variables can be
  139. ;; expanded in a syntax expression.
  140. (quasisyntax
  141. ;; The structure is a pair, just like what was matched.
  142. (
  143. ;; Within the expression, create a subexpression, which is
  144. ;; calculated using Scheme. -- Q: Why is this needed?
  145. (unsyntax
  146. (replace-placeholder
  147. new
  148. ;; To insert the pattern variable, put it inside a syntax
  149. ;; expression. This will attach information to the x,
  150. ;; which comes from the current context. The current
  151. ;; context is the scope in which (x . y) was matched, so
  152. ;; x will carry all information resulting from that
  153. ;; matching. This will result in x referring to the same
  154. ;; thing, which it referred to in the matched expression.
  155. (syntax x)))
  156. .
  157. (unsyntax
  158. (replace-placeholder new (syntax y)))))]))))
  159. (define-syntax replace-placeholder
  160. (λ (stx)
  161. (syntax-case stx (<?>)
  162. [(_ replacement <?>)
  163. (syntax replacement)]
  164. [(_ replacement (car-elem . cdr-elem))
  165. (quasisyntax
  166. ((unsyntax (replace-placeholder #'replacement #'car-elem)) .
  167. (unsyntax (replace-placeholder #'replacement #'cdr-elem))))]
  168. [(_ replacement other)
  169. (syntax other)])))
  170. (define-syntax add1
  171. (lambda (x)
  172. (syntax-case x ()
  173. ((_ exp)
  174. (syntax (+ exp 1))))))
  175. (display (replace-placeholder
  176. list
  177. (<?> bar)))