Commit 13b1840d authored by Stefan Monnier's avatar Stefan Monnier

Add support for `quote' and `app'.

* lisp/emacs-lisp/pcase.el (pcase--app-subst-match, pcase--app-subst-rest):
New optimization functions.
(pcase--u1): Add support for `quote' and `app'.
(pcase): Document them in the docstring.
parent 601a0cfe
......@@ -102,6 +102,9 @@ performance improvements when pasting large amounts of text.
* Changes in Specialized Modes and Packages in Emacs 24.5
** pcase
*** New UPatterns `quote' and `app'.
** Lisp mode
*** Strings after `:documentation' are highlighted as docstrings.
......
2014-09-22 Stefan Monnier <monnier@iro.umontreal.ca>
Add support for `quote' and `app'.
* emacs-lisp/pcase.el (pcase--app-subst-match, pcase--app-subst-rest):
New optimization functions.
(pcase--u1): Add support for `quote' and `app'.
(pcase): Document them in the docstring.
2014-09-22 Stefan Monnier <monnier@iro.umontreal.ca>
Use lexical-bindin in Ibuffer.
......
......@@ -102,13 +102,19 @@ UPatterns can take the following forms:
SYMBOL matches anything and binds it to SYMBOL.
(or UPAT...) matches if any of the patterns matches.
(and UPAT...) matches if all the patterns match.
'VAL matches if the object is `equal' to VAL
`QPAT matches if the QPattern QPAT matches.
(pred PRED) matches if PRED applied to the object returns non-nil.
(guard BOOLEXP) matches if BOOLEXP evaluates to non-nil.
(let UPAT EXP) matches if EXP matches UPAT.
(app FUN UPAT) matches if FUN applied to the object matches UPAT.
If a SYMBOL is used twice in the same pattern (i.e. the pattern is
\"non-linear\"), then the second occurrence is turned into an `eq'uality test.
FUN can be either of the form (lambda ARGS BODY) or a symbol.
It has to obey the rule that if (FUN X) returns V then calling it again will
return the same V again (so that multiple (FUN X) can be consolidated).
QPatterns can take the following forms:
(QPAT1 . QPAT2) matches if QPAT1 matches the car and QPAT2 the cdr.
[QPAT1 QPAT2..QPATn] matches a vector of length n and QPAT1..QPATn match
......@@ -119,7 +125,7 @@ QPatterns can take the following forms:
PRED can take the form
FUNCTION in which case it gets called with one argument.
(FUN ARG1 .. ARGN) in which case it gets called with an N+1'th argument
(F ARG1 .. ARGn) in which case F gets called with an n+1'th argument
which is the value being matched.
A PRED of the form FUNCTION is equivalent to one of the form (FUNCTION).
PRED patterns can refer to variables bound earlier in the pattern.
......@@ -157,6 +163,7 @@ like `(,a . ,(pred (< a))) or, with more checks:
(let* ((x (make-symbol "x"))
(pcase--dontwarn-upats (cons x pcase--dontwarn-upats)))
(pcase--expand
;; FIXME: Could we add the FILE:LINE data in the error message?
exp (append cases `((,x (error "No clause matching `%S'" ,x)))))))
(defun pcase--let* (bindings body)
......@@ -569,6 +576,27 @@ MATCH is the pattern that needs to be matched, of the form:
(defun pcase--self-quoting-p (upat)
(or (keywordp upat) (numberp upat) (stringp upat)))
(defun pcase--app-subst-match (match sym fun nsym)
(cond
((eq (car match) 'match)
(if (and (eq sym (cadr match))
(eq 'app (car-safe (cddr match)))
(equal fun (nth 1 (cddr match))))
`(match ,nsym ,@(nth 2 (cddr match)))
match))
((memq (car match) '(or and))
`(,(car match)
,@(mapcar (lambda (match)
(pcase--app-subst-match match sym fun nsym))
(cdr match))))
(t (error "Uknown MATCH %s" match))))
(defun pcase--app-subst-rest (rest sym fun nsym)
(mapcar (lambda (branch)
`(,(pcase--app-subst-match (car branch) sym fun nsym)
,@(cdr branch)))
rest))
(defsubst pcase--mark-used (sym)
;; Exceptionally, `sym' may be a constant expression rather than a symbol.
(if (symbolp sym) (put sym 'pcase-used t)))
......@@ -695,9 +723,40 @@ Otherwise, it defers to REST which is a list of branches of the form
(if env (macroexp-let* env exp) exp))))
(pcase--u1 (cons `(match ,sym . ,(nth 1 upat)) matches)
code vars rest)))
((eq (car-safe upat) 'app)
;; A upat of the form (app FUN UPAT)
(pcase--mark-used sym)
(let* ((fun (nth 1 upat)))
(macroexp-let2
macroexp-copyable-p nsym
(if (symbolp fun)
`(,fun ,sym)
(let* ((vs (pcase--fgrep (mapcar #'car vars) fun))
(env (mapcar (lambda (v) (list v (cdr (assq v vars))))
vs))
(call `(funcall #',fun ,sym)))
(if env (macroexp-let* env call) call)))
;; We don't change `matches' to reuse the newly computed value,
;; because we assume there shouldn't be such redundancy in there.
(pcase--u1 (cons `(match ,nsym ,@(nth 2 upat)) matches)
code vars
(pcase--app-subst-rest rest sym fun nsym)))))
((eq (car-safe upat) '\`)
(pcase--mark-used sym)
(pcase--q1 sym (cadr upat) matches code vars rest))
((eq (car-safe upat) 'quote)
(let* ((val (cadr upat))
(splitrest (pcase--split-rest
sym (lambda (pat) (pcase--split-equal val pat)) rest))
(then-rest (car splitrest))
(else-rest (cdr splitrest)))
(pcase--if (cond
((null val) `(null ,sym))
((or (integerp val) (symbolp val))
`(equal ,sym ,val))
(t `(equal ,sym ',val)))
(pcase--u1 matches code vars then-rest)
(pcase--u else-rest))))
((eq (car-safe upat) 'or)
(let ((all (> (length (cdr upat)) 1))
(memq-fine t))
......
;;; pcase-tests.el --- Test suite for pcase macro.
;; Copyright (C) 2012-2014 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(require 'ert)
(ert-deftest pcase-tests-behavior ()
"Test pcase code."
(should (equal (pcase '(1 . 2) ((app car '2) 6) ((app car '1) 5)) 5)))
;; Local Variables:
;; no-byte-compile: t
;; End:
;;; pcase-tests.el ends here.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment