c(a|d)+r macro in Racket

Question

I wonder if it's possible to write a macro in Racket that would translate every form of shape (c(a|d)+r xs), where c(a|d)+r is a regular expression matching car, cdr, caar, cadr, ... etc, into the corresponding composition of first and rest.

For example, this macro should take (caadr '(1 2 3 4 5)) and transform that to (first (first (rest '(1 2 3 4 5)))).

Something like this in Shen (Mark Tarver's new programming language): https://groups.google.com/group/qilang/browse_thread/thread/131eda1cf60d9094?hl=en

Answer 1

It is very possible to do exactly that in Racket, and in a much shorter way than done above. There are two (not-really) tricks involved:

1. Using Racket's #%top macro makes it possible to create such bindings-out-of-thin-air. This macro is getting used implicitly around any variable reference that is unbound ("top" because these things are references to toplevel variables).

2. Macros become much simpler if you make them do the necessary minimum, and leave the rest to a function.

Here's the complete code with comments and tests (the actual code is tiny, ~10 lines).

#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

You can certainly write something that takes in a quoted s-expression and outputs the translation as a quoted s-expression.

Start with simply translating well-formed lists like '(#\c #\a #\d #\r) into your first/rest s-expressions.

Now build the solution with symbol?, symbol->string, regexp-match #rx"^c(a|d)+r$", string->list, and map

Traverse the input. If it is a symbol, check the regexp (return as-is if it fails), convert to list, and use your starting translator. Recurse on the nested expressions.

EDIT: here's some badly written code that can translate source-to-source (assuming the purpose is to read the output)

;; 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)))

As mentioned in the comments, I am curious why you'd want a macro. If the purpose is to translate source into something readable, don't you want to capture the output to replace the original?

Answer 3

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.

Answer 4

Here's my implementation (now fixed to use call-site's car and cdr, so you can redefine them and they will work correctly):

(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)))))))))

Examples:

(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