giles
ce8ff8b738
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
641 lines
18 KiB
Plaintext
641 lines
18 KiB
Plaintext
;; 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}))))
|