coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions 8 Packages Projects Releases Wiki Activity
Files
4ed7ffe9dd974efa82080db041688630b8dd0529
rose-ash/lib/erlang/parser-expr.sx
giles 99753580b4 Recover agent-loop progress: lua/prolog/forth/erlang/haskell phases 1-2 
Salvaged from worktree-agent-* branches killed during sx-tree MCP outage:
- lua: tokenizer + parser + phase-2 transpile (~157 tests)
- prolog: tokenizer + parser + unification (72 tests, plan update lost to WIP)
- forth: phase-1 reader/interpreter + phase-2 colon/VARIABLE (134 tests)
- erlang: tokenizer + parser (114 tests)
- haskell: tokenizer + parse tests (43 tests)

Cherry-picked file contents only, not branch history, to avoid pulling in
unrelated ocaml-vm merge commits that were in those branches' bases.
2026-04-24 16:03:00 +00:00

535 lines
15 KiB
Plaintext
Raw Blame History

;; 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)
: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" "[")
(if
(er-is? st "punct" "]")
(do (er-advance! st) {:type "nil"})
(let
((elems (list (er-parse-expr-prec st 0))))
(er-parse-list-tail st elems)))))
(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}))))))
Reference in New Issue View Git Blame Copy Permalink