Function: parseclj-parser

parseclj-parser is a byte-compiled function defined in parseclj-parser.el.

Signature

(parseclj-parser REDUCE-LEAF REDUCE-BRANCH &optional OPTIONS)

Documentation

Clojure/EDN stack-based shift-reduce parser.

REDUCE-LEAF does reductions for leaf nodes. It is a function that takes the current value of the stack and a token, and either returns an updated stack, with a new leaf node at the top (front), or returns the stack unmodified.

REDUCE-BRANCH does reductions for branch nodes. It is a function that takes the current value of the stack, the type of branch node to create, and a list of child nodes, and returns an updated stack, with the new node at the top (front).

What "node" means in this case is up to the reducing functions, it could be AST nodes (as in the case of parseclj-parser-clojure), or plain values/sexps (as in the case of parseedn-read), or something else. The only requirement is that they should not put raw tokens back on the stack, as the parser relies on the presence or absence of these to detect parse errors.

OPTIONS is an association list which is passed on to the reducing functions. Additionally the following options are recognized

- :fail-fast
  Raise an error when a parse error is encountered, rather than continuing
  with a partial result.
- :value-p
  A predicate function to differentiate values from tokens and
  whitespace. This is needed when scanning the stack to see if any
  reductions can be performed. By default anything that isn't a token is
  considered a value. This can be problematic when parsing with
  :lexical-preservation, and which case you should provide an
  implementation that also returns falsy for :whitespace, :comment, and
  :discard AST nodes.
- :tag-readers
  An association list that describes tag handler functions for any possible
  tag. This options in only available in parseedn-read, for more
  information, please refer to its documentation.
- :read-one
  Return as soon as a single complete value has been read.

Source Code

;; Defined in ~/.emacs.d/elpa/parseclj-20261002.1230/parseclj-parser.el
(defun parseclj-parser (reduce-leaf reduce-branch &optional options)
  "Clojure/EDN stack-based shift-reduce parser.

REDUCE-LEAF does reductions for leaf nodes.  It is a function that takes
the current value of the stack and a token, and either returns an updated
stack, with a new leaf node at the top (front), or returns the stack
unmodified.

REDUCE-BRANCH does reductions for branch nodes.  It is a function that
takes the current value of the stack, the type of branch node to create,
and a list of child nodes, and returns an updated stack, with the new node
at the top (front).

What \"node\" means in this case is up to the reducing functions, it could
be AST nodes (as in the case of `parseclj-parser-clojure'), or plain
values/sexps (as in the case of `parseedn-read'), or something else. The
only requirement is that they should not put raw tokens back on the stack,
as the parser relies on the presence or absence of these to detect parse
errors.

OPTIONS is an association list which is passed on to the reducing
functions. Additionally the following options are recognized

- `:fail-fast'
  Raise an error when a parse error is encountered, rather than continuing
  with a partial result.
- `:value-p'
  A predicate function to differentiate values from tokens and
  whitespace. This is needed when scanning the stack to see if any
  reductions can be performed. By default anything that isn't a token is
  considered a value. This can be problematic when parsing with
  `:lexical-preservation', and which case you should provide an
  implementation that also returns falsy for :whitespace, :comment, and
  :discard AST nodes.
- `:tag-readers'
  An association list that describes tag handler functions for any possible
  tag.  This options in only available in `parseedn-read', for more
  information, please refer to its documentation.
- `:read-one'
  Return as soon as a single complete value has been read."
  (let ((fail-fast (map-elt options :fail-fast t))
        (read-one (map-elt options :read-one))
        (value-p (map-elt options :value-p (lambda (e) (not (parseclj-lex-token-p e)))))
        (stack nil)
        (token (parseclj-lex-next)))

    (while (not (or (and read-one (parseclj-single-value-p stack value-p))
                    (eq (parseclj-lex-token-type token) :eof)))
      ;; (message "STACK: %S" stack)
      ;; (message "TOKEN: %S\n" token)

      (when (and fail-fast (parseclj-lex-error-p token))
        (parseclj--error "Invalid token at %s: %S"
                         (map-elt token :pos)
                         (parseclj-lex-token-form token)))

      ;; Reduce based on the top item on the stack (collections)
      (cond
       ((parseclj-lex-leaf-token-p token)
        (setf stack (funcall reduce-leaf stack token options)))

       ((parseclj-lex-closing-token-p token)
        (setf stack (parseclj--reduce-coll stack token reduce-branch options)))

       (t (push token stack)))

      ;; Reduce based on top two items on the stack (special prefixed elements)
      (let* ((top-value (parseclj--take-value stack value-p))
             (opening-token (parseclj--take-token (nthcdr (length top-value) stack) value-p parseclj-lex--prefix-tokens))
             new-stack)
        (while (and top-value opening-token)
          ;; (message "Reducing...")
          ;; (message "  - STACK %S" stack)
          ;; (message "  - OPENING-TOKEN %S" opening-token)
          ;; (message "  - TOP-VALUE %S" top-value)
          (setq new-stack (nthcdr (+ (length top-value) (length opening-token)) stack))
          (setq stack (funcall reduce-branch new-stack (car opening-token) (append (cdr opening-token) top-value) options))

          ;; recur
          (setq top-value (parseclj--take-value stack value-p))
          (setq opening-token (parseclj--take-token (nthcdr (length top-value) stack) value-p parseclj-lex--prefix-tokens))))

      ;; Reduce based on top three items on the stack (metadata, namespaced maps)
      (let* ((top-value-1 (parseclj--take-value stack value-p))
             (top-value-2 (parseclj--take-value (nthcdr (length top-value-1) stack) value-p))
             (opening-token (parseclj--take-token (nthcdr (+ (length top-value-1)
                                                             (length top-value-2)) stack) value-p parseclj-lex--prefix-2-tokens))
             new-stack)
        (while (and top-value-1 top-value-2 opening-token)
          (setq new-stack (nthcdr (apply #'+ (mapcar #'length (list top-value-1 top-value-2 opening-token))) stack))
          (setq stack (funcall reduce-branch new-stack (car opening-token) (append (cdr opening-token) top-value-2 top-value-1) options))

          ;; recur
          (setq top-value-1 (parseclj--take-value stack value-p))
          (setq top-value-2 (parseclj--take-value (nthcdr (length top-value-1) stack) value-p))
          (setq opening-token (parseclj--take-token (nthcdr (+ (length top-value-1)
                                                               (length top-value-2)) stack) value-p parseclj-lex--prefix-2-tokens))))

      (setq token (parseclj-lex-next)))

    ;; reduce root
    (when fail-fast
      (when-let* ((token (seq-find #'parseclj-lex-token-p stack)))
        (parseclj--error "At position %s, unmatched %S"
                         (map-elt token :pos)
                         (parseclj-lex-token-type token))))

    (if read-one
        (car (parseclj--take-value stack value-p))
      (car (funcall reduce-branch nil (parseclj-lex-token :root "" 1)
                    (reverse stack)
                    options)))))