Syntax 使用Racket&x27在编译时注入语法；语法参数？

我试图使用语法参数，以便在需要注入语法的地方注入新语法。然后，此操作的结果将用于其他语法中。 然而，它并没有像我期望的那样工作。下面是一个简单的工作示例：

#lang racket

(require (for-syntax racket/contract))
(require racket/stxparam)


;; A list for holding the instructions
(define instructions-db
  '())

;===================================
; MACRO FOR DEFINING AN INSTRUCTION
;===================================

(provide define-instruction)
(define-syntax (define-instruction stx)
  (syntax-case stx ()
    [(_ id (attrs ...))
     ;; Insert instruction into database
     #'(set! instructions-db (append instructions-db '(id (attrs ...))))]))


;=============================================================
; MACRO TO MIMIC 'FOR' BUT TO BE USED WITH DEFINE-INSTRUCTION
;=============================================================

(begin-for-syntax
  ; Gets the head of each list within the given list of syntax lists. If any of
  ; the lists are empty, an empty list is returned.
  (define/contract (stx-heads ls)
    ((listof (syntax/c list?)) . -> . (listof (syntax/c any/c)))
    (let loop ([ls ls]
               [hs '()])
      (if (null? ls)
          hs
          (let ([l (syntax-e (car ls))])
            (if (null? l)
                '()
                (loop (cdr ls) (append hs (list (car l)))))))))

  ; Gets the tail of each list within the given list of syntax lists. If any of
  ; the lists are empty, an empty list is returned.
  (define/contract (stx-tails ls)
    ((listof (syntax/c list?)) . -> . (listof (syntax/c list?)))
    (let loop ([ls ls]
               [ts '()])
      (if (null? ls)
          ts
          (let* ([stx-l (car ls)]
                 [l (syntax-e stx-l)])
            (if (null? l)
                '()
                (loop (cdr ls) (append ts (list
                                           (datum->syntax stx-l
                                                          (cdr l)
                                                          stx-l
                                                          stx-l)))))))))

  (define (define-instruction-stx? stx)
    (if (syntax? stx)
        (let ([e (syntax-e stx)])
          (and (pair? e)
               (syntax? (car e))
               (equal? (syntax-e (car e)) 'define-instruction)))
        #f))

  ;; Given a syntax object, an identifier, and a replacement value, construct a
  ;; new syntax object where any occurrence of the identifier is substituted for
  ;; the value.
  (define (stx-id-substitute id replacement stx)
    (let loop ([e stx])
      (cond [(and (identifier? e)
                  (bound-identifier=? e id))
             replacement]
            [(syntax? e)
             (datum->syntax e (loop (syntax-e e)) e e)]
            [(pair? e)
             (cons (loop (car e)) (loop (cdr e)))]
            [else e])))

  ;; Given a 'define-instruction' syntax object, extends its ID with the given
  ;; string. If any other object is given, it is left intact and returned.
  (define (extend-id-of-define-instruction-stx suffix stx)
    (if (define-instruction-stx? stx)
        (let* ([e (syntax-e stx)]
               [stx-construct (car e)]
               [stx-id (cadr e)]
               [new-stx-id
                (datum->syntax stx-id
                               (string->symbol
                                (format "~a~a"
                                        (symbol->string (syntax-e stx-id))
                                        suffix))
                               stx-id
                               stx-id)]
               [stx-attrs (caddr e)])
          (datum->syntax stx
                         `(,stx-construct ,new-stx-id ,stx-attrs)
                         stx
                         stx))
        stx))

  ;; Given a list of variable-value pairs and define-instruction body, construct
  ;; a new body where all varible occurrences have been replaced with its
  ;; values.
  (define (instr-for-body-args-sub var-val-pairs stx-body)
    (let loop ([var-val-pairs var-val-pairs]
               [stx-body stx-body])
      (if (null? var-val-pairs)
          stx-body
          (let* ([var-val-p (car var-val-pairs)]
                 [var (car var-val-p)]
                 [val (cdr var-val-p)]
                 [new-stx-body (stx-id-substitute var val stx-body)]
                 [rest-var-val-pairs (cdr var-val-pairs)])
            (loop rest-var-val-pairs new-stx-body)))))

  ;; Given a list of variable-value pairs and define-instruction body, construct
  ;; a new body where all varible occurrences have been replaced with its
  ;; values. Also, an index is appended to the identifier of the new
  ;; define-instruction body.
  (define (instr-for-body-args var-val-pairs instr-index stx-body0)
    (let* ([stx-body1 (instr-for-body-args-sub var-val-pairs stx-body0)]
           [stx-body2 (let loop ([e stx-body1])
                        (cond [(define-instruction-stx? e)
                               (extend-id-of-define-instruction-stx
                                (format ":~a" instr-index)
                                e)]
                              [(syntax? e)
                               (datum->syntax e (loop (syntax-e e)) e e)]
                              [(pair? e)
                               (cons (loop (car e)) (loop (cdr e)))]
                              [else e]))])
      stx-body2))

  ;; Given a list of iteration arguments and an define-instruction body,
  ;; construct a list of define-instruction bodies.
  (define (instr-for-body stx-args stx-body)
    (let ([stx-vars (stx-heads (syntax-e stx-args))])
      (let loop ([stx-val-lists (stx-heads (stx-tails (syntax-e stx-args)))]
                 [instr-index 0])
        (if (null? stx-val-lists)
            '() ;; No more values to iterate over
            (let ([stx-vals (stx-heads stx-val-lists)])
              (if (null? stx-vals)
                  '() ;; At least one arg list has no more values
                  (let ([stx-arg-val-pairs (map cons stx-vars stx-vals)])
                    (cons (instr-for-body-args stx-arg-val-pairs
                                               instr-index
                                               stx-body)
                          (loop (stx-tails stx-val-lists)
                                (+ instr-index 1)))))))))))

(provide instr-for)
(define-syntax (instr-for stx)
  (syntax-case stx ()
    [(_ args body ...)
     (with-syntax ([(replaced-body ...)
                    (foldl
                     (lambda (stx-body replaced-stx-bodies)
                       (append (instr-for-body #'args stx-body)
                               replaced-stx-bodies))
                     '()
                     (syntax-e #'(body ...)))])
                  #'(begin replaced-body ...))]))


;===============================================
; MACROS TO SIMPLIFY DEFINITION OF INSTRUCTIONS
;===============================================

(define-syntax-parameter mem-op-addr
  (lambda (stx)
    (raise-syntax-error
     (syntax-e stx)
     "can only be used inside define-modrm-mem-op-instruction")))

(provide define-complex-addr-mode-instructions)
(define-syntax (define-complex-addr-mode-instructions stx)
  (syntax-case stx ()
    [(_ id (attrs ...))
     #'(begin
         (instr-for ([addr (#'reg1
                            #'[inttoptr 32 offset 32]
                            #'[inttoptr 32 (add 32 rbase rindex) 32]
                            #'[inttoptr 32 (add 32
                            #'                  rbase
                            #'                  (add 32 rindex offset))
                            #'          32])])
           (let ([_addr (syntax->datum addr)])
             (syntax-parameterize ([mem-op-addr
                                    (make-rename-transformer #'_addr)])
               (define-instruction id (attrs ...))))))]))

此代码用于定义指令并将其放入数据库中。该数据库指令的语义随后用于生成代码

现在我要声明一条指令。具体做法如下：

(define-instruction ADD:0
  ((semantics (add 8 reg0 reg1))))

(displayln instructions-db)

产生：

(ADD:0 ((semantics (add 8 reg0 reg1))

([ADD:0 ((semantics (add 32 reg0 (load-mem 32 mem-op-addr))))]
 [ADD:1 ((semantics (add 32 reg0 (load-mem 32 mem-op-addr))))]
 [ADD:2 ((semantics (add 32 reg0 (load-mem 32 mem-op-addr))))]
 [ADD:3 ((semantics (add 32 reg0 (load-mem 32 mem-op-addr))))]
 [SUB:0 ((semantics (add 32 reg0 (load-mem 32 mem-op-addr))))]
 [SUB:1 ((semantics (add 32 reg0 (load-mem 32 mem-op-addr))))]
 [SUB:2 ((semantics (add 32 reg0 (load-mem 32 mem-op-addr))))]
 [SUB:3 ((semantics (add 32 reg0 (load-mem 32 mem-op-addr))))])

要处理不同的位宽度，我们可以执行以下操作之一：

(define-instruction ADD:0
  ((semantics (add 8 reg0 reg1))))
(define-instruction ADD:1
  ((semantics (add 16 reg0 reg1))))
(define-instruction ADD:2
  ((semantics (add 32 reg0 reg1))))

(displayln instructions-db)

或者只需将我的

指令用于

宏：

(instr-for ([i (8 16 32)])
  (define-instruction ADD
    ((semantics (add i reg0 reg1)))))

(displayln instructions-db)

得出与上述相同的结果：

([ADD:0 ((semantics (add 8 reg0 reg1)))]
 [ADD:1 ((semantics (add 16 reg0 reg1)))]
 [ADD:2 ((semantics (add 32 reg0 reg1)))])

现在，一些指令具有复杂的寻址模式，这些模式出现在多个指令之间。例如：

; some ADD instructions
(define-instruction ADD:0
  ((semantics
    (add 32 reg0 (load-mem 32 reg1)))))
(define-instruction ADD:1
  ((semantics
    (add 32 reg0 (load-mem 32 [inttoptr 32 offset 32])))))
(define-instruction ADD:2
  ((semantics
    (add 32 reg0 (load-mem 32 [inttoptr 32 (add 32 rbase rindex) 32])))))
(define-instruction ADD:3
  ((semantics
    (add 32 reg0 (load-mem 32 [inttoptr 32 (add 32
                                                rbase
                                                (add 32 rindex offset))
                                        32])))))

; some SUB instructions, with the same addressing modes
(define-instruction SUB:0
  ((semantics
    (sub 32 reg0 (load-mem 32 reg1)))))
(define-instruction SUB:1
  ((semantics
    (sub 32 reg0 (load-mem 32 [inttoptr 32 offset 32])))))
(define-instruction SUB:2
  ((semantics
    (sub 32 reg0 (load-mem 32 [inttoptr 32 (add 32 rbase rindex) 32])))))
(define-instruction SUB:3
  ((semantics
    (sub 32 reg0 (load-mem 32 [inttoptr 32 (add 32
                                                rbase
                                                (add 32 rindex offset))
                                        32])))))

为了避免复制粘贴，我定义了一个新的宏

define complex addr mode instructions

，允许我们声明与上面相同的指令，只需使用：

(define-complex-addr-mode-instructions ADD
  ((semantics (add 32 reg0 (load-mem 32 mem-op-addr)))))
(define-complex-addr-mode-instructions SUB
  ((semantics (add 32 reg0 (load-mem 32 mem-op-addr)))))

(displayln instructions-db)

然而，这会产生：

(ADD:0 ((semantics (add 8 reg0 reg1))

([ADD:0 ((semantics (add 32 reg0 (load-mem 32 mem-op-addr))))]
 [ADD:1 ((semantics (add 32 reg0 (load-mem 32 mem-op-addr))))]
 [ADD:2 ((semantics (add 32 reg0 (load-mem 32 mem-op-addr))))]
 [ADD:3 ((semantics (add 32 reg0 (load-mem 32 mem-op-addr))))]
 [SUB:0 ((semantics (add 32 reg0 (load-mem 32 mem-op-addr))))]
 [SUB:1 ((semantics (add 32 reg0 (load-mem 32 mem-op-addr))))]
 [SUB:2 ((semantics (add 32 reg0 (load-mem 32 mem-op-addr))))]
 [SUB:3 ((semantics (add 32 reg0 (load-mem 32 mem-op-addr))))])

---

在阅读Greg Hendershott的著作时，我试图使用语法参数实现

定义复杂的addr模式指令

，因为使用

语法->数据

显然是不好的。我是否误解了语法参数的工作原理，或者在这种情况下我需要使用

datum->syntax

？我注意到，如果我将

instr for

中的

绑定标识符=？

替换为

免费标识符=？

，它会起作用，但我怀疑这不是正确的方法。

在我看来，你的问题的答案实际上与，尽管复杂性增加：

define指令

在其扩展中仍将其输入置于

quote

下，并且在

quote

下不会进行扩展。我会重新考虑在那里，

quote

是否真的是正确的选择。看起来你真的应该对这些输入进行更多的处理，并且你可以通过一种方式向宏扩展器发出信号（直接或间接）表明扩展可能会再次出现在这些点上。是的，我昨天在下班回家的路上也意识到了这一点，在发布了这个问题之后。说实话，我没有为

define指令

编写代码，所以我没有完全理解它是如何处理其参数的，但它似乎将所有内容都封装在

quote

中，然后逐个元素对其进行解析。由于参数没有被执行，因此没有被Racket解析为语法，所以现在很明显

syntax parameterize

在这种情况下不起作用。因此，对我来说，最简单的解决办法就是按照

instr for

的思路做一些事情。谢谢你的帮助@AlexisKing能否请您将您的评论转化为答案，以便我将此问题标记为已回答？我不同意您想要的解决方案是类似于

instr for

的方法，它遍历其子表单并对其进行重击。这样做几乎总是错误的。让宏扩展器为您工作，而不是与之斗争。在可能的情况下，允许展开为允许进一步展开的表达式。考虑使用代码>局部扩展< /代码>，如果你真的需要强制扩展递归的原因。屈服于宏扩展器，让它完成它的工作。这是否意味着宏扩展器可以遍历引用的语句？如果是，怎么做？显然，上述方法不是实现这一目标的方法。