Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Fetching contributors…

Cannot retrieve contributors at this time

file 31 lines (27 sloc) 0.912 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31
#lang s-exp "fallthrough-racket.rkt"
(require (for-syntax racket/base))

(register-fallthrough

 ;; Code by Chris Jester-Young.
 ;; See: http://stackoverflow.com/questions/9152279/cadr-macro-in-racket
 (lambda (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
           #'(#%plain-app a x))
          (_
           #'(#%plain-app a (d x))))))
     (else
      #f))))

(define (my-sixth x)
  (cadddddr x))
Something went wrong with that request. Please try again.