Name: Anonymous 2011-01-28 10:46
because HAS NO MACROS.
#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))