[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
simple pattern matcher
From: |
Keisuke Nishida |
Subject: |
simple pattern matcher |
Date: |
Sat, 24 Feb 2001 09:17:09 -0500 |
User-agent: |
Wanderlust/2.4.0 (Rio) SEMI/1.13.7 (Awazu) FLIM/1.13.2 (Kasanui) Emacs/21.0.96 (i686-pc-linux-gnu) MULE/5.0 (SAKAKI) |
I've written a simple pattern matcher for Guile.
May I add this to ice-9 after some more improvement?
(define (trans x)
(match x
(('+) 0)
(('+ e1) e1)
(('+ e1 e2) `(add ,e1 ,e2))
(else `oops)))
(trans '(+)) => 0
(trans '(+ 1)) => 1
(trans '(+ 1 2)) => (add 1 2)
(trans '(+ 1 2 3)) => oops
Kei
------------------------------------------------------------------------
(define-module (ice-9 match)
:export (match))
(define (make-ref n)
(case n
((0) `(car obj))
((1) `(cadr obj))
((2) `(caddr obj))
((3) `(cadddr obj))
(else `(list-ref obj n))))
(define (build-clause clause)
(let ((pattern (car clause)) (body (cdr clause)))
(if (eq? pattern 'else) `(else ,@body)
(let loop ((list pattern)
(n 0)
(formals '())
(consts '())
(args '()))
(cond ((null? list)
`((and (eq? len ,(length pattern))
,@(map (lambda (n)
`(eq? ,(make-ref n) ,(list-ref pattern n)))
(reverse! consts)))
((lambda ,(reverse! formals) ,@body)
,@(map make-ref (reverse! args)))))
((symbol? (car list))
(loop (cdr list) (1+ n) (cons (car list) formals)
consts (cons n args)))
(else
(loop (cdr list) (1+ n) formals (cons n consts) args)))))))
(define (build-match data . clauses)
`(let* ((obj ,data) (len (length obj)))
(cond ,@(map build-clause clauses))))
(define match
(procedure->memoizing-macro
(lambda (x e) (apply build-match (cdr x)))))
- simple pattern matcher,
Keisuke Nishida <=