Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
emacs
emacs
Commits
536cda1f
Commit
536cda1f
authored
Sep 22, 2014
by
Stefan Monnier
Browse files
* lisp/emacs-lisp/pcase.el (pcase-defmacro): New macro.
(pcase--macroexpand): New function. (pcase--expand): Use it.
parent
13b1840d
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
31 additions
and
1 deletion
+31
-1
etc/NEWS
etc/NEWS
+1
-0
lisp/ChangeLog
lisp/ChangeLog
+4
-0
lisp/emacs-lisp/pcase.el
lisp/emacs-lisp/pcase.el
+26
-1
No files found.
etc/NEWS
View file @
536cda1f
...
...
@@ -104,6 +104,7 @@ performance improvements when pasting large amounts of text.
**
pcase
***
New
UPatterns
`
quote
' and `app'
.
***
New
UPatterns
can
be
defined
with
`
pcase
-
defmacro
'.
** Lisp mode
*** Strings after `:documentation'
are
highlighted
as
docstrings
.
...
...
lisp/ChangeLog
View file @
536cda1f
2014-09-22 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/pcase.el (pcase-defmacro): New macro.
(pcase--macroexpand): New function.
(pcase--expand): Use it.
Add support for `quote' and `app'.
* emacs-lisp/pcase.el (pcase--app-subst-match, pcase--app-subst-rest):
New optimization functions.
...
...
lisp/emacs-lisp/pcase.el
View file @
536cda1f
...
...
@@ -284,7 +284,7 @@ of the form (UPAT EXP)."
(
main
(
pcase--u
(
mapcar
(
lambda
(
case
)
`
((
match
,
val
.
,
(
car
case
))
`
((
match
,
val
.
,
(
pcase--macroexpand
(
car
case
))
)
,
(
lambda
(
vars
)
(
unless
(
memq
case
used-cases
)
;; Keep track of the cases that are used.
...
...
@@ -303,6 +303,31 @@ of the form (UPAT EXP)."
(
message
"Redundant pcase pattern: %S"
(
car
case
))))
(
macroexp-let*
defs
main
))))
(
defun
pcase--macroexpand
(
pat
)
"Expands all macro-patterns in PAT."
(
let
((
head
(
car-safe
pat
)))
(
cond
((
memq
head
'
(
nil
pred
guard
quote
))
pat
)
((
memq
head
'
(
or
and
))
`
(
,
head
,@
(
mapcar
#'
pcase--macroexpand
(
cdr
pat
))))
((
eq
head
'let
)
`
(
let
,
(
pcase--macroexpand
(
cadr
pat
))
,@
(
cddr
pat
)))
((
eq
head
'app
)
`
(
app
,
(
nth
1
pat
)
,
(
pcase--macroexpand
(
nth
2
pat
))))
(
t
(
let*
((
expander
(
get
head
'pcase-macroexpander
))
(
npat
(
if
expander
(
apply
expander
(
cdr
pat
)))))
(
if
(
null
npat
)
(
error
(
if
expander
"Unexpandable %s pattern: %S"
"Unknown %s pattern: %S"
)
head
pat
)
(
pcase--macroexpand
npat
)))))))
;;;###autoload
(
defmacro
pcase-defmacro
(
name
args
&rest
body
)
"Define a pcase UPattern macro."
(
declare
(
indent
2
)
(
debug
(
def-name
sexp
def-body
))
(
doc-string
3
))
`
(
put
',name
'pcase-macroexpander
(
lambda
,
args
,@
body
)))
(
defun
pcase-codegen
(
code
vars
)
;; Don't use let*, otherwise macroexp-let* may merge it with some surrounding
;; let* which might prevent the setcar/setcdr in pcase--expand's fancy
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment