[ create a new paste ] login | about

Link: http://codepad.org/nRrFfv7w    [ raw code | output | fork ]

Scheme, pasted on May 18:
(define-syntax ppat
  (syntax-rules (_ quote unquote)
    ((_ v _ kt kf ) kt)
    ((_ v () kt kf ) (if (null? v) kt kf ))
    ((_ v (quote lit) kt kf ) (if (equal? v (quote lit)) kt kf ))
    ((_ v (unquote var) kt kf ) (let ((var v)) kt))
    ((_ v (x . y) kt kf )
     (if (pair? v)
        (let ((vx (car v)) (vy (cdr v)))
          (ppat vx x (ppat vy y kt kf ) kf ))
        kf ))
    ((_ v lit kt kf ) (if (equal? v (quote lit)) kt kf ))))

(define-syntax pmatch
  (syntax-rules (else guard)
    ((_ (rator rand ... ) cs ... )
     (let ((v (rator rand ... )))
       (pmatch v cs ... )))
    ((_ v) (error 'pmatch "failed: ˜s" v))
    ((_ v (else e0 e ... )) (begin e0 e ... ))
    ((_ v (pat (guard g ... ) e0 e ... ) cs ... )
     (let ((fk (lambda () (pmatch v cs ... ))))
       (ppat v pat
            (if (and g ... ) (begin e0 e ... ) (fk ))
            (fk ))))
    ((_ v (pat e0 e ... ) cs ... )
     (let ((fk (lambda () (pmatch v cs ... ))))
       (ppat v pat (begin e0 e ... ) (fk ))))))

(define h
  (lambda (x y z)
    (pmatch `(,x . ,y . ,z)
           (,c (guard (and (not (number? (car c))) (number? (cadr c)) (number? (caddr c)))) (eval c))
           (else (list x y z)))))

(display (list (h 2 'expt 24) (h 'expt 2 24)))


Output:
1
(16777216 (expt 2 24))


Create a new paste based on this one


Comments: