Function: tuareg--syntax-rules

tuareg--syntax-rules is a macro defined in tuareg.el.

Signature

(tuareg--syntax-rules &rest RULES)

Documentation

Generate a function to parse according to RULES.

Each argument has the form (RE BODY...) where RE is a regexp to match and BODY what to execute upon match. BODY is executed with point at the end of the match, start bound to the start of the match and group to the number of the first group in RE, if any. The returned function takes the two arguments BEGIN and END delimiting the region of interest.

Source Code

;; Defined in /nix/store/6mbh851dhnag8f92qfrlh9ckldzwf6c6-emacs-packages-deps/share/emacs/site-lisp/elpa/tuareg-20260626.936/tuareg.el
(defmacro tuareg--syntax-rules (&rest rules)
  "Generate a function to parse according to RULES.
Each argument has the form (RE BODY...) where RE is a regexp to
match and BODY what to execute upon match. BODY is executed with
point at the end of the match, `start' bound to the start of the
match and `group' to the number of the first group in RE, if any.
The returned function takes the two arguments BEGIN and END
delimiting the region of interest. "
  (let ((group-number 1)
        (clauses nil)
        (regexps nil))
    (dolist (rule rules)
      (let* ((re (macroexpand (car rule)))
             (body (cdr rule))
             (re-ngroups (regexp-opt-depth re))
             (clause-body
              (if (> re-ngroups 0)
                  `((let ((group ,(1+ group-number)))
                      ,@body))
                body)))
        (push re regexps)
        ;; We can just omit empty clauses since the conditions are
        ;; mutually exclusive by construction (and the value of the
        ;; clause bodies are ignored).
        (when body
          (push `((match-beginning ,group-number) . ,clause-body)
                clauses))
        (setq group-number (+ group-number 1 re-ngroups))))
    (let ((combined-re (mapconcat (lambda (re) (concat "\\(" re "\\)"))
                                  (nreverse regexps) "\\|"))
          (begin (make-symbol "begin"))
          (end (make-symbol "end")))
      `(lambda (,begin ,end)
         (goto-char ,begin)
         (while (and (< (point) ,end)
                     (re-search-forward ,combined-re ,end t)
                     (let ((start (match-beginning 0)))
                       (cond . ,(nreverse clauses))
                       t)))))))