;; Erlang expression parser — top-level fns operating on parser state.
;; Depends on parser-core.sx (er-state-*, er-cur-*, er-is?, er-expect!)
;; and parser.sx (er-is-binop?, er-any-binop?, er-build-cons, er-slice-list).

;; ── entry point ───────────────────────────────────────────────────
(define
  er-parse-expr
  (fn
    (src)
    (let
      ((st (er-state-make (er-tokenize src))))
      (er-parse-expr-prec st 0))))

;; Pratt-like operator-precedence parser.
(define
  er-parse-expr-prec
  (fn
    (st min-prec)
    (let
      ((left (er-parse-unary st)))
      (er-parse-expr-loop st min-prec left))))

(define
  er-parse-expr-loop
  (fn
    (st min-prec left)
    (if
      (er-any-binop? (er-cur st) min-prec)
      (let
        ((tok (er-cur st)))
        (cond
          (er-is-binop? tok 0)
          (do (er-advance! st) (er-parse-expr-loop st min-prec {:rhs (er-parse-expr-prec st 0) :type "match" :lhs left}))
          (er-is-binop? tok 1)
          (do (er-advance! st) (er-parse-expr-loop st min-prec {:msg (er-parse-expr-prec st 1) :type "send" :to left}))
          (er-is-binop? tok 2)
          (let
            ((op (get tok :value)))
            (er-advance! st)
            (er-parse-expr-loop st min-prec {:args (list left (er-parse-expr-prec st 3)) :type "op" :op op}))
          (er-is-binop? tok 3)
          (let
            ((op (get tok :value)))
            (er-advance! st)
            (er-parse-expr-loop st min-prec {:args (list left (er-parse-expr-prec st 4)) :type "op" :op op}))
          (er-is-binop? tok 4)
          (let
            ((op (get tok :value)))
            (er-advance! st)
            (er-parse-expr-loop st min-prec {:args (list left (er-parse-expr-prec st 5)) :type "op" :op op}))
          (er-is-binop? tok 5)
          (let
            ((op (get tok :value)))
            (er-advance! st)
            (er-parse-expr-loop st min-prec {:args (list left (er-parse-expr-prec st 5)) :type "op" :op op}))
          (er-is-binop? tok 6)
          (let
            ((op (get tok :value)))
            (er-advance! st)
            (er-parse-expr-loop st min-prec {:args (list left (er-parse-expr-prec st 7)) :type "op" :op op}))
          (er-is-binop? tok 7)
          (let
            ((op (get tok :value)))
            (er-advance! st)
            (er-parse-expr-loop st min-prec {:args (list left (er-parse-expr-prec st 8)) :type "op" :op op}))
          :else left))
      left)))

(define
  er-parse-unary
  (fn
    (st)
    (cond
      (er-is? st "op" "-")
      (do (er-advance! st) {:arg (er-parse-unary st) :type "unop" :op "-"})
      (er-is? st "op" "+")
      (do (er-advance! st) (er-parse-unary st))
      (er-is? st "keyword" "not")
      (do (er-advance! st) {:arg (er-parse-unary st) :type "unop" :op "not"})
      (er-is? st "keyword" "bnot")
      (do (er-advance! st) {:arg (er-parse-unary st) :type "unop" :op "bnot"})
      :else (er-parse-postfix st))))

(define
  er-parse-postfix
  (fn (st) (er-parse-postfix-loop st (er-parse-primary st))))

(define
  er-parse-postfix-loop
  (fn
    (st node)
    (cond
      (er-is? st "punct" ":")
      (do
        (er-advance! st)
        (let
          ((rhs (er-parse-primary st)))
          (er-parse-postfix-loop st {:fun rhs :mod node :type "remote"})))
      (er-is? st "punct" "(")
      (let
        ((args (er-parse-call-args st)))
        (er-parse-postfix-loop st {:args args :fun node :type "call"}))
      :else node)))

(define
  er-parse-call-args
  (fn
    (st)
    (er-expect! st "punct" "(")
    (if
      (er-is? st "punct" ")")
      (do (er-advance! st) (list))
      (let
        ((args (list (er-parse-expr-prec st 0))))
        (er-parse-args-tail st args)))))

(define
  er-parse-args-tail
  (fn
    (st args)
    (cond
      (er-is? st "punct" ",")
      (do
        (er-advance! st)
        (append! args (er-parse-expr-prec st 0))
        (er-parse-args-tail st args))
      (er-is? st "punct" ")")
      (do (er-advance! st) args)
      :else (error
        (str
          "Erlang parse: expected ',' or ')' in args, got '"
          (er-cur-value st)
          "'")))))

;; A body is: Expr {, Expr}
(define
  er-parse-body
  (fn
    (st)
    (let
      ((exprs (list (er-parse-expr-prec st 0))))
      (er-parse-body-tail st exprs))))

(define
  er-parse-body-tail
  (fn
    (st exprs)
    (if
      (er-is? st "punct" ",")
      (do
        (er-advance! st)
        (append! exprs (er-parse-expr-prec st 0))
        (er-parse-body-tail st exprs))
      exprs)))

;; Guards: G1 ; G2 ; ... where each Gi is a guard-conj (T, T, ...)
(define
  er-parse-guards
  (fn
    (st)
    (let
      ((alts (list (er-parse-guard-conj st))))
      (er-parse-guards-tail st alts))))

(define
  er-parse-guards-tail
  (fn
    (st alts)
    (if
      (er-is? st "punct" ";")
      (do
        (er-advance! st)
        (append! alts (er-parse-guard-conj st))
        (er-parse-guards-tail st alts))
      alts)))

(define
  er-parse-guard-conj
  (fn
    (st)
    (let
      ((ts (list (er-parse-expr-prec st 0))))
      (er-parse-guard-conj-tail st ts))))

(define
  er-parse-guard-conj-tail
  (fn
    (st ts)
    (if
      (er-is? st "punct" ",")
      (do
        (er-advance! st)
        (append! ts (er-parse-expr-prec st 0))
        (er-parse-guard-conj-tail st ts))
      ts)))

(define er-parse-pattern (fn (st) (er-parse-expr-prec st 0)))

;; ── primary expressions ──────────────────────────────────────────
(define
  er-parse-primary
  (fn
    (st)
    (let
      ((tok (er-cur st)))
      (cond
        (= (er-cur-type st) "integer")
        (do (er-advance! st) {:value (get tok :value) :type "integer"})
        (= (er-cur-type st) "float")
        (do (er-advance! st) {:value (get tok :value) :type "float"})
        (= (er-cur-type st) "string")
        (do (er-advance! st) {:value (get tok :value) :type "string"})
        (= (er-cur-type st) "atom")
        (do (er-advance! st) {:value (get tok :value) :type "atom"})
        (= (er-cur-type st) "var")
        (do (er-advance! st) {:type "var" :name (get tok :value)})
        (er-is? st "punct" "(")
        (do
          (er-advance! st)
          (let
            ((e (er-parse-expr-prec st 0)))
            (er-expect! st "punct" ")")
            e))
        (er-is? st "punct" "{")
        (er-parse-tuple st)
        (er-is? st "punct" "[")
        (er-parse-list st)
        (er-is? st "keyword" "if")
        (er-parse-if st)
        (er-is? st "keyword" "case")
        (er-parse-case st)
        (er-is? st "keyword" "receive")
        (er-parse-receive st)
        (er-is? st "keyword" "begin")
        (er-parse-begin st)
        (er-is? st "keyword" "fun")
        (er-parse-fun-expr st)
        (er-is? st "keyword" "try")
        (er-parse-try st)
        (er-is? st "punct" "<<")
        (er-parse-binary st)
        :else (error
          (str
            "Erlang parse: unexpected "
            (er-cur-type st)
            " '"
            (get tok :value)
            "' at pos "
            (get tok :pos)))))))

