-;;; pcase.el --- ML-style pattern-matching macro for Elisp -*- lexical-binding: t; coding: utf-8 -*-
+;;; pcase.el --- ML-style pattern-matching macro for Elisp -*- lexical-binding: t -*-
-;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2016 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords:
;; to be performed anyway, so better do it first so it's shared).
;; - then choose the test that discriminates more (?).
;; - provide Agda's `with' (along with its `...' companion).
-;; - implement (not UPAT). This might require a significant redesign.
+;; - implement (not PAT). This might require a significant redesign.
;; - ideally we'd want (pcase s ((re RE1) E1) ((re RE2) E2)) to be able to
;; generate a lex-style DFA to decide whether to run E1 or E2.
(defvar pcase--dontwarn-upats '(pcase--dontcare))
(def-edebug-spec
- pcase-UPAT
+ pcase-PAT
(&or symbolp
- ("or" &rest pcase-UPAT)
- ("and" &rest pcase-UPAT)
- ("`" pcase-QPAT)
+ ("or" &rest pcase-PAT)
+ ("and" &rest pcase-PAT)
("guard" form)
- ("let" pcase-UPAT form)
- ("pred"
- &or lambda-expr
- ;; Punt on macros/special forms.
- (functionp &rest form)
- sexp)
+ ("let" pcase-PAT form)
+ ("pred" pcase-FUN)
+ ("app" pcase-FUN pcase-PAT)
+ pcase-MACRO
sexp))
(def-edebug-spec
- pcase-QPAT
- (&or ("," pcase-UPAT)
- (pcase-QPAT . pcase-QPAT)
+ pcase-FUN
+ (&or lambda-expr
+ ;; Punt on macros/special forms.
+ (functionp &rest form)
sexp))
+(def-edebug-spec pcase-MACRO pcase--edebug-match-macro)
+
+;; Only called from edebug.
+(declare-function get-edebug-spec "edebug" (symbol))
+(declare-function edebug-match "edebug" (cursor specs))
+
+(defun pcase--edebug-match-macro (cursor)
+ (let (specs)
+ (mapatoms
+ (lambda (s)
+ (let ((m (get s 'pcase-macroexpander)))
+ (when (and m (get-edebug-spec m))
+ (push (cons (symbol-name s) (get-edebug-spec m))
+ specs)))))
+ (edebug-match cursor (cons '&or specs))))
+
;;;###autoload
(defmacro pcase (exp &rest cases)
- "Perform ML-style pattern matching on EXP.
-CASES is a list of elements of the form (UPATTERN CODE...).
+ "Eval EXP and perform ML-style pattern matching on that value.
+CASES is a list of elements of the form (PATTERN CODE...).
-UPatterns can take the following forms:
+Patterns can take the following forms:
_ matches anything.
- SELFQUOTING matches itself. This includes keywords, numbers, and strings.
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
+ (or PAT...) matches if any of the patterns matches.
+ (and PAT...) matches if all the patterns match.
+ \\='VAL matches if the object is `equal' to VAL.
+ ATOM is a shorthand for \\='ATOM.
+ ATOM can be a keyword, an integer, or a string.
(pred FUN) matches if FUN 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.
+ (let PAT EXP) matches if EXP matches PAT.
+ (app FUN PAT) matches if FUN applied to the object matches PAT.
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.
which is the value being matched.
So a FUN of the form SYMBOL is equivalent to one of the form (FUN).
FUN can refer to variables bound earlier in the pattern.
+E.g. you can match pairs where the cdr is larger than the car with a pattern
+like \\=`(,a . ,(pred (< a))) or, with more checks:
+\\=`(,(and a (pred numberp)) . ,(and (pred numberp) (pred (< a))))
FUN is assumed to be pure, i.e. it can be dropped if its result is not used,
and two identical calls can be merged into one.
-E.g. you can match pairs where the cdr is larger than the car with a pattern
-like `(,a . ,(pred (< a))) or, with more checks:
-`(,(and a (pred numberp)) . ,(and (pred numberp) (pred (< a))))
Additional patterns can be defined via `pcase-defmacro'.
Currently, the following patterns are provided this way:"
- (declare (indent 1) (debug (form &rest (pcase-UPAT body))))
+ (declare (indent 1) (debug (form &rest (pcase-PAT body))))
;; We want to use a weak hash table as a cache, but the key will unavoidably
;; be based on `exp' and `cases', yet `cases' is a fresh new list each time
;; we're called so it'll be immediately GC'd. So we use (car cases) as key
;; (puthash (car cases) `(,exp ,cases ,@expansion) pcase--memoize-2)
expansion))))
+(declare-function help-fns--signature "help-fns"
+ (function doc real-def real-function buffer))
+
;; FIXME: Obviously, this will collide with nadvice's use of
;; function-documentation if we happen to advise `pcase'.
(put 'pcase 'function-documentation '(pcase--make-docstring))
(defun pcase--make-docstring ()
(let* ((main (documentation (symbol-function 'pcase) 'raw))
(ud (help-split-fundoc main 'pcase)))
+ ;; So that eg emacs -Q -l cl-lib --eval "(documentation 'pcase)" works,
+ ;; where cl-lib is anything using pcase-defmacro.
+ (require 'help-fns)
(with-temp-buffer
(insert (or (cdr ud) main))
(mapatoms
(insert "\n\n-- ")
(let* ((doc (documentation me 'raw)))
(setq doc (help-fns--signature symbol doc me
- (indirect-function me)))
+ (indirect-function me) nil))
(insert "\n" (or doc "Not documented.")))))))
(let ((combined-doc (buffer-string)))
(if ud (help-add-fundoc-usage combined-doc (car ud)) combined-doc)))))
;;;###autoload
(defmacro pcase-lambda (lambda-list &rest body)
- "Like `lambda' but allow each argument to be a UPattern.
+ "Like `lambda' but allow each argument to be a pattern.
I.e. accepts the usual &optional and &rest keywords, but every
formal argument can be any pattern accepted by `pcase' (a mere
variable name being but a special case of it)."
(declare (doc-string 2) (indent defun)
- (debug ((&rest pcase-UPAT) body)))
+ (debug ((&rest pcase-PAT) body)))
(let* ((bindings ())
(parsed-body (macroexp-parse-body body))
(args (mapcar (lambda (pat)
(defmacro pcase-let* (bindings &rest body)
"Like `let*' but where you can use `pcase' patterns for bindings.
BODY should be an expression, and BINDINGS should be a list of bindings
-of the form (UPAT EXP)."
+of the form (PAT EXP)."
(declare (indent 1)
- (debug ((&rest (pcase-UPAT &optional form)) body)))
+ (debug ((&rest (pcase-PAT &optional form)) body)))
(let ((cached (gethash bindings pcase--memoize)))
;; cached = (BODY . EXPANSION)
(if (equal (car cached) body)
(defmacro pcase-let (bindings &rest body)
"Like `let' but where you can use `pcase' patterns for bindings.
BODY should be a list of expressions, and BINDINGS should be a list of bindings
-of the form (UPAT EXP)."
+of the form (PAT EXP).
+The macro is expanded and optimized under the assumption that those
+patterns *will* match, so a mismatch may go undetected or may cause
+any kind of error."
(declare (indent 1) (debug pcase-let*))
(if (null (cdr bindings))
`(pcase-let* ,bindings ,@body)
(push (list (car binding) tmpvar) matches)))))
`(let ,(nreverse bindings) (pcase-let* ,matches ,@body)))))
+;;;###autoload
(defmacro pcase-dolist (spec &rest body)
- (declare (indent 1) (debug ((pcase-UPAT form) body)))
+ (declare (indent 1) (debug ((pcase-PAT form) body)))
(if (pcase--trivial-upat-p (car spec))
`(dolist ,spec ,@body)
(let ((tmpvar (make-symbol "x")))
;;;###autoload
(defmacro pcase-defmacro (name args &rest body)
- "Define a pcase UPattern macro."
+ "Define a new kind of pcase PATTERN, by macro expansion.
+Patterns of the form (NAME ...) will be expanded according
+to this macro."
(declare (indent 2) (debug defun) (doc-string 3))
- (let ((fsym (intern (format "%s--pcase-macroexpander" name))))
- ;; Add the function via `fsym', so that an autoload cookie placed
- ;; on a pcase-defmacro will cause the macro to be loaded on demand.
+ ;; Add the function via `fsym', so that an autoload cookie placed
+ ;; on a pcase-defmacro will cause the macro to be loaded on demand.
+ (let ((fsym (intern (format "%s--pcase-macroexpander" name)))
+ (decl (assq 'declare body)))
+ (when decl (setq body (remove decl body)))
`(progn
(defun ,fsym ,args ,@body)
+ (put ',fsym 'edebug-form-spec ',(cadr (assq 'debug decl)))
(put ',name 'pcase-macroexpander #',fsym))))
(defun pcase--match (val upat)
CODE is the code generator for that branch.
VARS is the set of vars already bound by earlier matches.
MATCH is the pattern that needs to be matched, of the form:
- (match VAR . UPAT)
+ (match VAR . PAT)
(and MATCH ...)
(or MATCH ...)"
(when (setq branches (delq nil branches))
res))
(defun pcase--self-quoting-p (upat)
- (or (keywordp upat) (numberp upat) (stringp upat)))
+ (or (keywordp upat) (integerp upat) (stringp upat)))
(defun pcase--app-subst-match (match sym fun nsym)
(cond
(sym (car cdrpopmatches))
(upat (cdr cdrpopmatches)))
(cond
- ((memq upat '(t _)) (pcase--u1 matches code vars rest))
+ ((memq upat '(t _))
+ (let ((code (pcase--u1 matches code vars rest)))
+ (if (eq upat '_) code
+ (macroexp--warn-and-return
+ "Pattern t is deprecated. Use `_' instead"
+ code))))
((eq upat 'pcase--dontcare) :pcase--dontcare)
((memq (car-safe upat) '(guard pred))
(if (eq (car upat) 'pred) (pcase--mark-used sym))
(pcase--eval (cadr upat) vars))
(pcase--u1 matches code vars then-rest)
(pcase--u else-rest))))
- ((symbolp upat)
+ ((and (symbolp upat) upat)
(pcase--mark-used sym)
(if (not (assq upat vars))
(pcase--u1 matches code (cons (cons upat sym) vars) rest)
(pcase--u1 (cons (pcase--match sym (nth 1 upat)) matches)
code vars rest)))
((eq (car-safe upat) 'app)
- ;; A upat of the form (app FUN UPAT)
+ ;; A upat of the form (app FUN PAT)
(pcase--mark-used sym)
(let* ((fun (nth 1 upat))
(nsym (make-symbol "x"))
(pcase--u rest))
vars
(list `((and . ,matches) ,code . ,vars))))
- (t (error "Unknown internal pattern `%S'" upat)))))
+ (t (error "Unknown pattern `%S'" upat)))))
(t (error "Incorrect MATCH %S" (car matches)))))
+(def-edebug-spec
+ pcase-QPAT
+ ;; Cf. edebug spec for `backquote-form' in edebug.el.
+ (&or ("," pcase-PAT)
+ (pcase-QPAT [&rest [¬ ","] pcase-QPAT]
+ . [&or nil pcase-QPAT])
+ (vector &rest pcase-QPAT)
+ sexp))
+
(pcase-defmacro \` (qpat)
"Backquote-style pcase patterns.
QPAT 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
its 0..(n-1)th elements, respectively.
- ,UPAT matches if the UPattern UPAT matches.
- STRING matches if the object is `equal' to STRING.
- ATOM matches if the object is `eq' to ATOM."
+ ,PAT matches if the pcase pattern PAT matches.
+ ATOM matches if the object is `equal' to ATOM.
+ ATOM can be a symbol, an integer, or a string."
+ (declare (debug (pcase-QPAT)))
(cond
((eq (car-safe qpat) '\,) (cadr qpat))
((vectorp qpat)
`(and (pred consp)
(app car ,(list '\` (car qpat)))
(app cdr ,(list '\` (cdr qpat)))))
- ((or (stringp qpat) (integerp qpat) (symbolp qpat)) `',qpat)))
+ ((or (stringp qpat) (integerp qpat) (symbolp qpat)) `',qpat)
+ (t (error "Unknown QPAT: %S" qpat))))
(provide 'pcase)