라켓의 c (a | d) + r 매크로

Question

모든 형태의 모양 (c (a | d) + r xs)을 변환 할 수있는 라켓에 매크로를 작성할 수 있는지 궁금합니다. 여기서 c (a | d) + r은 의 첫 번째와 나머지 부분에 해당하는 자동차, cdr, 카아, 카디 ... 등의 정규 표현식입니다.

예를 들어,이 매크로는 (caadr '(1 2 3 4 5))를 가져와 첫 번째 (첫 번째 나머지는'(1 2 3 4 5)))로 변환해야합니다. 쉔이 같은

뭔가 (막 타버의 새로운 프로그래밍 언어) : 당신은 확실히 인용의 표현에 소요 인용의 표현으로 번역을 출력 뭔가를 쓸 수 https://groups.google.com/group/qilang/browse_thread/thread/131eda1cf60d9094?hl=en

Answer 1

Racket에서 정확히 수행 할 수 있으며 위에서 수행 한 것보다 훨씬 짧은 방법입니다. 라켓의 #%top 매크로를 사용

1. 가능 등의 바인딩 - 아웃 - 오브 - 얇은 공기를 만들 수 있습니다 : 두 (안-정말) 참여 트릭이있다. 이 매크로는 바인딩되지 않은 변수 참조 ("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

.

먼저 '(#\C#\a #\d #\r)과 같은 올바른 형식의 목록을 첫 번째/나머지 s- 표현식으로 변환하는 것으로 시작하십시오.

지금 기호의 해결책? 기호 설명> 문자열, 정규 표현식 매치 #rx "^ C (A | D) + r에 $"구축, 현악기와> 목록을, 입력 트래버스

매핑합니다. 기호이면 regexp (실패한 경우 그대로 반환)을 확인하고 목록으로 변환 한 다음 시작 번역자를 사용하십시오. 중첩 된 표현식에 대한 재귀.

편집 : 여기에 소스 - 소스를 번역 할 수있는 몇 가지 잘못 작성된 코드의

코멘트에서 언급 한 바와 같이

;; 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 매크로를 정의합니다.