Finally get error handling right?

This commit is contained in:
Scott Richmond 2022-02-21 13:16:22 -05:00
parent a4cecc3d01
commit 9414109312

View File

@ -25,13 +25,24 @@
(defn- token-type [parser] (defn- token-type [parser]
(::token/type (current parser))) (::token/type (current parser)))
(defn- node-type [parser]
(get-in parser [::ast ::ast/type]))
;; some forward declarations ;; some forward declarations
(declare parse-expr) (declare parse-expr)
(declare parse-word) (declare parse-word)
;; handle some errors ;; handle some errors
(def sync-on #{
::token/newline
::token/semicolon
::token/comma
::token/rparen
::token/rbracket
::token/rbrace
})
(defn- sync [parser message origin end] (defn- sync [parser message origin end]
(println "Synching on " (current parser))
(let [poison { (let [poison {
::ast/type ::ast/poison ::ast/type ::ast/poison
:message message :message message
@ -45,17 +56,48 @@
(defn- poisoned? [parser] (defn- poisoned? [parser]
(= ::ast/poison (get-in parser [::ast ::ast/type]))) (= ::ast/poison (get-in parser [::ast ::ast/type])))
(defn- panic [parser message sync-on] (defn- panic
([parser message] (panic parser message sync-on))
([parser message sync-on]
(println "PANIC!!! in the parser") (println "PANIC!!! in the parser")
(let [origin (current parser)] (let [origin (current parser)]
(loop [parser parser] (loop [parser (advance parser)]
(let [ (let [
curr (current parser) curr (current parser)
type (::token/type curr) type (::token/type curr)
] ]
(if (or (= ::token/eof type) (contains? sync-on type)) (if (or (= ::token/eof type) (contains? sync-on type))
(sync parser message origin curr) (sync parser message origin curr)
(recur (advance parser))))))) (recur (advance parser))))))))
;; some helper functions
(defn- expect [tokens message parser]
(let [curr (current parser)
tokens (if (set? tokens) tokens #{tokens})
type (::token/type curr)]
(if (contains? tokens type)
(advance parser)
(-> parser
(advance)
(panic message tokens)))))
(defn- accept [tokens parser]
(let [curr (current parser)
tokens (if (set? tokens) tokens #{tokens})
type (::token/type curr)]
(if (contains? tokens type)
(advance parser)
parser)))
(defn- accept-many [tokens parser]
(let [tokens (if (set? tokens) tokens #{tokens})]
(loop [parser parser]
(let [
curr (current parser)
type (::token/type curr)]
(if (contains? tokens type)
(recur (advance parser))
parser)))))
;; various parsing functions ;; various parsing functions
(defn- parse-atom [parser] (defn- parse-atom [parser]
@ -89,31 +131,37 @@
(conj members member))) (conj members member)))
(defn- parse-tuple [parser] (defn- parse-tuple [parser]
(loop [parser (advance parser) (loop [
parser (accept-many #{::token/newline ::token/comma} (advance parser))
members [] members []
current_member nil] current_member nil
(let [curr (current parser)] ]
(case (::token/type curr) (let [
curr (current parser)
]
(case (token-type parser)
::token/rparen (let [ms (add-member members current_member)] ::token/rparen (let [ms (add-member members current_member)]
(assoc (advance parser) ::ast (assoc (advance parser) ::ast
{::ast/type ::ast/tuple {::ast/type ::ast/tuple
:length (count ms) :length (count ms)
:members ms})) :members ms}))
(::token/comma ::token/newline) (recur (advance parser) (add-member members current_member) nil)
(::token/comma ::token/newline)
(recur
(accept-many #{::token/comma ::token/newline} parser)
(add-member members current_member) nil)
(::token/rbrace ::token/rbracket)
(panic parser (str "Mismatched enclosure in tuple: " (::token/lexeme curr)))
(let [parsed (parse-expr parser)] (let [parsed (parse-expr parser)]
(if (poisoned? parsed)
(let [
panicked
(panic parser (get-in parsed [::ast :message]) #{::token/rparen})
]
(recur panicked members (::ast panicked))
)
(recur parsed members (::ast parsed)) (recur parsed members (::ast parsed))
) )
)
)))) )
)
)
)
(defn- parse-list [parser] (defn- parse-list [parser]
(loop [parser (advance parser) (loop [parser (advance parser)
@ -240,29 +288,6 @@
(assoc ::ast {::ast/type ::ast/poison :message "Expected pattern"})) (assoc ::ast {::ast/type ::ast/poison :message "Expected pattern"}))
))) )))
(defn- expect [token message parser]
(let [curr (current parser)
type (::token/type curr)]
(if (= type token)
(advance parser)
(-> parser
(advance)
(panic message #{token})))))
(defn- accept [token parser]
(let [curr (current parser)
type (::token/type curr)]
(if (= type token)
(advance parser)
parser)))
(defn- accept-many [token parser]
(loop [curr (current parser)]
(let [type (::token/type curr)]
(if (= type token)
(recur (advance parser))
parser))))
(defn- parse-let-expr [parser pattern] (defn- parse-let-expr [parser pattern]
(let [expr (parse-expr parser)] (let [expr (parse-expr parser)]
(assoc expr ::ast {::ast/type ::ast/let (assoc expr ::ast {::ast/type ::ast/let
@ -364,15 +389,14 @@
(do (do
(def pp pp/pprint) (def pp pp/pprint)
(def source "(12, 43, arf@) (def source "(1, 2, (},; 4, 123^)")
")
(def lexed (scanner/scan source)) (def lexed (scanner/scan source))
(def tokens (:tokens lexed)) (def tokens (:tokens lexed))
(def p (parser tokens)) (def p (parser tokens))
(-> p (-> p
(parse-script) (parse-script)
(::ast) (::errors)
(pp) (pp)
) )
) )