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

Add flat combinator

Browse Source
This commit is contained in:
Scott Richmond 2023-05-16 18:29:22 -04:00
parent cbd78ce7f7
commit 52abde501a
1 changed files with 26 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
src/ludus/parser-new.clj
View File

@ -13,7 +13,7 @@
(defn pass? [{status :status}] (contains? passing status)) (defn pass? [{status :status}] (contains? passing status))
(defn fail? [{status :status}] (conatins? failing status)) (defn fail? [{status :status}] (contains? failing status))
(defn data [{d :data}] d) (defn data [{d :data}] d)
@ -59,7 +59,7 @@
rem-ts (remaining result) rem-ts (remaining result)
rem-ps (rest ps)] rem-ps (rest ps)]
(cond (cond
(pass? result) (pass? result) ;result
{:status :ok :type name :data [result] :token (first tokens) :remaining rem-ts} {:status :ok :type name :data [result] :token (first tokens) :remaining rem-ts}
(= :err (:status result)) (= :err (:status result))
@ -86,9 +86,9 @@
(:ok :quiet :group) (:ok :quiet :group)
(loop [ps (rest parsers) (loop [ps (rest parsers)
results (case (:status first-result) results (case (:status first-result)
:ok [first-result] :ok [first-result]
:quiet [] :quiet []
:group (:data first-result)) :group (:data first-result))
ts (remaining first-result)] ts (remaining first-result)]
(let [result (apply-parser (first ps) ts) (let [result (apply-parser (first ps) ts)
res-rem (remaining result)] res-rem (remaining result)]
@ -164,13 +164,13 @@
:token (first tokens) :token (first tokens)
:remaining (remaining rest-result)}) :remaining (remaining rest-result)})
:quiet :quiet
(let [rest-result (apply-parser rest-parser (remaining first-result))] (let [rest-result (apply-parser rest-parser (remaining first-result))]
{:status :quiet {:status :quiet
:type name :type name
:data [] :data []
:token (first tokens) :token (first tokens)
:remaining (remaining rest-result)}) :remaining (remaining rest-result)})
(:err :none) first-result)))})) (:err :none) first-result)))}))
@ -185,6 +185,14 @@
{:status :group :type name :data [] :token (first tokens) :remaining tokens} {:status :group :type name :data [] :token (first tokens) :remaining tokens}
)))})) )))}))
(defn flat
([parser] (flat (pname parser) parser))
([name parser]
{:name (kw+str name "-flat")
:rule (fn flat-fn [tokens]
(let [result (apply-parser parser tokens)]
(if (pass? result) (first (:data result)) result)))}))
(comment (comment
" "
If I'm not mistaken, the Ludus grammer requires *no* lookahead, the first token in an expression tells you what kind of expression it is: If I'm not mistaken, the Ludus grammer requires *no* lookahead, the first token in an expression tells you what kind of expression it is:
@ -219,7 +227,7 @@
(declare expression) (declare expression)
(def literal (choice :literal [:nil :true :false :number :string])) (def literal (flat (choice :literal [:nil :true :false :number :string])))
(def separator (choice :separator [:comma :newline])) (def separator (choice :separator [:comma :newline]))
@ -257,7 +265,7 @@
(def splat (order :splat [(quiet :splat) :word])) (def splat (order :splat [(quiet :splat) :word]))
(def list-term (choice :list-term [splat expression])) (def list-term (flat (choice :list-term [splat expression])))
(def list-entry (order :list-entry [(quiet (one+ separator)) list-term])) (def list-entry (order :list-entry [(quiet (one+ separator)) list-term]))
@ -285,7 +293,7 @@
(def importt (order :import [(quiet :import) :string (quiet :as) :word])) (def importt (order :import [(quiet :import) :string (quiet :as) :word]))
(def toplevel (choice :toplevel [importt expression])) (def toplevel (flat (choice :toplevel [importt expression])))
(def script-line (order :script-line [(quiet terminator) toplevel])) (def script-line (order :script-line [(quiet terminator) toplevel]))
@ -293,7 +301,9 @@
(def eg (:tokens (scan/scan (def eg (:tokens (scan/scan
"" "1
2
3"
))) )))
eg eg