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

Complete parser & ludus grammar!

Browse Source
This commit is contained in:
Scott Richmond 2023-05-18 16:44:29 -04:00
parent 23e29fdca2
commit f97453b813
2 changed files with 227 additions and 76 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

280
src/ludus/grammar.clj
View File

@ -8,29 +8,78 @@
(def terminator (choice :terminator [:newline :semicolon])) (def terminator (choice :terminator [:newline :semicolon]))
(defn entries [name sep parser]
(zero+ (weak (order name [(quiet (one+ sep)) parser]))))
(def nls? (quiet (zero+ :nls :newline))) (def nls? (quiet (zero+ :nls :newline)))
(def splat (group (order :splat [(quiet :splat) :word]))) (def splat (group (order :splat [(quiet :splat) :word])))
(def splattern (group (order :splat [(quiet :splattern) (flat (choice :splatted [:word :ignored :placeholder]))]))) (def splattern (group (order :splat [(quiet :splat) (flat (choice :splatted [:word :ignored :placeholder]))])))
(def literal (flat (choice :literal [:nil :true :false :number :string]))) (def literal (flat (choice :literal [:nil :true :false :number :string])))
(def tuple-pat-term (choice :tuple-pat-term [pattern splattern])) (def tuple-pattern-term (choice :tuple-pattern-term [pattern splattern]))
(def tuple-pat-entry (order :tuple-pat-enry [(quiet (one+ separator)) pattern])) (def tuple-pattern-entries (entries :tuple-pattern-enries separator pattern))
(def tuple-pat (group (order :tuple-pat (def tuple-pattern (group (order :tuple-pattern
[(quiet :lparen) [(quiet :lparen)
(quiet (zero+ separator)) (quiet (zero+ separator))
(maybe pattern) (maybe pattern)
(zero+ tuple-pat-entry) tuple-pattern-entries
(quiet (zero+ separator)) (quiet (zero+ separator))
(quiet :rparen)]))) (quiet :rparen)])))
;; TODO: list, dict, struct patterns (def list-pattern (group (order :list-pattern
[(quiet :lbracket)
(quiet (zero+ separator))
(maybe pattern)
tuple-pattern-entries
(quiet (zero+ separator))
(quiet :rbracket)])))
(def pattern (choice :pattern [:literal :ignored :placeholder :word :keyword tuple-pat])) (def pair-pattern (order :pair-pattern [:keyword pattern]))
(def dict-pattern-term (flat (choice :dict-pattern-term [pair-pattern :word splattern])))
(def dict-pattern-entries (entries :dict-pattern-entries separator dict-pattern-term))
(def dict-pattern (group (order :dict-pattern
[(quiet :startdict)
(quiet (zero+ separator))
(maybe dict-pattern-term)
dict-pattern-entries
(quiet (zero+ separator))
(quiet :rbrace)
])))
(def struct-pattern (group (order :struct-pattern
[(quiet :startstruct)
(quiet (zero+ separator))
(maybe dict-pattern-term)
dict-pattern-entries
(quiet (zero+ separator))
(quiet :rbrace)
])))
(def constraint (order :constraint [:when expression]))
(def pattern (choice :pattern [literal :ignored :placeholder :word :keyword tuple-pattern dict-pattern struct-pattern list-pattern]))
(def match-clause (group (order :match-clause
[pattern (maybe constraint) (quiet :rarrow) expression])))
(def match-entries (entries :match-entries terminator match-clause))
(def match (group (order :match
[(quiet :match) expression nls?
(quiet :with) (quiet :lbrace) nls?
match-clause
match-entries
nls?
(quiet :rbrace)
])))
(def iff (order :if [(quiet :if) (def iff (order :if [(quiet :if)
nls? nls?
@ -46,78 +95,96 @@
(def cond-clause (group (order :cond-clause [cond-lhs (quiet :rarrow) expression]))) (def cond-clause (group (order :cond-clause [cond-lhs (quiet :rarrow) expression])))
(def cond-entry (order :cond-entry [(quiet (one+ terminator)) cond-clause])) (def cond-entries (entries :cond-entries terminator cond-clause))
(def condd (order :cond [(quiet :cond) (quiet :lbrace) (def condd (order :cond [(quiet :cond) (quiet :lbrace)
(quiet (zero+ terminator)) (quiet (zero+ terminator))
cond-clause cond-clause
(zero+ cond-entry) cond-entries
(quiet (zero+ terminator)) (quiet (zero+ terminator))
(quiet :rbrace)])) (quiet :rbrace)]))
(def lett (order :let [(quiet :let) (def lett (group (order :let [(quiet :let)
pattern pattern
(quiet :equals) (quiet :equals)
nls? nls?
expression])) expression])))
(def tuple-entry (order :tuple-entry [(quiet (one+ separator)) expression])) (def tuple-entry (weak (order :tuple-entry [(quiet (one+ separator)) expression])))
(def tuple (order :tuple (def tuple-entries (entries :tuple-entries separator expression))
[(quiet :lparen)
(quiet (zero+ separator)) (def tuple (group (order :tuple
(maybe expression) [(quiet :lparen)
(zero+ tuple-entry) (quiet (zero+ separator))
(quiet (zero+ separator)) (maybe expression)
(quiet :rparen)])) tuple-entries
(quiet (zero+ separator))
(quiet :rparen)])))
(def list-term (flat (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 (weak (order :list-entry [(quiet (one+ separator)) list-term])))
(def listt (order :list (def list-entries (entries :list-entries separator list-term))
[(quiet :lbracket)
(quiet (zero+ separator)) (def listt (group (order :list
(maybe list-term) [(quiet :lbracket)
(zero+ list-entry) (quiet (zero+ separator))
(quiet (zero+ separator)) (maybe list-term)
(quiet :rbracket)])) list-entries
(quiet (zero+ separator))
(quiet :rbracket)])))
(def sett (group (order :set [
(quiet :startset)
(quiet (zero+ separator))
(maybe list-term)
list-entries
(quiet (zero+ separator))
(quiet :rbrace)])))
(def pair (group (order :pair [:keyword expression]))) (def pair (group (order :pair [:keyword expression])))
(def struct-term (flat (choice :struct-term [:word pair]))) (def struct-term (flat (choice :struct-term [:word pair])))
(def struct-entry (order :struct-entry [(quiet (one+ separator)) struct-term])) (def struct-entry (weak (order :struc-entry [(quiet (one+ separator)) struct-term])))
(def structt (order :struct (def struct-entries (entries :struct-entries separator struct-term))
[(quiet :startstruct)
(quiet (zero+ separator)) (def structt (group (order :struct
(maybe struct-term) [(quiet :startstruct)
(zero+ struct-entry) (quiet (zero+ separator))
(quiet (zero+ separator)) (maybe struct-term)
(quiet :rbrace)])) struct-entries
(quiet (zero+ separator))
(quiet :rbrace)])))
(def dict-term (flat (choice :dict-term [:word pair splat]))) (def dict-term (flat (choice :dict-term [:word pair splat])))
(def dict-entry (order :dict-entry [(quiet (one+ separator)) dict-term])) (def dict-entry (weak (order :dict-entry [(quiet (one+ separator)) dict-term])))
(def dict (order :dict (def dict-entries (entries :dict-entries separator dict-term))
[(quiet :startdict)
(quiet (zero+ separator)) (def dict (group (order :dict
(maybe dict-term) [(quiet :startdict)
(zero+ dict-entry) (quiet (zero+ separator))
(quiet (zero+ separator)) (maybe dict-term)
(quiet :rbrace)])) dict-entries
(quiet (zero+ separator))
(quiet :rbrace)])))
(def arg-expr (flat (choice :arg-expr [:placeholder expression]))) (def arg-expr (flat (choice :arg-expr [:placeholder expression])))
(def arg-entry (order :arg-entry [(quiet (one+ separator)) arg-expr])) (def arg-entry (weak (order :arg-entry [(quiet (one+ separator)) arg-expr])))
(def arg-entries (entries :arg-entries separator arg-expr))
(def arg-tuple (order :arg-tuple (def arg-tuple (order :arg-tuple
[(quiet :lparen) [(quiet :lparen)
(quiet (zero+ separator)) (quiet (zero+ separator))
(maybe arg-expr) (maybe arg-expr)
(zero+ arg-entry) arg-entries
(quiet (zero+ separator)) (quiet (zero+ separator))
(quiet :rparen)])) (quiet :rparen)]))
@ -127,14 +194,18 @@
(def synthetic (order :synthetic [synth-root (zero+ synth-term)])) (def synthetic (order :synthetic [synth-root (zero+ synth-term)]))
(def fn-clause (group (order :fn-clause [tuple-pat (quiet :rarrow) expression]))) (def fn-clause (group (order :fn-clause [tuple-pattern (maybe constraint) (quiet :rarrow) expression])))
(def fn-entry (order :fn-entry [(quiet (one+ terminator)) fn-clause])) (def fn-entry (weak (order :fn-entry [(quiet (one+ terminator)) fn-clause])))
(def fn-entries (entries :fn-entries terminator fn-clause))
(def compound (group (order :compound [(quiet :lbrace) (def compound (group (order :compound [(quiet :lbrace)
nls?
(maybe :string) (maybe :string)
nls?
fn-clause fn-clause
(zero+ fn-entry) fn-entries
nls? nls?
(quiet :rbrace) (quiet :rbrace)
]))) ])))
@ -147,11 +218,68 @@
(def fnn (group (order :fn [(quiet :fn) body]))) (def fnn (group (order :fn [(quiet :fn) body])))
(def block-line (order :block-line [(quiet terminator) expression])) (def block-lines (entries :block-lines terminator expression))
(def block (group (order :block [(quiet :lbrace) nls? expression (zero+ block-line) nls? (quiet :rbrace)]))) (def block (group (order :block [(quiet :lbrace)
nls?
expression
block-lines
nls? (quiet :rbrace)])))
(def expression (flat (choice :expression [fnn lett iff condd synthetic block structt listt tuple literal]))) (def pipeline (order :pipeline [nls? :pipeline]))
(def do-entry (weak (order :do-entry [pipeline expression])))
(def doo (group (order :do [
(quiet :do)
expression
(one+ do-entry)
])))
(def reff (group (order :ref [(quiet :ref) :word (quiet :equals) expression])))
(def spawn (group (order :spawn [(quiet :spawn) expression])))
(def receive (group (order :receive
[(quiet :receive) (quiet :lbrace) nls?
match-clause
match-entries
nls?
(quiet :rbrace)
])))
(def compound-loop (group (order :compound-loop
[(quiet :lbrace)
nls?
fn-clause
fn-entries
nls?
(quiet :rbrace)])))
(def loopp (group (order :loop
[(quiet :loop) tuple (quiet :with)
(flat (choice :loop-body [fn-clause compound-loop]))])))
(def expression (flat (choice :expression [fnn
match
loopp
lett
iff
condd
spawn
receive
synthetic
block
doo
reff
structt
dict
listt
sett
tuple
literal])))
(def test (group (order :test [(quiet :test) :string expression])))
(def importt (group (order :import [(quiet :import) :string (quiet :as) :word]))) (def importt (group (order :import [(quiet :import) :string (quiet :as) :word])))
@ -164,19 +292,28 @@
(quiet (zero+ separator)) (quiet (zero+ separator))
(quiet :rbrace)]))) (quiet :rbrace)])))
(def toplevel (flat (choice :toplevel [importt nss expression]))) (def toplevel (flat (choice :toplevel [importt nss expression test])))
(def script-line (order :script-line [(quiet (one+ terminator)) toplevel])) (def script-lines (entries :script-lines terminator toplevel))
(def script (order :script [nls? toplevel (zero+ script-line) nls? (quiet :eof)])) (def script (order :script [nls?
toplevel
script-lines
nls?
(quiet :eof)]))
;;;;;;;;;;;;;;;; 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
(def eg (:tokens (scan/scan (def eg (:tokens (scan/scan
" "receive { _ -> 1; () -> 2 }
add (1, 2) "
fn foo { (_) -> (1, 2) }"
))) )))
@ -201,12 +338,9 @@ fn foo { (_) -> (1, 2) }"
(defn tap [x] (println "\n\n\n\n******NEW PARSE\n\n:::=> " x "\n\n") x) (defn tap [x] (println "\n\n\n\n******NEW PARSE\n\n:::=> " x "\n\n") x)
(def my-data (-> result clean tap)) (def my-data (-> result
clean
tap
))
my-data my-data
(def my-first (-> my-data first))
(def my-sec (map :data (-> my-data second :data)))
(concat my-first my-sec)

