c球拍中的c（a | d）+ r宏

Question

我想知道是否有可能在Racket中编写一个可以转换各种形状（c（a | d）+ r xs）的宏，其中c（a | d ）+ r是一个匹配car，cdr，caar，cadr等等的正则表达式，其中第一个和其余部分对应的组成为 。例如，这个宏应该采用（caadr'（1 2 3 4 5））并将其转换为（first（first（first（rest'（1 2 3 4 5）））））。

像这样的东西在沉（马克·塔弗的新的编程语言）：https://groups.google.com/group/qilang/browse_thread/thread/131eda1cf60d9094?hl=en

Answer 1

在球拍中完全可以做到这一点，并且比上面所做的要简单得多。主要涉及两个（非真）窍门：

1. 使用球拍的#%top宏观能够创造这样的绑定-外的薄空中。这个宏被隐式地用于任何未绑定的变量引用（“top”，因为这些东西是对顶级变量的引用）。

2. 如果你让它们做了必要的最小值，那么宏变得更简单了，剩下的就变成函数了。

下面是带有注释和测试的完整代码（实际代码很小，约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)简单地翻译成您的第一个/ rest表达式。

立即建立与符号的溶液?,符号 - >串，正则表达式匹配#rx “^ C（A | d）+ R $”，与字符串>列表，并且映射

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

编辑：这里的一些糟糕的代码，可以转换源到源（假设目的是要读取输出）

;; 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，其中它定义了一个宏，它可以做你想做的事。