Finally get it right?
This commit is contained in:
parent
4ea7a3a23d
commit
4fd593752b
|
@ -22,7 +22,7 @@
|
||||||
|
|
||||||
(def tuple-pattern-term (flat (choice :tuple-pattern-term [pattern splattern])))
|
(def tuple-pattern-term (flat (choice :tuple-pattern-term [pattern splattern])))
|
||||||
|
|
||||||
(def tuple-pattern-entry (order-1 :tuple-pattern-entry [tuple-pattern-term (quiet (one+ separator))]))
|
(def tuple-pattern-entry (weak-order :tuple-pattern-entry [tuple-pattern-term separators]))
|
||||||
|
|
||||||
(def tuple-pattern (group (order-1 :tuple-pattern
|
(def tuple-pattern (group (order-1 :tuple-pattern
|
||||||
[(quiet :lparen)
|
[(quiet :lparen)
|
||||||
|
@ -40,7 +40,7 @@
|
||||||
|
|
||||||
(def dict-pattern-term (flat (choice :dict-pattern-term [pair-pattern :word splattern])))
|
(def dict-pattern-term (flat (choice :dict-pattern-term [pair-pattern :word splattern])))
|
||||||
|
|
||||||
(def dict-pattern-entry (order-1 :dict-pattern-entry [dict-pattern-term (quiet (one+ separator))]))
|
(def dict-pattern-entry (weak-order :dict-pattern-entry [dict-pattern-term separators]))
|
||||||
|
|
||||||
(def dict-pattern (group (order-1 :dict-pattern
|
(def dict-pattern (group (order-1 :dict-pattern
|
||||||
[(quiet :startdict)
|
[(quiet :startdict)
|
||||||
|
@ -63,7 +63,7 @@
|
||||||
(def match-clause (group (order-0 :match-clause
|
(def match-clause (group (order-0 :match-clause
|
||||||
[pattern (maybe constraint) (quiet :rarrow) expression])))
|
[pattern (maybe constraint) (quiet :rarrow) expression])))
|
||||||
|
|
||||||
(def match-entry (order-0 :match-entry [match-clause (quiet (one+ terminator))]))
|
(def match-entry (weak-order :match-entry [match-clause terminators]))
|
||||||
|
|
||||||
(def match (group (order-1 :match
|
(def match (group (order-1 :match
|
||||||
[(quiet :match) expression nls?
|
[(quiet :match) expression nls?
|
||||||
|
@ -87,7 +87,7 @@
|
||||||
|
|
||||||
(def cond-clause (group (order-0 :cond-clause [cond-lhs (quiet :rarrow) expression])))
|
(def cond-clause (group (order-0 :cond-clause [cond-lhs (quiet :rarrow) expression])))
|
||||||
|
|
||||||
(def cond-entry (order-0 :cond-entry [cond-clause (quiet (one+ terminator))]))
|
(def cond-entry (weak-order :cond-entry [cond-clause terminators]))
|
||||||
|
|
||||||
(def condd (order-1 :cond [(quiet :cond) (quiet :lbrace)
|
(def condd (order-1 :cond [(quiet :cond) (quiet :lbrace)
|
||||||
(quiet (zero+ terminator))
|
(quiet (zero+ terminator))
|
||||||
|
@ -100,7 +100,7 @@
|
||||||
nls?
|
nls?
|
||||||
expression])))
|
expression])))
|
||||||
|
|
||||||
(def tuple-entry (order-1 :tuple-entry [expression separators]))
|
(def tuple-entry (weak-order :tuple-entry [expression separators]))
|
||||||
|
|
||||||
(def tuple (group (order-1 :tuple [(quiet :lparen)
|
(def tuple (group (order-1 :tuple [(quiet :lparen)
|
||||||
(quiet (zero+ separator))
|
(quiet (zero+ separator))
|
||||||
|
@ -181,7 +181,7 @@
|
||||||
|
|
||||||
(def fnn (group (order-1 :fn [(quiet :fn) body])))
|
(def fnn (group (order-1 :fn [(quiet :fn) body])))
|
||||||
|
|
||||||
(def block-line (order-1 :block-line [expression terminators]))
|
(def block-line (weak-order :block-line [expression terminators]))
|
||||||
|
|
||||||
(def block (group (order-1 :block [(quiet :lbrace)
|
(def block (group (order-1 :block [(quiet :lbrace)
|
||||||
(quiet (zero+ terminator))
|
(quiet (zero+ terminator))
|
||||||
|
@ -251,7 +251,7 @@
|
||||||
|
|
||||||
(def toplevel (flat (choice :toplevel [importt nss expression testt])))
|
(def toplevel (flat (choice :toplevel [importt nss expression testt])))
|
||||||
|
|
||||||
(def script-line (order-0 :script-line [toplevel terminators]))
|
(def script-line (weak-order :script-line [toplevel terminators]))
|
||||||
|
|
||||||
(def script (order-0 :script [nls?
|
(def script (order-0 :script [nls?
|
||||||
(one+ script-line)
|
(one+ script-line)
|
||||||
|
@ -260,20 +260,18 @@
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;; REPL CRUFT
|
;;;;;;;;;;;;;;;; REPL CRUFT
|
||||||
|
|
||||||
;;TODO: improve current bug reporting in the parser
|
|
||||||
;; --e.g., give functions better names in the stack trace
|
|
||||||
;; --I think this might require a macro (::facepalm::)
|
|
||||||
;;TODO: fix forward declaration errors
|
;;TODO: fix forward declaration errors
|
||||||
;;TODO: in, e.g., script-line (repeated, separated entities -- zero/one+->order), order-0 gives an error before a closing token (in this case, :eof), because it's not a line; but using order-1 parses correctly but swallows orders further down. I need to revisit how no match vs. errors pass through the system, esp. the combination of repeats and orders
|
|
||||||
|
|
||||||
|
|
||||||
(def eg (:tokens (scan/scan
|
(def eg (:tokens (scan/scan
|
||||||
"{1; 2; 3; (1, _)}"
|
"
|
||||||
|
test \"foo\" bar
|
||||||
|
"
|
||||||
)))
|
)))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(def result (apply-parser block eg))
|
(def result (apply-parser script eg))
|
||||||
|
|
||||||
|
|
||||||
(defn report [node]
|
(defn report [node]
|
||||||
|
|
|
@ -70,8 +70,7 @@
|
||||||
{:status :none :token (first tokens) :trace [name] :remaining rem-ts}
|
{:status :none :token (first tokens) :trace [name] :remaining rem-ts}
|
||||||
|
|
||||||
:else (recur rem-ps)))))})
|
:else (recur rem-ps)))))})
|
||||||
;; TODO - figure out a scheme for zero and one lookahead
|
|
||||||
;; Lookahead isn't even the right term here
|
|
||||||
(defn order-1 [name parsers]
|
(defn order-1 [name parsers]
|
||||||
{:name name
|
{:name name
|
||||||
:rule (fn order-fn [tokens]
|
:rule (fn order-fn [tokens]
|
||||||
|
@ -79,10 +78,7 @@
|
||||||
first-result (apply-parser (first parsers) tokens)]
|
first-result (apply-parser (first parsers) tokens)]
|
||||||
(case (:status first-result)
|
(case (:status first-result)
|
||||||
(:err :none)
|
(:err :none)
|
||||||
{:status :none
|
(update (assoc first-result :trace #(conj % name)) :status :none)
|
||||||
:token (first tokens)
|
|
||||||
:trace [name]
|
|
||||||
:remaining tokens}
|
|
||||||
|
|
||||||
(:ok :quiet :group)
|
(:ok :quiet :group)
|
||||||
(loop [ps (rest parsers)
|
(loop [ps (rest parsers)
|
||||||
|
@ -122,6 +118,7 @@
|
||||||
(vec (concat results (:data result)))
|
(vec (concat results (:data result)))
|
||||||
res-rem)
|
res-rem)
|
||||||
:quiet (recur (rest ps) results res-rem)
|
:quiet (recur (rest ps) results res-rem)
|
||||||
|
|
||||||
(:err :none)
|
(:err :none)
|
||||||
(assoc (update result :trace #(conj % name)) :status :err))))))))})
|
(assoc (update result :trace #(conj % name)) :status :err))))))))})
|
||||||
|
|
||||||
|
@ -165,9 +162,55 @@
|
||||||
(vec (concat results (:data result)))
|
(vec (concat results (:data result)))
|
||||||
res-rem)
|
res-rem)
|
||||||
:quiet (recur (rest ps) results res-rem)
|
:quiet (recur (rest ps) results res-rem)
|
||||||
|
|
||||||
(:err :none)
|
(:err :none)
|
||||||
(assoc (update result :trace #(conj % name)) :status :err)))))))})
|
(assoc (update result :trace #(conj % name)) :status :err)))))))})
|
||||||
|
|
||||||
|
(defn weak-order [name parsers]
|
||||||
|
{:name name
|
||||||
|
:rule (fn order-fn [tokens]
|
||||||
|
(let [origin (first tokens)]
|
||||||
|
(loop [ps parsers
|
||||||
|
results []
|
||||||
|
ts tokens]
|
||||||
|
(let [result (apply-parser (first ps) ts)
|
||||||
|
res-rem (remaining result)]
|
||||||
|
(if (empty? (rest ps))
|
||||||
|
;; Nothing more: return
|
||||||
|
(case (:status result)
|
||||||
|
:ok {:status :group
|
||||||
|
:type name
|
||||||
|
:data (conj results result)
|
||||||
|
:token origin
|
||||||
|
:remaining res-rem}
|
||||||
|
|
||||||
|
:quiet {:status :group
|
||||||
|
:type name
|
||||||
|
:data results
|
||||||
|
:token origin
|
||||||
|
:remaining res-rem}
|
||||||
|
|
||||||
|
:group {:status :group
|
||||||
|
:type name
|
||||||
|
:data (vec (concat results (:data result)))
|
||||||
|
:token origin
|
||||||
|
:remaining res-rem}
|
||||||
|
|
||||||
|
(:err :none)
|
||||||
|
(update result :trace #(conj % name)))
|
||||||
|
|
||||||
|
;; Still parsers left in the vector: recur
|
||||||
|
(case (:status result)
|
||||||
|
:ok (recur (rest ps) (conj results result) res-rem)
|
||||||
|
:group (recur (rest ps)
|
||||||
|
(vec (concat results (:data result)))
|
||||||
|
res-rem)
|
||||||
|
:quiet (recur (rest ps) results res-rem)
|
||||||
|
|
||||||
|
(:err :none)
|
||||||
|
(update result :trace #(conj % name))))))))})
|
||||||
|
|
||||||
|
|
||||||
(defn quiet [parser]
|
(defn quiet [parser]
|
||||||
{:name (kw+str (? (:name parser) parser) "-quiet")
|
{:name (kw+str (? (:name parser) parser) "-quiet")
|
||||||
:rule (fn quiet-fn [tokens]
|
:rule (fn quiet-fn [tokens]
|
||||||
|
@ -219,9 +262,7 @@
|
||||||
:token (first tokens)
|
:token (first tokens)
|
||||||
:remaining (remaining rest-result)}
|
:remaining (remaining rest-result)}
|
||||||
|
|
||||||
:err (update rest-result :trace #(conj % name)))
|
:err (update rest-result :trace #(conj % name))))
|
||||||
|
|
||||||
)
|
|
||||||
|
|
||||||
:quiet
|
:quiet
|
||||||
(let [rest-result (apply-parser rest-parser (remaining first-result))]
|
(let [rest-result (apply-parser rest-parser (remaining first-result))]
|
||||||
|
|
Loading…
Reference in New Issue
Block a user