bug#43100: 28.0.50; pcase not binding variables conditionally

[Pip Cet <pipcet@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 9920 bytes --]

Hello Stefan,

On Sun, Aug 30, 2020 at 6:07 PM Stefan Monnier <monnier@iro.umontreal.ca> wrote:
>
> >> IIUC you want
> >>
> >>     (pcase V
> >>       ((or (pred symbolp) name)
> >>        (let ((foo 'bar)) name)))
> >>
> >> to behave like
> >>
> >>     (cond
> >>      ((symbolp V) (let ((foo 'bar)) name))
> >>      (t (let ((name V)) (let ((foo 'bar)) name))))
> >>
> >> ?
> >
> > Yes, that's correct. It's also how (pcase V ((or (pred symbolp) name)
> > name) behaves...
>
> Indeed, but that's an accident.  Ideally it should either signal an
> error at macro-expansion time, or return nil when V is a symbol.

So, as I half-expected, the reaction to "pcase isn't powerful enough"
is "let's make it less powerful" :-)

Seriously, I get the impression you strongly feel pcase shouldn't be
(more) powerful, it should instead make non-explicit but fairly strong
complexity promises.

I disagree: in practice, complexity promises and optimization based on
them are often unnecessary. In fact, there's a Lisp tradition of using
assq and memq rather than building ad-hoc hash tables, even though
that often means run time is theoretically O(n^2) rather than O(n
log(n)).

> Since the current implementation doesn't go to the effort of doing
> either of those, we instead limit ourselves to recommend against using
> such patterns (IOW, "use at your own risks").

> >> I'd rather not go there
> > You'd rather have the behavior of (pcase V ((or pred symbolp) name)
> > EXPR) depend on the complexity of EXPR?
>
> More specifically, I'd rather not choose a semantics that imposes
> duplicating the branch body, since we have no control over its size and
> that can hence lead to potential code size explosion.

You're right, and it's a good thing that the duplication of the branch
body is a fixable implementation detail rather than something imposed
by the semantics.

> A code size explosion due to a particular implementation choice is
> undesirable, but a code size explosion imposed by the semantics is much
> more problematic.

Again, I don't think that's the case here.

> > I think it would be nice to have a lexical three-argument version of
> > pcase which specifies which variables are output values, treating the
> > remaining ones as input values, to make it easier to build
> > non-constant patterns.
>
> The design of `pcase` assumes you want to optimize away the tests that
> are common to the various patterns.  That can't be done with dynamic
> patterns.

Or it's a bit more difficult, at least...

> > IOW, if you want to call a function with arguments determined by
> > pcase-like patterns, why not introduce pcase-call so something like
> > the following would work:
> >
> > (defun f (hello world) (cons hello world))
> >
> > (let ((space " ") (hw "hello world"))
> >   (pcase-call 'f ((concat hello space world) hw)))
>
> How do you intend to implement this?

Proof-of-concept attached; I'm no longer sure I want to be able to say
(concat hello space world) rather than (concat hello (pred (equal
space)) world); it's inconsistent to use `equal' here rather than `eq'
for ordinary symbols (can't we at least use `eql'?), and I'm too
worried about adding an optional argument called `space' and changing
the interpretation of pcase-calls far away.

The difficult part, in fact, is deciding that we want the arglist to
be part of the exposed function API: given an "arglist" function, the
rest of the implementation seems unproblematic, though some
workarounds for lexical binding are required (if nothing else, this is
an interesting exercise in how painful lexical binding can be to work
with).

> > As for duplicating the body, that is an implementation detail. You can
> > easily avoid it by producing
> >
> > (let ((name name))
> >   (cond ((symbolp V) X)
> >     (progn (setq name V) X)))
>
> So it's more like my option of returning nil, except it would return
> the value of a surrounding `name` variable?  That could be done, but I'm
> not convinced it'd be more often useful.

I started out with a fairly explicit practical problem: parsing GCC
machine descriptions, which are (essentially) sexps but have made the
mistake of having "optional" non-final parts, and I think it would be
great to express that in a pcase pattern, both for the obvious reasons
of legibility and for some non-obvious reasons of my own.

> > disallowing the modification of name in X.
>
> That's rather hard to do (and I don't see what would be the benefit here).

I meant adding a cautionary note about it in the documentation, not
actively preventing it. If we had read-only bindings, pcase would
probably use them, but we don't.

> >> The "intended" behavior instead would be to behave like
> >>
> >>     (cond
> >>      ((symbolp V) (let ((name nil)) (let ((foo 'bar)) name)))
> >>      (t (let ((name V)) (let ((foo 'bar)) name))))
> >>
> >> That's already the behavior you get if you switch the two:
> >>
> >>     (macroexpand '(pcase V
> >>                     ((or (and (pred foo) name) (pred symbolp))
> >>                      (let ((foo 'bar)) name))))
> >>     =>
> >>     (let* ((pcase-0 (lambda (name) (let ((foo 'bar)) name))))
> >>       (cond ((foo V) (funcall pcase-0 V))
> >>             ((symbolp V) (funcall pcase-0 nil))
> >>             (t nil)))
> >
> > I don't see where the nil comes from, or why it's a useful choice for
> > a default value.
>
> It comes from the absence of a binding for `name` and was chosen because
> nil is the standard default value in Elisp.

Sorry, I meant I don't see anything in the pcase input that justifies
our using a nil value.

> It comes from this code in pcase.el:
>
>                     (let ((args (mapcar (lambda (pa)
>                                           (let ((v (assq (car pa) vars)))
>                                             (setq vars (delq v vars))
>                                             (cdr v)))
>                                         prevvars)))
>                       ;; If some of `vars' were not found in `prevvars', that's
>                       ;; OK it just means those vars aren't present in all
>                       ;; branches, so they can be used within the pattern
>                       ;; (e.g. by a `guard/let/pred') but not in the branch.
>                       ;; FIXME: But if some of `prevvars' are not in `vars' we
>                       ;; should remove them from `prevvars'!
>                       `(funcall ,res ,@args)))))))
>
> The computation of `args` searches in `vars` for the bindings expected
> by the branch (stored in `prevvars` the first time we encountered that
> branch).  The assq+cdr will return nil if a var from `prevvars` isn't
> found in `vars`.

Yes, it's the precise code I want to change.

> >> the fact that the behavior depends on the order of elements in `or` is
> >> an undesirable side effect of the implementation technique.
> > It also depends on the complexity of the branch.
> > It seems to me there are at least three consistent ways of behaving
> > (throw an error, bind name to nil, bind name to name), with an
> > inconsistent fourth way being what's currently implemented.
>
> The current implementation amounts to "we should signal an error but we
> don't bother doing so and just warn against it in the manual".
> Patch welcome ;-)

You mean a patch that would make pcase less powerful by making what I
want to do impossible rather than merely difficult?

> >> I don't know of a simple implementation.
> > Here's my better-than-nothing attempt.  I don't think that's complex;
> > if anything, it's too trivial.
>
> So you give it a search-based semantics.

I don't think the semantics are at all unclear, except for the greedy
vs shy question. The implementation could be very different, reasoning
about the length of sequences matched by pcase subpatterns, of course.

> The problem with it for me is that if we turn
>
>     `(,a ,@b)
>
> into
>
>     (append `(,a) b)

List-final ,@ is too special, IMHO, to be turned into an (append)
pattern at all.

> the pcase match will take a lot more time than the equivalent
>
>     `(,a . ,b)
>
> Of course, you can try and handle these "easy" cases more efficiently,
> but then your ,@ will sometimes be very cheap and sometimes very
> expensive (depending on when an optimization can be applied), which
> I think is a misfeature (it's for this same reason that I dislike CL
> keyword arguments for functions).

I think it's an implementation detail. Some reasoning about the
minimum and maximum length of sequences matched by pcase patterns
could help ordinary pcases, too, though:

(pcase '(a b c d)
  (`(,a ,b ,c ,d) (list a b c d)))

could call (pcase--check-length EXPVAL 4 4) rather than calling consp
four times, potentially descending into expensive predicates that are
unnecessary.
It's strange to read quotes that yo
In general, of course, multiple ,@s in the same list will be slow
because it's a difficult problem.

> I think it's fine to have such a search-based `append` (because it's
> "reliably expensive") but I'd rather not automatically use it for ,@

Again, I think that's a fundamental difference between us when it
comes to the philosophy behind pcase. If I understand you correctly,
you deliberately want to limit pcase, moving away from the intuitive
definition of it that I gave above, because there might be a situation
in which people expect better performance than our limited
implementation can give them. Is that correct?

I think that's a weak reason for a strong limitation, but of course
those are subjective questions. For example, I don't expect (pcase 9
((* x x) x)) to work, and the intuitive try-everything oracle would
work for it. In any case, if there is such a fundamental difference of
opinion, pcase simply isn't what I should be looking at.

> [ BTW, you don't need (nor want) `eval` in your definition.  ]

Thank you! Premature "optimization"...

Thanks again!

[-- Attachment #2: pcall.el --]
[-- Type: text/x-emacs-lisp, Size: 19830 bytes --]

;; -*- lexical-binding: t; -*-

(defun f (hello world)
  (cons hello world))

(defun pcall-collect-symbols-1 (expr pusher)
  (cond
   ((consp expr)
    (pcall-collect-symbols-1 (car expr) pusher)
    (pcall-collect-symbols-1 (cdr expr) pusher))
   ((symbolp expr)
    (funcall pusher expr))))

(defun pcall-collect-symbols (bindings)
  (let (list)
    (dolist (binding bindings)
      (pcall-collect-symbols-1 binding
                               (lambda (x)
                                 (unless (memq x list)
                                   (push x list)))))
    list))

(defun pcall-make-environment (syms)
  (let (env)
    (dolist (sym syms)
      (push (list 'cons
                  (list 'quote sym)
                  `(condition-case error
                       ,sym
                     (void-variable (push ',sym unbound-syms))))
            env))
    (cons 'list (nreverse env))))

(defun pcaller (func pats)
  (let* ((arglist (arglist func))
         (arg-symbols (pcall-collect-symbols arglist)))
    `(lambda (env vals)
       (dolist (sym ',arglist)
         ;; (if (assq sym env)
         ;;     (warn "shadowing variable binding for %S"
         ;;           sym))
         (setq env (assq-delete-all sym env)))
       (eval '(filtered-pcase vals
                (lambda (x)
                  (assq x env))
                (,(list '\` (mapcar (lambda (x) (list '\, x))
                                    pats))
                 (funcall ',func ,@arglist)))
             env))))

(defun arglist (func)
  (while (and (symbolp func)
	      (setq func (symbol-function func))))
  (pcase func
    ((or `(lambda ,arglist . ,body)
	 `(closure ,lexenv ,arglist . ,body))
     arglist)
    (_ (cdr (read
	     (downcase
	      (car (help-split-fundoc (documentation func t) func t))))))))

(defmacro pcall (func &rest bindings)
  (let* ((syms (pcall-collect-symbols bindings))
         (env (pcall-make-environment syms))
         (pats (mapcar #'car bindings))
         (vals (mapcar #'cadr bindings)))
  `(let ((func ',func))
     (while (and (symbolp func)
	         (setq func (symbol-function func))))
     (let ((pcaller (funcall #'pcaller func ',pats)))
       (let* ((unbound-syms (list nil))
              (env ,env)
	      (pcase--env env))
         (dolist (sym unbound-syms)
           (setq env (assq-delete-all sym env)))
         (funcall pcaller env (list ,@vals)))))))

(defun pcase--expand (exp cases filter)
  ;; (message "pid=%S (pcase--expand %S ...hash=%S)"
  ;;          (emacs-pid) exp (sxhash cases))
  (macroexp-let2 macroexp-copyable-p val exp
    (let* ((defs ())
           (seen '())
           (codegen
            (lambda (code vars)
              (let ((vars (pcase--fgrep vars code))
                    (prev (assq code seen)))
                (if (not prev)
                    (let ((res (pcase-codegen code vars)))
                      (push (list code vars res) seen)
                      res)
                  ;; Since we use a tree-based pattern matching
                  ;; technique, the leaves (the places that contain the
                  ;; code to run once a pattern is matched) can get
                  ;; copied a very large number of times, so to avoid
                  ;; code explosion, we need to keep track of how many
                  ;; times we've used each leaf and move it
                  ;; to a separate function if that number is too high.
                  ;;
                  ;; We've already used this branch.  So it is shared.
                  (let* ((code (car prev))         (cdrprev (cdr prev))
                         (prevvars (car cdrprev))  (cddrprev (cdr cdrprev))
                         (res (car cddrprev)))
                    (unless (symbolp res)
                      ;; This is the first repeat, so we have to move
                      ;; the branch to a separate function.
                      (let ((bsym
                             (make-symbol (format "pcase-%d" (length defs)))))
                        (push `(,bsym (lambda ,(mapcar #'car prevvars) ,@code))
                              defs)
                        (setcar res 'funcall)
                        (setcdr res (cons bsym (mapcar #'cdr prevvars)))
                        (setcar (cddr prev) bsym)
                        (setq res bsym)))
                    (setq vars (copy-sequence vars))
                    (let ((args (mapcar (lambda (pa)
                                          (let ((v (assq (car pa) vars)))
                                            (setq vars (delq v vars))
                                            (cdr v)))
                                        prevvars)))
                      ;; If some of `vars' were not found in `prevvars', that's
                      ;; OK it just means those vars aren't present in all
                      ;; branches, so they can be used within the pattern
                      ;; (e.g. by a `guard/let/pred') but not in the branch.
                      ;; FIXME: But if some of `prevvars' are not in `vars' we
                      ;; should remove them from `prevvars'!
                      `(funcall ,res ,@args)))))))
           (used-cases ())
           (main
            (pcase--u
             (mapcar (lambda (case)
                       `(,(pcase--match val (pcase--macroexpand (car case)))
                         ,(lambda (vars)
                            (unless (memq case used-cases)
                              ;; Keep track of the cases that are used.
                              (push case used-cases))
                            (funcall
                             (if (pcase--small-branch-p (cdr case))
                                 ;; Don't bother sharing multiple
                                 ;; occurrences of this leaf since it's small.
                                 (lambda (code vars)
                                   (pcase-codegen code
                                                  (pcase--fgrep vars code)))
                               codegen)
                             (cdr case)
                             vars))))
                     cases)
             filter)))
      (dolist (case cases)
        (unless (or (memq case used-cases)
                    (memq (car case) pcase--dontwarn-upats))
          (message "Redundant pcase pattern: %S" (car case))))
      (macroexp-let* defs main))))

(defvar pcase--env nil)

(pcase-defmacro concat (&rest patterns)
  (if patterns
      (let* ((pat (list '\` (cons (list '\, (car patterns))
				  (list '\, (cons 'concat
						  (cdr patterns))))))
	     (f `(lambda (l)
		   (catch 'pcase--call
		     (dotimes (i (1+ (length l)))
		       (let* ((lc (cons (seq-subseq l 0 i)
					(seq-subseq l i))))
			 (filtered-pcase lc
			   (lambda (x)
			     (assq x pcase--env))
			   (,pat (throw 'pcase--call lc)))))))))
	`(app ,f ,pat))
    `(pred seq-empty-p)))

(defmacro filtered-pcase (exp filter &rest cases)
  (declare (indent 1) (debug (form &rest (pcase-PAT body))))
  (pcase--expand exp cases filter))

(defmacro pcase (exp &rest cases)
  "Evaluate EXP to get EXPVAL; try passing control to one of CASES.
CASES is a list of elements of the form (PATTERN CODE...).
For the first CASE whose PATTERN \"matches\" EXPVAL,
evaluate its CODE..., and return the value of the last form.
If no CASE has a PATTERN that matches, return nil.

Each PATTERN expands, in essence, to a predicate to call
on EXPVAL.  When the return value of that call is non-nil,
PATTERN matches.  PATTERN can take one of the forms:

  _                matches anything.
  \\='VAL             matches if EXPVAL is `equal' to VAL.
  KEYWORD          shorthand for \\='KEYWORD
  INTEGER          shorthand for \\='INTEGER
  STRING           shorthand for \\='STRING
  SYMBOL           matches anything and binds it to SYMBOL.
                   If a SYMBOL is used twice in the same pattern
                   the second occurrence becomes an `eq'uality test.
  (pred FUN)       matches if FUN called on EXPVAL returns non-nil.
  (app FUN PAT)    matches if FUN called on EXPVAL matches PAT.
  (guard BOOLEXP)  matches if BOOLEXP evaluates to non-nil.
  (let PAT EXPR)   matches if EXPR matches PAT.
  (and PAT...)     matches if all the patterns match.
  (or PAT...)      matches if any of the patterns matches.

FUN in `pred' and `app' can take one of the forms:
  SYMBOL  or  (lambda ARGS BODY)
     call it with one argument
  (F ARG1 .. ARGn)
     call F with ARG1..ARGn and EXPVAL as n+1'th argument

FUN, BOOLEXP, EXPR, and subsequent PAT can refer to variables
bound earlier in the pattern by a SYMBOL pattern.

Additional patterns can be defined using `pcase-defmacro'.

See Info node `(elisp) Pattern-Matching Conditional' in the
Emacs Lisp manual for more information and examples."
  (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
  ;; which does come straight from the source code and should hence not be GC'd
  ;; so easily.
  (let ((data (gethash (car cases) pcase--memoize))
        (filter nil))
    ;; data = (EXP CASES . EXPANSION)
    (if (and (equal exp (car data)) (equal cases (cadr data)))
        ;; We have the right expansion.
        (cddr data)
      ;; (when (gethash (car cases) pcase--memoize-1)
      ;;   (message "pcase-memoize failed because of weak key!!"))
      ;; (when (gethash (car cases) pcase--memoize-2)
      ;;   (message "pcase-memoize failed because of eq test on %S"
      ;;            (car cases)))
      ;; (when data
      ;;   (message "pcase-memoize: equal first branch, yet different"))
      (let ((expansion (pcase--expand exp cases filter)))
        (puthash (car cases) `(,exp ,cases ,@expansion) pcase--memoize)
        ;; (puthash (car cases) `(,exp ,cases ,@expansion) pcase--memoize-1)
        ;; (puthash (car cases) `(,exp ,cases ,@expansion) pcase--memoize-2)
        expansion))))

(defun pcase--u (branches filter)
  "Expand matcher for rules BRANCHES.
Each BRANCH has the form (MATCH CODE . VARS) where
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 . PAT)
  (and MATCH ...)
  (or MATCH ...)"
  (when (setq branches (delq nil branches))
    (let* ((carbranch (car branches))
           (match (car carbranch)) (cdarbranch (cdr carbranch))
           (code (car cdarbranch))
           (vars (cdr cdarbranch)))
      (pcase--u1 (list match) code vars (cdr branches) filter))))

(defun pcase--u1 (matches code vars rest filter)
  "Return code that runs CODE (with VARS) if MATCHES match.
Otherwise, it defers to REST which is a list of branches of the form
\(ELSE-MATCH ELSE-CODE . ELSE-VARS)."
  ;; Depending on the order in which we choose to check each of the MATCHES,
  ;; the resulting tree may be smaller or bigger.  So in general, we'd want
  ;; to be careful to chose the "optimal" order.  But predicate
  ;; patterns make this harder because they create dependencies
  ;; between matches.  So we don't bother trying to reorder anything.
  (cond
   ((null matches) (funcall code vars))
   ((eq :pcase--fail (car matches)) (pcase--u rest filter))
   ((eq :pcase--succeed (car matches))
    (pcase--u1 (cdr matches) code vars rest filter))
   ((eq 'and (caar matches))
    (pcase--u1 (append (cdar matches) (cdr matches)) code vars rest
               filter))
   ((eq 'or (caar matches))
    (let* ((alts (cdar matches))
           (var (if (eq (caar alts) 'match) (cadr (car alts))))
           (simples '()) (others '()) (mem-fun 'memq))
      (when var
        (dolist (alt alts)
          (if (and (eq (car alt) 'match) (eq var (cadr alt))
                   (let ((upat (cddr alt)))
                     (eq (car-safe upat) 'quote)))
              (let ((val (cadr (cddr alt))))
                (cond ((integerp val)
                       (when (eq mem-fun 'memq)
                         (setq mem-fun 'memql)))
                      ((not (symbolp val))
                       (setq mem-fun 'member)))
                (push val simples))
            (push alt others))))
      (cond
       ((null alts) (error "Please avoid it") (pcase--u rest filter))
       ;; Yes, we can use `memql' (or `member')!
       ((> (length simples) 1)
        (pcase--u1 (cons `(match ,var
                                 . (pred (pcase--flip ,mem-fun ',simples)))
                         (cdr matches))
                   code vars
                   (if (null others) rest
                     (cons (cons
                            (pcase--and (if (cdr others)
                                            (cons 'or (nreverse others))
                                          (car others))
                                        (cdr matches))
                            (cons code vars))
                           rest))
                   filter))
       (t
        (pcase--u1 (cons (pop alts) (cdr matches)) code vars
                   (if (null alts) (progn (error "Please avoid it") rest)
                     (cons (cons
                            (pcase--and (if (cdr alts)
                                            (cons 'or alts) (car alts))
                                        (cdr matches))
                            (cons code vars))
                           rest))
                   filter)))))
   ((eq 'match (caar matches))
    (let* ((popmatches (pop matches))
           (_op (car popmatches))      (cdrpopmatches (cdr popmatches))
           (sym (car cdrpopmatches))
           (upat (cdr cdrpopmatches)))
      (cond
       ((memq upat '(t _))
        (let ((code (pcase--u1 matches code vars rest filter)))
          (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))
        (let* ((splitrest
                (pcase--split-rest
                 sym (lambda (pat) (pcase--split-pred vars upat pat)) rest))
               (then-rest (car splitrest))
               (else-rest (cdr splitrest)))
          (pcase--if (if (eq (car upat) 'pred)
                         (pcase--funcall (cadr upat) sym vars)
                       (pcase--eval (cadr upat) vars))
                     (pcase--u1 matches code vars then-rest filter)
                     (pcase--u else-rest filter))))
       ((and (symbolp upat) upat)
        (pcase--mark-used sym)
        (cond
         ((and filter (funcall filter upat))
          (pcase--u1 (cons `(match ,sym . (pred (lambda (x) (equal ,(cdr (funcall filter upat)) x))))
                           matches)
                     code vars rest filter))
         ((not (assq upat vars))
          (pcase--u1 matches code (cons (cons upat sym) vars) rest filter))
         (;; Non-linear pattern.  Turn it into an `eq' test.
          (pcase--u1 (cons `(match ,sym . (pred (eq ,(cdr (assq upat vars)))))
                           matches)
                     code vars rest filter))))
       ((eq (car-safe upat) 'let)
        ;; A upat of the form (let VAR EXP).
        ;; (pcase--u1 matches code
        ;;            (cons (cons (nth 1 upat) (nth 2 upat)) vars) rest)
        (macroexp-let2
            macroexp-copyable-p sym
            (pcase--eval (nth 2 upat) vars)
          (pcase--u1 (cons (pcase--match sym (nth 1 upat)) matches)
                     code vars rest filter)))
       ((eq (car-safe upat) 'app)
        ;; A upat of the form (app FUN PAT)
        (pcase--mark-used sym)
        (let* ((fun (nth 1 upat))
               (nsym (gensym "x"))
               (body
                ;; 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 (pcase--match nsym (nth 2 upat)) matches)
                           code vars
                           (pcase--app-subst-rest rest sym fun nsym)
                           (lambda (x) (and (not (eq x nsym))) (and filter (funcall filter x))))))
          (if (not (get nsym 'pcase-used))
              body
            (macroexp-let*
             `((,nsym ,(pcase--funcall fun sym vars)))
             body))))
       ((eq (car-safe upat) 'quote)
        (pcase--mark-used sym)
        (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))
                      ((integerp val) `(eql ,sym ,val))
                      ((symbolp val)
                       (if (pcase--self-quoting-p val)
                           `(eq ,sym ,val)
                         `(eq ,sym ',val)))
                      (t `(equal ,sym ',val)))
                     (pcase--u1 matches code vars then-rest filter)
                     (pcase--u else-rest filter))))
       ((eq (car-safe upat) 'not)
        ;; FIXME: The implementation below is naive and results in
        ;; inefficient code.
        ;; To make it work right, we would need to turn pcase--u1's
        ;; `code' and `vars' into a single argument of the same form as
        ;; `rest'.  We would also need to split this new `then-rest' argument
        ;; for every test (currently we don't bother to do it since
        ;; it's only useful for odd patterns like (and `(PAT1 . PAT2)
        ;; `(PAT3 . PAT4)) which the programmer can easily rewrite
        ;; to the more efficient `(,(and PAT1 PAT3) . ,(and PAT2 PAT4))).
        (pcase--u1 `((match ,sym . ,(cadr upat)))
                   ;; FIXME: This codegen is not careful to share its
                   ;; code if used several times: code blow up is likely.
                   (lambda (_vars)
                     ;; `vars' will likely contain bindings which are
                     ;; not always available in other paths to
                     ;; `rest', so there' no point trying to pass
                     ;; them down.
                     (pcase--u rest filter))
                   vars
                   (list `((and . ,matches) ,code . ,vars))
                   filter))
       (t (error "Unknown pattern `%S'" upat)))))
   (t (error "Incorrect MATCH %S" (car matches)))))

(let ((space " "))
  (pcall f ((concat hello space world) "hello world")))

(defun pcase--length (pattern)
    (setq pattern (pcase--macroexpand pattern))
    (pcase pattern
      (`(pred null) (cons 0 0))
      (`'nil (cons 0 0))
      (`(pred consp) (cons 1 1.0e+INF))
      (`(app cdr ,pattern)
       (let ((length (pcase--length pattern)))
	 (if (> (car length) 0)
	     (cons (1+ (car length)) (1+ (cdr length)))
	   (cons 0 (1+ (cdr length))))))
      (`(or . ,patterns)
       (let ((inf 0)
	     (sup 1.0e+INF))
	 (dolist (pattern patterns)
	   (let* ((is (pcase--length pattern))
		  (i (car is))
		  (s (cdr is)))
	     (setq inf (min inf i))
	     (setq sup (max sup s))))
	 (cons inf sup)))
      (`(and . ,patterns)
       (let ((inf 0)
	     (sup 1.0e+INF))
	 (dolist (pattern patterns)
	   (let* ((is (pcase--length pattern))
		  (i (car is))
		  (s (cdr is)))
	     (setq inf (max inf i))
	     (setq sup (min sup s))))
	 (cons inf sup)))
      (_ (cons 0 1.0e+INF))))

(pcase-defmacro not (pat)
  `(app (lambda (expval) (not (pcase expval (,pat t))))
        (pred identity)))