Function: combobulate-query--match-many-children

combobulate-query--match-many-children is a natively compiled function defined in combobulate-navigation.el.

Signature

(combobulate-query--match-many-children CHILDREN FULL-QUERY &optional QUANTIFIER NEXT-QUERY SIBLING)

Source Code

;; Defined in /nix/store/b5fvrwzi3zvkabyzx0in6gw1cj963z46-emacs-packages-deps/share/emacs/site-lisp/combobulate-navigation.el
(cl-defun combobulate-query--match-many-children (children full-query &optional quantifier next-query sibling)
  (setq quantifier (or quantifier '1))
  (let* ((query-term-types (mapcar #'combobulate-query--term-type full-query))
         (match-anonymous (or (member 'anonymous query-term-types)
                              (member 'wildcard query-term-types)))
         (query (combobulate-query--iter-query full-query))
         (terms-left -1)
         (machine nil)
         (term-quantifier '1)
         (next-term)
         (match-state 'unknown)
         (machine-state nil)
         (accrued-matches)
         (child)
         (matches)
         (match-result)
         (term)
         (starting-children children))
    (when (and sibling (or (member '* full-query)
                           (member '+ full-query)))
      (error "Only `?' quantifiers are supported in sibling sub-queries."))
    (cl-flet* ((advance-machine (status)
                 (setq machine-state (iter-next machine status))
                 machine-state)
               (store-match (v)
                 (setq accrued-matches (nconc accrued-matches (mapcar #'append v))))
               (commit-matches ()
                 (setq matches (nconc matches accrued-matches))
                 (setq accrued-matches nil))
               (discard-matches ()
                 (setq accrued-matches nil))
               (next-term (&optional reset)
                 (when reset
                   (iter-next query t))
                 (pcase-let ((`(,new-term ,peek-term ,ct) (iter-next query)))
                   (setq term new-term)
                   (when (>= ct terms-left)
                     (commit-matches))
                   (setq terms-left ct)
                   (setq next-term peek-term)
                   (if (and peek-term (eq (combobulate-query--term-type peek-term) 'quantifier))
                       (setq term-quantifier peek-term)
                     (setq term-quantifier '1))
                   new-term))
               (reset-machine ()
                 (if machine
                     (setq machine-state (iter-next machine 'reset))
                   (setq machine (combobulate-query--iter-state-machine quantifier t))
                   (setq machine-state (iter-next machine)))
                 (unless (eq machine-state 'start)
                   (error "Machine start machine-state should be `start' but it is `%s'" machine-state))))
      (reset-machine)
      (next-term)
      (cl-block stop
        (while term
          ;; debug
          (when (eq (combobulate-query--term-type term) 'quantifier)
            (error "Next term is a quantifier `%s'" term))
          (cl-block next-child
            (while (setq child (pop children))
              (setq match-result nil)
              (when (or (and (not (combobulate-node-named-p child)) match-anonymous)
                        (combobulate-node-named-p child))
                (setq match-result (if (not (eq term-quantifier '1))
                                       (combobulate-query--match-many-children
                                        (list child) (list term)
                                        (prog1 (next-term) (next-term))
                                        next-term)
                                     (funcall (combobulate-query-find-test-function term) child term)))
                (pcase match-result
                  (`(match . (,sub-results . ,_))
                   (setq match-result sub-results))
                  (`(no-match . ,_)
                   (setq match-result nil))
                  (`(ignore . (nil . ,_))
                   (push child children)
                   (setq match-result nil)
                   (cl-return-from next-child))
                  (_ (error "unknown sub result `%s'" match-result)))
                (if match-result
                    (progn
                      (advance-machine 'match)
                      (when (and (eq machine-state 'match-continue)
                                 next-query children
                                 (combobulate-query-search-1 (car children)
                                                             (if (consp next-query)
                                                                 next-query
                                                               (cons next-query nil))))
                        (store-match match-result)
                        (commit-matches)
                        (setq match-state 'match)
                        (setq term nil)
                        (cl-return-from stop))
                      (pcase machine-state
                        ('match-continue
                         (store-match match-result)
                         (next-term))
                        ('match-stop
                         (store-match match-result)
                         (reset-machine)
                         (commit-matches)
                         (if (> terms-left 1)
                             (next-term)
                           (setq term nil))
                         (setq match-state 'match)
                         (cl-return-from next-child))
                        (_ (error "Positive match machine-state error: `%s'" machine-state))))
                  (pcase (setq machine-state (advance-machine 'no-match))
                    ('match-stop
                     (reset-machine)
                     (setq match-state 'match)
                     (push child children)
                     (discard-matches)
                     (cl-return-from stop))
                    ;; do nothing: we've been told to proceed
                    ('continue)
                    (_ (error "Negative match machine-state error: `%s'" machine-state))))))
            (pcase (setq machine-state (advance-machine 'no-children))
              ('failed-match
               (reset-machine)
               (setq match-state 'no-match)
               (cl-return-from stop))
              ('match-stop
               (reset-machine)
               (setq match-state 'match)
               (cl-return-from stop))
              ('skip
               (reset-machine)
               (setq children starting-children)
               (setq match-state 'ignore)
               (cl-return-from stop))
              (_ (error "Out of children machine-state error: `%s'" machine-state))))))
      (when accrued-matches
        (error "accrued matches error: `%s'" accrued-matches))
      (cons match-state (cons matches children)))))