Name: Anonymous 2011-01-28 10:46
because HAS NO MACROS.
(defmacro aif (cond then else)
`(let ((it ,cond))
(if it ,then ,else)))
#lang racket
(require racket/stxparam)
(define-syntax-parameter it (λ (stx) (raise-syntax-error 'anaphora "missed context" stx)))
(define-syntax-rule (aif cond then else)
(let ([temp cond])
(syntax-parameterize ([it (make-rename-transformer #`temp)])
(if temp then else))))
len [x@xs] -> 1+xs.len
(define len
(@
`(,x . ,(app (@ (? (@ `() -> #t
x -> #f)
x) -> 1
(? (@ (app len x) -> (> x 0)) x) -> (add1 (len x)))
l)) -> l))
#lang racket
(require syntax/parse)
(define-syntax (@ stx)
(define equations `())
(define eqs `())
(define (process expr)
(syntax-parse expr
[(name1:id (~datum :) name2:id)
(begin
(set! eqs (cons (list #`name1 #`name2) eqs))
#`name1)]
[((~datum :) name:id)
(with-syntax ([sym (gensym)])
(set! eqs (cons (list #`sym #`name) eqs))
#`(unquote sym))]
[(a ...) (map process (syntax->list #`(a ...)))]
[a #`a]))
(define-syntax-class no->
(pattern (~not (~datum ->))))
(define-splicing-syntax-class patt->expr
(pattern (~seq p:no-> ... (~datum ->) e:expr)
#:attr cut-:
(begin0
(map process (syntax->list #`(p ...)))
(set! equations (cons eqs equations))
(set! eqs `()))))
(syntax-parse stx
[(@ pe:patt->expr ...)
(with-syntax ([((new-patt ...) ...) (attribute pe.cut-:)]
[eqs (reverse equations)])
#`(lambda arg (match-all-form eqs arg ((pe.e new-patt ...) ...))))]))
(define len
(@
`(,x . ,(app (@ (? (@ `() -> #t
x -> #f)
x) -> 1
(? (@ (app len x) -> (> x 0)) x) -> (add1 (len x)))
l)) -> l))
find x [@xs m:@x @ys] -> m
#lang racket
(require syntax/parse)
(define-syntax (find stx)
(syntax-case stx ()
[(_ (patt ...) expr) #`(begin (define-splicing-syntax-class my-class
(pattern (~seq patt ...)))
(syntax-parse expr
[(a (... ...) q:my-class b (... ...)) #`q]
[_ #f]))]))
(find (W o r l d) #`(H e l l o W o r l d))