[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
match facility
From: |
Andy Wingo |
Subject: |
match facility |
Date: |
Tue, 21 Aug 2012 23:09:10 +0200 |
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/24.1 (gnu/linux) |
Hello,
One of the things I have most enjoyed about the Guile 2.0 series is that
it bundles a pattern matcher. I love using pattern matchers to
destructure data -- it feels really nice.
I needed to match some Elisp data recently, so I wrote the following
matcher. What do you think about it? If you like it, I can do the
paperwork.
(setq lexical-binding t)
(eval-when-compile (require 'cl))
(defun compile-or-match (id pats kt kf)
(if (null pats)
kf
(compile-match id (car pats) kt
(compile-or-match id (cdr pats) kt kf))))
(defun compile-and-match (id pats kt kf)
(if (null pats)
kt
(compile-match id (car pats)
(compile-and-match id (cdr pats) kt kf)
kf)))
(defun compile-match (id pat kt kf)
(cond ((consp pat)
(cond
((eq (car pat) 'quote)
`(if (equal ,id ',(cadr pat)) ,kt ,kf))
((eq (car pat) 'funcall)
`(if (funcall ,@(cdr pat) ,id) ,kt ,kf))
((eq (car pat) 'or)
(compile-or-match id (cdr pat) kt kf))
((eq (car pat) 'and)
(compile-and-match id (cdr pat) kt kf))
(t
`(if (consp ,id)
,(let ((head (gensym))
(tail (gensym)))
`(let ((,head (car ,id))
(,tail (cdr ,id)))
,(compile-match head (car pat)
(compile-match tail (cdr pat) kt kf)
kf)))
,kf))))
((eq pat '_) kt)
((null pat) `(if (null ,id) ,kt ,kf))
((eq pat t) `(if (eq ,id t) ,kt ,kf))
((symbolp pat) `(let ((,pat ,id)) ,kt))
(t `(if (equal ,id ',pat) ,kt ,kf))))
(defun compile-match-clauses (id clauses)
(let ((exp '(error "Match failed"))
(fns nil)
(next (gensym))
(kf (gensym))
(return (gensym)))
(setq clauses (reverse clauses))
(while clauses
(let ((kf (gensym)))
(let ((clause (pop clauses)))
(push `(,kf #'(lambda () ,exp)) fns)
(setq exp
(compile-match id (car clause)
`(throw ',return (progn ,@(cdr clause)))
`(throw ',next ,kf))))))
`(let* ,(reverse fns)
(catch ',return
(let ((,kf (catch ',next ,exp)))
(while t
(setq next (catch ',next (funcall ,kf)))))))))
(defmacro match (form &rest clauses)
(let ((id (gensym)))
`(let ((,id ,form))
,(compile-match-clauses id clauses))))
(put 'match 'lisp-indent-function 1)
The syntax is:
(match expr (pat body ...) ...)
where
pat := _ ; matches anything
| (and pat ...) ; matches values that match all sub-patterns
| (or pat ...) ; matches pairs whose parts match any sub-pattern
| (funcall f arg ...) ; matches if (funcall F ARG ... VAL)
| 'literal ; matches a literal, using EQUAL
| (pat . pat) ; matches pairs whose parts match
| id ; binds ID to VALUE, in the context of BODY ...
| val ; like 'literal, the last case
An example use:
(defun compile-sxml-match-attrs (id pat kt kf)
(match pat
(() kt)
(((attr-name attr-val-pat) . attrs)
(let ((val (gensym)))
`(match (assq ',attr-name ,id)
((_ ,val)
,(compile-sxml-match val attr-val-pat
(compile-sxml-match-attrs id attrs kt kf)
kf))
(() ,kf)
(_ (error "Bad XML: expected attrs list after tag")))))))
Both in the function and its output: pretty fun.
Perhaps the elispy thing to do would be to have t be the match-anything
case. Dunno.
Thoughts welcome.
Andy
--
http://wingolog.org/
- match facility,
Andy Wingo <=