2

あらゆる形の形状（c（a | d）+ r xs）を変換するマクロをRacketで記述できるかどうか疑問に思います。ここで、c（a | d）+ rは、car、cdr、caar、 cadr、...など、最初と残りの対応する構成に。

たとえば、このマクロは（caadr'（1 2 3 4 5））を取り、それを（first（first（rest'（1 2 3 4 5））））に変換する必要があります。

Shen（Mark Tarverの新しいプログラミング言語）でのこのようなもの：https ：//groups.google.com/group/qilang/browse_thread/thread/131eda1cf60d9094？hl = en

4

4 に答える 4

14

ラケットでは、上記よりもはるかに短い方法で、正確にそれを行うことが非常に可能です。関係する 2 つの (実際ではない) トリックがあります。

  1. Racket の#%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
于 2012-02-06T06:42:03.647 に答える
2

引用符で囲まれたs-expressionを取り込んで、引用符で囲まれたs-expressionとして翻訳を出力するものを確実に書くことができます。

のような整形式のリスト'(#\c #\a #\d #\r)を最初の/残りのS式に単純に変換することから始めます。

次に、symbol？、symbol-> string、regexp-match #rx "^ c（a | d）+ r $"、string-> 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)))

コメントで述べたように、なぜマクロが必要なのか興味があります。ソースを読みやすいものに変換することが目的の場合、出力をキャプチャして元の出力を置き換えたくないですか？

于 2012-02-05T20:01:07.300 に答える
1

Let Over Lambda is a book which uses Common Lisp but it has a chapter in which it defines a macro with-all-cxrs that does what you want.

于 2012-02-05T21:01:59.540 に答える
1

これが私の実装です（呼び出しサイトのcarandを使用するように修正された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
于 2012-02-05T20:16:00.293 に答える