Finally get error handling right?
This commit is contained in:
parent
a4cecc3d01
commit
9414109312
|
@ -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)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user