From f97453b8136860bf9774fd0ca22018279333d897 Mon Sep 17 00:00:00 2001 From: Scott Richmond Date: Thu, 18 May 2023 16:44:29 -0400 Subject: [PATCH] Complete parser & ludus grammar! --- src/ludus/grammar.clj | 280 +++++++++++++++++++++++++++++---------- src/ludus/parser_new.clj | 23 +++- 2 files changed, 227 insertions(+), 76 deletions(-) diff --git a/src/ludus/grammar.clj b/src/ludus/grammar.clj index abf1a71..23dc653 100644 --- a/src/ludus/grammar.clj +++ b/src/ludus/grammar.clj @@ -8,29 +8,78 @@ (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 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 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 - [(quiet :lparen) - (quiet (zero+ separator)) - (maybe pattern) - (zero+ tuple-pat-entry) - (quiet (zero+ separator)) - (quiet :rparen)]))) +(def tuple-pattern (group (order :tuple-pattern + [(quiet :lparen) + (quiet (zero+ separator)) + (maybe pattern) + tuple-pattern-entries + (quiet (zero+ separator)) + (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) nls? @@ -46,78 +95,96 @@ (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) (quiet (zero+ terminator)) cond-clause - (zero+ cond-entry) + cond-entries (quiet (zero+ terminator)) (quiet :rbrace)])) -(def lett (order :let [(quiet :let) - pattern - (quiet :equals) - nls? - expression])) +(def lett (group (order :let [(quiet :let) + pattern + (quiet :equals) + nls? + 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 - [(quiet :lparen) - (quiet (zero+ separator)) - (maybe expression) - (zero+ tuple-entry) - (quiet (zero+ separator)) - (quiet :rparen)])) +(def tuple-entries (entries :tuple-entries separator expression)) + +(def tuple (group (order :tuple + [(quiet :lparen) + (quiet (zero+ separator)) + (maybe expression) + tuple-entries + (quiet (zero+ separator)) + (quiet :rparen)]))) (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 - [(quiet :lbracket) - (quiet (zero+ separator)) - (maybe list-term) - (zero+ list-entry) - (quiet (zero+ separator)) - (quiet :rbracket)])) +(def list-entries (entries :list-entries separator list-term)) + +(def listt (group (order :list + [(quiet :lbracket) + (quiet (zero+ separator)) + (maybe list-term) + 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 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 - [(quiet :startstruct) - (quiet (zero+ separator)) - (maybe struct-term) - (zero+ struct-entry) - (quiet (zero+ separator)) - (quiet :rbrace)])) +(def struct-entries (entries :struct-entries separator struct-term)) + +(def structt (group (order :struct + [(quiet :startstruct) + (quiet (zero+ separator)) + (maybe struct-term) + struct-entries + (quiet (zero+ separator)) + (quiet :rbrace)]))) (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 - [(quiet :startdict) - (quiet (zero+ separator)) - (maybe dict-term) - (zero+ dict-entry) - (quiet (zero+ separator)) - (quiet :rbrace)])) +(def dict-entries (entries :dict-entries separator dict-term)) + +(def dict (group (order :dict + [(quiet :startdict) + (quiet (zero+ separator)) + (maybe dict-term) + dict-entries + (quiet (zero+ separator)) + (quiet :rbrace)]))) (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 [(quiet :lparen) (quiet (zero+ separator)) (maybe arg-expr) - (zero+ arg-entry) + arg-entries (quiet (zero+ separator)) (quiet :rparen)])) @@ -127,14 +194,18 @@ (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) + nls? (maybe :string) + nls? fn-clause - (zero+ fn-entry) + fn-entries nls? (quiet :rbrace) ]))) @@ -147,11 +218,68 @@ (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]))) @@ -164,19 +292,28 @@ (quiet (zero+ separator)) (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 +;;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 - " -add (1, 2) -fn foo { (_) -> (1, 2) }" + "receive { _ -> 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) -(def my-data (-> result clean tap)) +(def my-data (-> result + clean + tap + )) -my-data - -(def my-first (-> my-data first)) - -(def my-sec (map :data (-> my-data second :data))) - -(concat my-first my-sec) \ No newline at end of file +my-data \ No newline at end of file diff --git a/src/ludus/parser_new.clj b/src/ludus/parser_new.clj index d1a8f5c..8cef82b 100644 --- a/src/ludus/parser_new.clj +++ b/src/ludus/parser_new.clj @@ -28,6 +28,7 @@ (defn apply-kw-parser [kw tokens] (let [token (first tokens)] + (if (= kw (:type token)) (println "Matched " kw)) (if (= kw (:type token)) {:status :ok :type kw @@ -37,10 +38,12 @@ {:status :none :token token :trace [kw] :remaining (rest tokens)}))) (defn apply-fn-parser [parser tokens] - (let [rule (:rule parser) name (:name parser)] - (rule tokens))) + (let [rule (:rule parser) name (:name parser) result (rule tokens)] + (if (pass? result) (println "Matched " (:name parser))) + result)) (defn apply-parser [parser tokens] + (println "Applying parser " (? (:name parser) parser)) (cond (keyword? parser) (apply-kw-parser parser tokens) (:rule parser) (apply-fn-parser parser tokens) @@ -139,7 +142,11 @@ :group (recur (vec (concat results (:data result))) (remaining result)) :quiet (recur results (remaining result)) :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+ ([parser] (one+ (pname parser) parser)) @@ -196,6 +203,16 @@ (assoc result :status :ok) 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}] (println "Unexpected token " (:type token) " on line " (:line token)) (println "Expected token " (first trace)))