23
src/ludus/parser_new.clj
View File

@ -28,6 +28,7 @@
(defn apply-kw-parser [kw tokens] (defn apply-kw-parser [kw tokens]
(let [token (first tokens)] (let [token (first tokens)]
(if (= kw (:type token)) (println "Matched " kw))
(if (= kw (:type token)) (if (= kw (:type token))
{:status :ok {:status :ok
:type kw :type kw
@ -37,10 +38,12 @@
{:status :none :token token :trace [kw] :remaining (rest tokens)}))) {:status :none :token token :trace [kw] :remaining (rest tokens)})))
(defn apply-fn-parser [parser tokens] (defn apply-fn-parser [parser tokens]
(let [rule (:rule parser) name (:name parser)] (let [rule (:rule parser) name (:name parser) result (rule tokens)]
(rule tokens))) (if (pass? result) (println "Matched " (:name parser)))
result))
(defn apply-parser [parser tokens] (defn apply-parser [parser tokens]
(println "Applying parser " (? (:name parser) parser))
(cond (cond
(keyword? parser) (apply-kw-parser parser tokens) (keyword? parser) (apply-kw-parser parser tokens)
(:rule parser) (apply-fn-parser parser tokens) (:rule parser) (apply-fn-parser parser tokens)
@ -139,7 +142,11 @@
:group (recur (vec (concat results (:data result))) (remaining result)) :group (recur (vec (concat results (:data result))) (remaining result))
:quiet (recur results (remaining result)) :quiet (recur results (remaining result))
:err (update result :trace #(conj % name)) :err (update result :trace #(conj % name))
{:status :group :type name :data results :token (first tokens) :remaining ts}))))})) :none {:status :group
:type name
:data results
:token (first tokens)
:remaining ts}))))}))
(defn one+ (defn one+
([parser] (one+ (pname parser) parser)) ([parser] (one+ (pname parser) parser))
@ -196,6 +203,16 @@
(assoc result :status :ok) (assoc result :status :ok)
result)))})) result)))}))
(defn weak
([parser] (weak (pname parser) parser))
([name parser]
{:name (kw+str name "-weak")
:rule (fn weak-fn [tokens]
(let [result (apply-parser parser tokens)]
(if (= :err (:status result))
(assoc result :status :none)
result)))}))
(defn err-msg [{token :token trace :trace}] (defn err-msg [{token :token trace :trace}]
(println "Unexpected token " (:type token) " on line " (:line token)) (println "Unexpected token " (:type token) " on line " (:line token))
(println "Expected token " (first trace))) (println "Expected token " (first trace)))