Question

我想知道是否可以在Racket中编写一个可以转换每种形状的宏（c（a | d）+ r xs），其中c（a | d）+ r是匹配car的正则表达式，cdr ，caar，cadr，...等相应的第一和休息的组成。

例如，这个宏应该采用（caadr'（1 2 3 4 5））并将其转换为（first（first（rest 2（1 2 3 4 5）））。

沉（Mark Tarver的新编程语言）中有类似的东西：https://groups.google.com/group/qilang/browse_thread/thread/131eda1cf60d9094?hl=en

Answer 1

很有可能在Racket中做到这一点，并且以比上面更短的方式完成。有两个（不是真的）技巧：

使用Racket的#%top宏可以创建无限制的绑定。这个宏被隐式地用于任何未绑定的变量引用（“top”，因为这些东西是对顶层变量的引用）。
如果你让它们做到必要的最小值，那么宏就会变得简单得多，而将其余部分留给一个函数。

这是包含注释和测试的完整代码（实际代码很小，约10行）。

#lang racket

;; we're going to define our own #%top, so make the real one available
(require (only-in racket [#%top real-top]))
;; in case you want to use this thing as a library for other code
(provide #%top)

;; non-trick#1: doing the real work in a function is almost trivial
(define (c...r path)
  (apply compose (map (λ(x) (case x [(#\a) car] [(#\d) cdr])) path)))

;; non-trick#2: define our own #%top, which expands to the above in
;; case of a `c[ad]*r', or to the real `#%top' otherwise.
(define-syntax (#%top stx)
  (syntax-case stx ()
    [(_ . id)
     (let ([m (regexp-match #rx"^c([ad]*)r$"
                            (symbol->string (syntax-e #'id)))])
       (if m
         #`(c...r '#,(string->list (cadr m)))
         #'(real-top . id)))]))

;; Tests, to see that it works:
(caadadr '(1 (2 (3 4)) 5 6))
(let ([f caadadr]) (f '(1 (2 (3 4)) 5 6))) ; works even as a value
(cr 'bleh)
(cadr '(1 2 3))    ; uses the actual `cadr' since it's bound,
;; (cadr '(1))     ; to see this, note this error message
;; (caddddr '(1))  ; versus the error in this case
(let ([cr list]) (cr 'bleh)) ; lexical scope is still respected

Answer 2

你当然可以写一些带引号的s表达式并将翻译作为带引号的s表达式输出。

首先简单地将格式良好的列表（如'(#\c #\a #\d #\r)）翻译成您的第一个/其他s表达式。

现在使用符号构建解决方案？，symbol-＆gt; string，regexp-match #rx“^ c（a | d）+ r $”，string-＆gt; list和map

遍历输入。如果是符号，请检查正则表达式（如果失败则按原样返回），转换为列表，并使用您的起始翻译器。递归嵌套表达式。

编辑：这里有一些编写得很糟糕的代码，可以翻译源到源（假设目的是读取输出）

;; translates a list of characters '(#\c #\a #\d #\r)
;; into first and rest equivalents
;; throw first of rst into call
(define (translate-list lst rst)
  (cond [(null? lst) (raise #f)]
        [(eq? #\c (first lst)) (translate-list (rest lst) rst)]
        [(eq? #\r (first lst)) (first rst)]
        [(eq? #\a (first lst)) (cons 'first (cons (translate-list (rest lst) rst) '()))]
        [(eq? #\d (first lst)) (cons 'rest (cons (translate-list (rest lst) rst) '()))]
        [else (raise #f)]))

;; translate the symbol to first/rest if it matches c(a|d)+r
;; pass through otherwise
(define (maybe-translate sym rst)
  (if (regexp-match #rx"^c(a|d)+r$" (symbol->string sym))
      (translate-list (string->list (symbol->string sym)) rst)
      (cons sym rst)))

;; recursively first-restify a quoted s-expression
(define (translate-expression exp)
  (cond [(null? exp) null]
        [(symbol? (first exp)) (maybe-translate (first exp) (translate-expression (rest exp)))]
        [(pair? (first exp)) (cons (translate-expression (first exp)) (translate-expression (rest exp)))]
        [else exp]))

'test-2
(define test-2 '(cadr (1 2 3)))
(maybe-translate (first test-2) (rest test-2))
(translate-expression test-2)
(translate-expression '(car (cdar (list (list 1 2) 3))))
(translate-expression '(translate-list '() '(a b c)))
(translate-expression '(() (1 2)))

正如评论中所提到的，我很好奇为什么你想要一个宏。如果目的是将源转换为可读的内容，那么您不想捕获输出以替换原始的吗？

Answer 3

以下是我的实现（现已修复为使用调用网站的car和cdr，因此您可以重新定义它们并且它们将正常工作）：

(define-syntax (biteme stx)
  (define (id->string id)
    (symbol->string (syntax->datum id)))
  (define (decomp id)
    (define match (regexp-match #rx"^c([ad])(.*)r$" (id->string id)))
    (define func (case (string-ref (cadr match) 0)
                  ((#\a) 'car)
                  ((#\d) 'cdr)))
    (datum->syntax id (list func (string->symbol (format "c~ar" (caddr match))))))
  (syntax-case stx ()
    ((_ (c*r x)) (regexp-match #rx"^c[ad]+r$" (id->string #'c*r))
     (with-syntax (((a d) (decomp #'c*r)))
       (syntax-case #'d (cr)
         (cr #'(a x))
         (_ #'(a (biteme (d x)))))))))

示例：

(biteme (car '(1 2 3 4 5 6 7)))        ; => 1
(biteme (cadr '(1 2 3 4 5 6 7)))       ; => 2
(biteme (cddddr '(1 2 3 4 5 6 7)))     ; => (5 6 7)
(biteme (caddddddr '(1 2 3 4 5 6 7)))  ; => 7
(let ((car cdr)
      (cdr car))
  (biteme (cdaaaaar '(1 2 3 4 5 6 7)))) ; => 6

Answer 4

Let Over Lambda是一本使用Common Lisp的书，但它有一个chapter，其中定义了一个宏with-all-cxrs，可以满足您的需求。

在Racket中c（a | d）+ r宏

4 个答案: