twc/ludus
4
0
Fork 0
Code Issues 32 Pull Requests Packages Projects 8 Releases Wiki Activity

Finally get it right?

Browse Source
This commit is contained in:
Scott Richmond 2023-05-20 14:18:30 -04:00
parent 4ea7a3a23d
commit 4fd593752b
2 changed files with 63 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
src/ludus/grammar.clj
View File

@ -22,7 +22,7 @@
(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
[(quiet :lparen)
@ -40,7 +40,7 @@
(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
[(quiet :startdict)
@ -63,7 +63,7 @@
(def match-clause (group (order-0 :match-clause
[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
[(quiet :match) expression nls?
@ -87,7 +87,7 @@
(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)
(quiet (zero+ terminator))
@ -100,7 +100,7 @@
nls?
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)
(quiet (zero+ separator))
@ -181,7 +181,7 @@
(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)
(quiet (zero+ terminator))
@ -251,7 +251,7 @@
(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?
(one+ script-line)
@ -260,20 +260,18 @@
;;;;;;;;;;;;;;;; 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: 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
"{1; 2; 3; (1, _)}"
"
test \"foo\" bar
"
)))
(def result (apply-parser block eg))
(def result (apply-parser script eg))
(defn report [node]

59
src/ludus/parser_new.clj
View File

@ -70,8 +70,7 @@
{:status :none :token (first tokens) :trace [name] :remaining rem-ts}
: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]
{:name name
:rule (fn order-fn [tokens]
@ -79,10 +78,7 @@
first-result (apply-parser (first parsers) tokens)]
(case (:status first-result)
(:err :none)
{:status :none
:token (first tokens)
:trace [name]
:remaining tokens}
(update (assoc first-result :trace #(conj % name)) :status :none)
(:ok :quiet :group)
(loop [ps (rest parsers)
@ -122,6 +118,7 @@
(vec (concat results (:data result)))
res-rem)
:quiet (recur (rest ps) results res-rem)
(:err :none)
(assoc (update result :trace #(conj % name)) :status :err))))))))})
@ -165,9 +162,55 @@
(vec (concat results (:data result)))
res-rem)
:quiet (recur (rest ps) results res-rem)
(:err :none)
(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]
{:name (kw+str (? (:name parser) parser) "-quiet")
:rule (fn quiet-fn [tokens]
@ -219,9 +262,7 @@
:token (first tokens)
:remaining (remaining rest-result)}
:err (update rest-result :trace #(conj % name)))
)
:err (update rest-result :trace #(conj % name))))
:quiet
(let [rest-result (apply-parser rest-parser (remaining first-result))]