(define
  er-parse-tuple
  (fn
    (st)
    (er-expect! st "punct" "{")
    (if
      (er-is? st "punct" "}")
      (do (er-advance! st) {:elements (list) :type "tuple"})
      (let
        ((elems (list (er-parse-expr-prec st 0))))
        (er-parse-tuple-tail st elems)))))

(define
  er-parse-tuple-tail
  (fn
    (st elems)
    (cond
      (er-is? st "punct" ",")
      (do
        (er-advance! st)
        (append! elems (er-parse-expr-prec st 0))
        (er-parse-tuple-tail st elems))
      (er-is? st "punct" "}")
      (do (er-advance! st) {:elements elems :type "tuple"})
      :else (error
        (str
          "Erlang parse: expected ',' or '}' in tuple, got '"
          (er-cur-value st)
          "'")))))

(define
  er-parse-list
  (fn
    (st)
    (er-expect! st "punct" "[")
    (cond
      (er-is? st "punct" "]")
      (do (er-advance! st) {:type "nil"})
      :else (let
        ((first (er-parse-expr-prec st 0)))
        (cond
          (er-is? st "punct" "||") (er-parse-list-comp st first)
          :else (er-parse-list-tail st (list first)))))))

(define
  er-parse-list-comp
  (fn
    (st head)
    (er-advance! st)
    (let
      ((quals (list (er-parse-lc-qualifier st))))
      (er-parse-list-comp-tail st head quals))))

(define
  er-parse-list-comp-tail
  (fn
    (st head quals)
    (cond
      (er-is? st "punct" ",")
      (do
        (er-advance! st)
        (append! quals (er-parse-lc-qualifier st))
        (er-parse-list-comp-tail st head quals))
      (er-is? st "punct" "]")
      (do (er-advance! st) {:head head :qualifiers quals :type "lc"})
      :else (error
        (str
          "Erlang parse: expected ',' or ']' in list comprehension, got '"
          (er-cur-value st)
          "'")))))

(define
  er-parse-lc-qualifier
  (fn
    (st)
    (let
      ((e (er-parse-expr-prec st 0)))
      (cond
        (er-is? st "punct" "<-")
        (do
          (er-advance! st)
          (let
            ((source (er-parse-expr-prec st 0)))
            {:kind "gen" :pattern e :source source}))
        :else {:kind "filter" :expr e}))))

(define
  er-parse-list-tail
  (fn
    (st elems)
    (cond
      (er-is? st "punct" ",")
      (do
        (er-advance! st)
        (append! elems (er-parse-expr-prec st 0))
        (er-parse-list-tail st elems))
      (er-is? st "punct" "|")
      (do
        (er-advance! st)
        (let
          ((tail (er-parse-expr-prec st 0)))
          (er-expect! st "punct" "]")
          (er-build-cons elems tail)))
      (er-is? st "punct" "]")
      (do (er-advance! st) (er-build-cons elems {:type "nil"}))
      :else (error
        (str
          "Erlang parse: expected ',' '|' or ']' in list, got '"
          (er-cur-value st)
          "'")))))

;; ── if ──────────────────────────────────────────────────────────
(define
  er-parse-if
  (fn
    (st)
    (er-expect! st "keyword" "if")
    (let
      ((clauses (list (er-parse-if-clause st))))
      (er-parse-if-tail st clauses))))

(define
  er-parse-if-tail
  (fn
    (st clauses)
    (if
      (er-is? st "punct" ";")
      (do
        (er-advance! st)
        (append! clauses (er-parse-if-clause st))
        (er-parse-if-tail st clauses))
      (do (er-expect! st "keyword" "end") {:clauses clauses :type "if"}))))

(define
  er-parse-if-clause
  (fn
    (st)
    (let
      ((guards (er-parse-guards st)))
      (er-expect! st "punct" "->")
      (let ((body (er-parse-body st))) {:body body :guards guards}))))

;; ── case ────────────────────────────────────────────────────────
(define
  er-parse-case
  (fn
    (st)
    (er-expect! st "keyword" "case")
    (let
      ((e (er-parse-expr-prec st 0)))
      (er-expect! st "keyword" "of")
      (let
        ((clauses (list (er-parse-case-clause st))))
        (er-parse-case-tail st e clauses)))))

(define
  er-parse-case-tail
  (fn
    (st e clauses)
    (if
      (er-is? st "punct" ";")
      (do
        (er-advance! st)
        (append! clauses (er-parse-case-clause st))
        (er-parse-case-tail st e clauses))
      (do (er-expect! st "keyword" "end") {:expr e :clauses clauses :type "case"}))))

(define
  er-parse-case-clause
  (fn
    (st)
    (let
      ((pat (er-parse-pattern st)))
      (let
        ((guards (if (er-is? st "keyword" "when") (do (er-advance! st) (er-parse-guards st)) (list))))
        (er-expect! st "punct" "->")
        (let ((body (er-parse-body st))) {:pattern pat :body body :guards guards})))))

;; ── receive ─────────────────────────────────────────────────────
(define
  er-parse-receive
  (fn
    (st)
    (er-expect! st "keyword" "receive")
    (let
      ((clauses (if (er-is? st "keyword" "after") (list) (list (er-parse-case-clause st)))))
      (er-parse-receive-clauses st clauses))))

(define
  er-parse-receive-clauses
  (fn
    (st clauses)
    (cond
      (er-is? st "punct" ";")
      (do
        (er-advance! st)
        (append! clauses (er-parse-case-clause st))
        (er-parse-receive-clauses st clauses))
      (er-is? st "keyword" "after")
      (do
        (er-advance! st)
        (let
          ((after-ms (er-parse-expr-prec st 0)))
          (er-expect! st "punct" "->")
          (let
            ((after-body (er-parse-body st)))
            (er-expect! st "keyword" "end")
            {:clauses clauses :type "receive" :after-ms after-ms :after-body after-body})))
      :else (do (er-expect! st "keyword" "end") {:clauses clauses :type "receive" :after-ms nil :after-body (list)}))))

(define
  er-parse-begin
  (fn
    (st)
    (er-expect! st "keyword" "begin")
    (let
      ((exprs (er-parse-body st)))
      (er-expect! st "keyword" "end")
      {:exprs exprs :type "block"})))

(define
  er-parse-fun-expr
  (fn
    (st)
    (er-expect! st "keyword" "fun")
    (cond
      (er-is? st "punct" "(")
      (let
        ((clauses (list (er-parse-fun-clause st nil))))
        (er-parse-fun-expr-tail st clauses))
      :else (error "Erlang parse: fun-ref syntax not yet supported"))))

(define
  er-parse-fun-expr-tail
  (fn
    (st clauses)
    (if
      (er-is? st "punct" ";")
      (do
        (er-advance! st)
        (append! clauses (er-parse-fun-clause st nil))
        (er-parse-fun-expr-tail st clauses))
      (do (er-expect! st "keyword" "end") {:clauses clauses :type "fun"}))))

(define
  er-parse-fun-clause
  (fn
    (st named-name)
    (er-expect! st "punct" "(")
    (let
      ((patterns (if (er-is? st "punct" ")") (list) (er-parse-pattern-list st (list (er-parse-pattern st))))))
      (er-expect! st "punct" ")")
      (let
        ((guards (if (er-is? st "keyword" "when") (do (er-advance! st) (er-parse-guards st)) (list))))
        (er-expect! st "punct" "->")
        (let ((body (er-parse-body st))) {:patterns patterns :body body :guards guards :name named-name})))))

(define
  er-parse-pattern-list
  (fn
    (st pats)
    (if
      (er-is? st "punct" ",")
      (do
        (er-advance! st)
        (append! pats (er-parse-pattern st))
        (er-parse-pattern-list st pats))
      pats)))

