From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Andy Wingo Newsgroups: gmane.emacs.devel Subject: match facility Date: Tue, 21 Aug 2012 23:09:10 +0200 Message-ID: <87a9xodkax.fsf@pobox.com> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: ger.gmane.org 1345583368 1705 80.91.229.3 (21 Aug 2012 21:09:28 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Tue, 21 Aug 2012 21:09:28 +0000 (UTC) To: emacs-devel Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Tue Aug 21 23:09:26 2012 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1T3vhV-0002QT-CN for ged-emacs-devel@m.gmane.org; Tue, 21 Aug 2012 23:09:25 +0200 Original-Received: from localhost ([::1]:46191 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1T3vhT-000871-Oa for ged-emacs-devel@m.gmane.org; Tue, 21 Aug 2012 17:09:23 -0400 Original-Received: from eggs.gnu.org ([208.118.235.92]:44029) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1T3vhQ-00086v-W4 for emacs-devel@gnu.org; Tue, 21 Aug 2012 17:09:22 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1T3vhL-0004vw-6X for emacs-devel@gnu.org; Tue, 21 Aug 2012 17:09:20 -0400 Original-Received: from a-pb-sasl-quonix.pobox.com ([208.72.237.25]:48023 helo=sasl.smtp.pobox.com) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1T3vhL-0004vq-1v for emacs-devel@gnu.org; Tue, 21 Aug 2012 17:09:15 -0400 Original-Received: from sasl.smtp.pobox.com (unknown [127.0.0.1]) by a-pb-sasl-quonix.pobox.com (Postfix) with ESMTP id A23D19A01 for ; Tue, 21 Aug 2012 17:09:14 -0400 (EDT) DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=pobox.com; h=from:to :subject:date:message-id:mime-version:content-type; s=sasl; bh=b hhbGd5RNROX1ATKpA8R6tWQ9rI=; b=We6S2NHa7SMOcVK7JOTGvmhcgBbArUKG4 zlxnGej69An0SJUr/Z58UYv2kVWH3yGk703lKAMSPNmZPXfjmpNyN1ukjiTqPMEg EeMonBArmfIsn6fw5ZKQ447ScmdQd+fj1CO6Pjb0zv9LaNbF42ThtkVJLy6g7Tle wbFQcWeAcE= DomainKey-Signature: a=rsa-sha1; c=nofws; d=pobox.com; h=from:to:subject :date:message-id:mime-version:content-type; q=dns; s=sasl; b=rwe 9we00r4Baxt7abjR4HSXfAQaxyxZTJGcpN7WrbrDEAs1EYptJa1Ywsv52QXAnDEi hJj6FrZ8YskwLQJ12nhzOm3M1bvsoUTck6tqMBW/IPugbihRJQkmG+pYQX5ggCSF pPe3HRHwtW8rMoghk8TodjQ0B1dnNN2Ku3a4OuTk= Original-Received: from a-pb-sasl-quonix.pobox.com (unknown [127.0.0.1]) by a-pb-sasl-quonix.pobox.com (Postfix) with ESMTP id 9628E9A00 for ; Tue, 21 Aug 2012 17:09:14 -0400 (EDT) Original-Received: from badger (unknown [89.131.176.233]) (using TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)) (No client certificate requested) by a-pb-sasl-quonix.pobox.com (Postfix) with ESMTPSA id EB70C99FE for ; Tue, 21 Aug 2012 17:09:13 -0400 (EDT) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.1 (gnu/linux) X-Pobox-Relay-ID: 75DF5B6A-EBD4-11E1-832E-11610E5B5709-02397024!a-pb-sasl-quonix.pobox.com X-detected-operating-system: by eggs.gnu.org: Solaris 10 (beta) X-Received-From: 208.72.237.25 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:152719 Archived-At: 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/