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