;; ── try ─────────────────────────────────────────────────────────
(define
  er-parse-try
  (fn
    (st)
    (er-expect! st "keyword" "try")
    (let
      ((exprs (er-parse-body st))
        (of-clauses (list))
        (catch-clauses (list))
        (after-body (list)))
      (when
        (er-is? st "keyword" "of")
        (er-advance! st)
        (append! of-clauses (er-parse-case-clause st))
        (er-parse-try-of-tail st of-clauses))
      (when
        (er-is? st "keyword" "catch")
        (er-advance! st)
        (append! catch-clauses (er-parse-catch-clause st))
        (er-parse-try-catch-tail st catch-clauses))
      (when
        (er-is? st "keyword" "after")
        (er-advance! st)
        (set! after-body (er-parse-body st)))
      (er-expect! st "keyword" "end")
      {:exprs exprs :catch-clauses catch-clauses :type "try" :of-clauses of-clauses :after after-body})))

(define
  er-parse-try-of-tail
  (fn
    (st clauses)
    (when
      (er-is? st "punct" ";")
      (er-advance! st)
      (append! clauses (er-parse-case-clause st))
      (er-parse-try-of-tail st clauses))))

(define
  er-parse-try-catch-tail
  (fn
    (st clauses)
    (when
      (er-is? st "punct" ";")
      (er-advance! st)
      (append! clauses (er-parse-catch-clause st))
      (er-parse-try-catch-tail st clauses))))

(define
  er-parse-catch-clause
  (fn
    (st)
    (let
      ((p1 (er-parse-pattern st)))
      (let
        ((klass (if (= (get p1 :type) "remote") (get p1 :mod) {:value "throw" :type "atom"}))
          (pat (if (= (get p1 :type) "remote") (get p1 :fun) p1)))
        (let
          ((guards (if (er-is? st "keyword" "when") (do (er-advance! st) (er-parse-guards st)) (list))))
          (er-expect! st "punct" "->")
          (let ((body (er-parse-body st))) {:pattern pat :body body :class klass :guards guards}))))))

;; ── binary literals / patterns ────────────────────────────────
;; `<< [Seg {, Seg}] >>` where Seg = Value [: Size] [/ Spec]. Size is
;; a literal integer (multiple of 8 supported); Spec is `integer`
;; (default) or `binary` (rest-of-binary tail). Sufficient for the
;; common `<<A:8, B:16, Rest/binary>>` patterns.
(define
  er-parse-binary
  (fn
    (st)
    (er-expect! st "punct" "<<")
    (cond
      (er-is? st "punct" ">>")
      (do (er-advance! st) {:segments (list) :type "binary"})
      :else (let
        ((segs (list (er-parse-binary-segment st))))
        (er-parse-binary-tail st segs)))))

(define
  er-parse-binary-tail
  (fn
    (st segs)
    (cond
      (er-is? st "punct" ",")
      (do
        (er-advance! st)
        (append! segs (er-parse-binary-segment st))
        (er-parse-binary-tail st segs))
      (er-is? st "punct" ">>")
      (do (er-advance! st) {:segments segs :type "binary"})
      :else (error
        (str
          "Erlang parse: expected ',' or '>>' in binary, got '"
          (er-cur-value st)
          "'")))))

(define
  er-parse-binary-segment
  (fn
    (st)
    ;; Use `er-parse-primary` for the value so a leading `:` falls
    ;; through to the segment's size suffix instead of being eaten
    ;; by `er-parse-postfix-loop` as a `Mod:Fun` remote call.
    (let
      ((v (er-parse-primary st)))
      (let
        ((size (cond
                 (er-is? st "punct" ":")
                 (do (er-advance! st) (er-parse-primary st))
                 :else nil))
          (spec (cond
                  (er-is? st "op" "/")
                  (do
                    (er-advance! st)
                    (let
                      ((tok (er-cur st)))
                      (er-advance! st)
                      (get tok :value)))
                  :else "integer")))
        {:size size :spec spec :value v}))))