From a7ab313a5f20ccc6b5d08ca622440e5fb6153b17 Mon Sep 17 00:00:00 2001 From: Scott Richmond Date: Tue, 16 May 2023 20:54:01 -0400 Subject: [PATCH] Broken! Argh. --- src/ludus/grammar.clj | 212 +++++++++++++++++++ src/ludus/{parser-new.clj => parser_new.clj} | 143 ++----------- 2 files changed, 231 insertions(+), 124 deletions(-) create mode 100644 src/ludus/grammar.clj rename src/ludus/{parser-new.clj => parser_new.clj} (68%) diff --git a/src/ludus/grammar.clj b/src/ludus/grammar.clj new file mode 100644 index 0000000..abf1a71 --- /dev/null +++ b/src/ludus/grammar.clj @@ -0,0 +1,212 @@ +(ns ludus.grammar + (:require [ludus.parser-new :refer :all] + [ludus.scanner :as scan])) + +(declare expression pattern) + +(def separator (choice :separator [:comma :newline])) + +(def terminator (choice :terminator [:newline :semicolon])) + +(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 literal (flat (choice :literal [:nil :true :false :number :string]))) + +(def tuple-pat-term (choice :tuple-pat-term [pattern splattern])) + +(def tuple-pat-entry (order :tuple-pat-enry [(quiet (one+ 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)]))) + +;; TODO: list, dict, struct patterns + +(def pattern (choice :pattern [:literal :ignored :placeholder :word :keyword tuple-pat])) + +(def iff (order :if [(quiet :if) + nls? + expression + nls? + (quiet :then) + expression + nls? + (quiet :else) + expression])) + +(def cond-lhs (flat (choice :cond-lhs [expression :placeholder :else]))) + +(def cond-clause (group (order :cond-clause [cond-lhs (quiet :rarrow) expression]))) + +(def cond-entry (order :cond-entry [(quiet (one+ terminator)) cond-clause])) + +(def condd (order :cond [(quiet :cond) (quiet :lbrace) + (quiet (zero+ terminator)) + cond-clause + (zero+ cond-entry) + (quiet (zero+ terminator)) + (quiet :rbrace)])) + +(def lett (order :let [(quiet :let) + pattern + (quiet :equals) + nls? + expression])) + +(def tuple-entry (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 list-term (flat (choice :list-term [splat expression]))) + +(def list-entry (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 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 structt (order :struct + [(quiet :startstruct) + (quiet (zero+ separator)) + (maybe struct-term) + (zero+ struct-entry) + (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 (order :dict + [(quiet :startdict) + (quiet (zero+ separator)) + (maybe dict-term) + (zero+ dict-entry) + (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-tuple (order :arg-tuple + [(quiet :lparen) + (quiet (zero+ separator)) + (maybe arg-expr) + (zero+ arg-entry) + (quiet (zero+ separator)) + (quiet :rparen)])) + +(def synth-root (choice :synth-root [:keyword :word :recur])) + +(def synth-term (choice :synth-term [arg-tuple :keyword])) + +(def synthetic (order :synthetic [synth-root (zero+ synth-term)])) + +(def fn-clause (group (order :fn-clause [tuple-pat (quiet :rarrow) expression]))) + +(def fn-entry (order :fn-entry [(quiet (one+ terminator)) fn-clause])) + +(def compound (group (order :compound [(quiet :lbrace) + (maybe :string) + fn-clause + (zero+ fn-entry) + nls? + (quiet :rbrace) + ]))) + +(def clauses (flat (choice :clauses [compound fn-clause]))) + +(def named (group (order :named [:word clauses]))) + +(def body (flat (choice :body [fn-clause named]))) + +(def fnn (group (order :fn [(quiet :fn) body]))) + +(def block-line (order :block-line [(quiet terminator) expression])) + +(def block (group (order :block [(quiet :lbrace) nls? expression (zero+ block-line) nls? (quiet :rbrace)]))) + +(def expression (flat (choice :expression [fnn lett iff condd synthetic block structt listt tuple literal]))) + +(def importt (group (order :import [(quiet :import) :string (quiet :as) :word]))) + +(def nss (group (order :nss [(quiet :ns) + :word + (quiet :lbrace) + (quiet (zero+ separator)) + (maybe struct-term) + (zero+ struct-entry) + (quiet (zero+ separator)) + (quiet :rbrace)]))) + +(def toplevel (flat (choice :toplevel [importt nss expression]))) + +(def script-line (order :script-line [(quiet (one+ terminator)) toplevel])) + +(def script (order :script [nls? toplevel (zero+ script-line) nls? (quiet :eof)])) + + +;;;;;;;;;;;;;;;; REPL CRUFT + +(def eg (:tokens (scan/scan + " +add (1, 2) +fn foo { (_) -> (1, 2) }" + ))) + + + +(def result (apply-parser script eg)) + + +(defn report [node] + (when (fail? node) (err-msg node)) + node) + +(defn clean [node] + (if (map? node) + (-> node + (report) + (dissoc + :status + :remaining + :token) + (update :data #(into [] (map clean) %))) + node)) + +(defn tap [x] (println "\n\n\n\n******NEW PARSE\n\n:::=> " x "\n\n") x) + +(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 diff --git a/src/ludus/parser-new.clj b/src/ludus/parser_new.clj similarity index 68% rename from src/ludus/parser-new.clj rename to src/ludus/parser_new.clj index f2af225..d1a8f5c 100644 --- a/src/ludus/parser-new.clj +++ b/src/ludus/parser_new.clj @@ -1,6 +1,4 @@ -(ns ludus.parser-new - (:require - [ludus.scanner :as scan])) +(ns ludus.parser-new) (defn ? [val default] (if (nil? val) default val)) @@ -30,7 +28,6 @@ (defn apply-kw-parser [kw tokens] (let [token (first tokens)] - ;(println "applying kw parser " kw " to " token) (if (= kw (:type token)) {:status :ok :type kw @@ -40,8 +37,7 @@ {:status :none :token token :trace [kw] :remaining (rest tokens)}))) (defn apply-fn-parser [parser tokens] - (let [rule (:rule parser) name (:name parser)] - ;(println "appying fn parser " name " to " (first tokens)) + (let [rule (:rule parser) name (:name parser)] (rule tokens))) (defn apply-parser [parser tokens] @@ -53,13 +49,12 @@ (defn choice [name parsers] {:name name :rule (fn choice-fn [tokens] - ;(println "entering CHOICE" name) (loop [ps parsers] (let [result (apply-parser (first ps) tokens) rem-ts (remaining result) rem-ps (rest ps)] (cond - (pass? result) ;result + (pass? result) {:status :ok :type name :data [result] :token (first tokens) :remaining rem-ts} (= :err (:status result)) @@ -72,8 +67,7 @@ (defn order [name parsers] {:name name - :rule (fn order-fn [tokens] - ;(println "entering ORDER" name) + :rule (fn order-fn [tokens] (let [origin (first tokens) first-result (apply-parser (first parsers) tokens)] (case (:status first-result) @@ -137,15 +131,14 @@ ([name parser] {:name (kw+str name "-zero+") :rule (fn zero+fn [tokens] - ;(println "entering ZERO+") (loop [results [] ts tokens] - ;(println "looping ZERO+" (? (:name parser) parser)) (let [result (apply-parser parser ts)] (case (:status result) :ok (recur (conj results result) (remaining result)) :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}))))})) (defn one+ @@ -193,6 +186,20 @@ (let [result (apply-parser parser tokens)] (if (pass? result) (first (:data result)) result)))})) +(defn group + ([parser] (group (pname parser) parser)) + ([name parser] + {:name (kw+str name "-group") + :rule (fn group-fn [tokens] + (let [result (apply-parser parser tokens)] + (if (= :group (:status result)) + (assoc result :status :ok) + result)))})) + +(defn err-msg [{token :token trace :trace}] + (println "Unexpected token " (:type token) " on line " (:line token)) + (println "Expected token " (first trace))) + (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: @@ -225,115 +232,3 @@ ") -(declare expression) - -(def literal (flat (choice :literal [:nil :true :false :number :string]))) - -(def separator (choice :separator [:comma :newline])) - -(def nls? (quiet (zero+ :nls :newline))) - -(def pattern (choice :pattern [:literal :word])) ;; stupid to start - -(def iff (order :iff [ - (quiet :if) - nls? - expression - nls? - (quiet :then) - expression - nls? - (quiet :else) - expression])) - -(def lett (order :let [ - (quiet :let) - pattern - (quiet :equals) - nls? - expression])) - -(def tuple-entry (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 splat (order :splat [(quiet :splat) :word])) - -(def list-term (flat (choice :list-term [splat expression]))) - -(def list-entry (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 synth-root (choice :synth-root [:keyword :word])) - -(def synth-term (choice :synth-term [tuple :keyword])) - -(def synthetic (order :synthetic [synth-root (zero+ synth-term)])) - -(def terminator (choice :terminator [:newline :semicolon])) - -(def block-line (order :block-line [(quiet terminator) expression])) - -(def block (order :block [(quiet :lbrace) nls? expression (zero+ block-line) nls? (quiet :rbrace)])) - -(def expression (choice :expression [lett iff synthetic block listt tuple literal])) - -(def importt (order :import [(quiet :import) :string (quiet :as) :word])) - -(def toplevel (flat (choice :toplevel [importt expression]))) - -(def script-line (order :script-line [(quiet terminator) toplevel])) - -(def script (order :script [nls? toplevel (zero+ script-line) nls? (quiet :eof)])) - - -(def eg (:tokens (scan/scan - "1 - 2 - 3" - ))) - -eg - -(println eg) - -(def result (apply-parser script eg)) - -result - -(println result) - -(defn clean [node] - (if (map? node) - (-> node - (dissoc - :status - :remaining - :token) - (update :data #(into [] (map clean) %))) - node)) - -(defn tap [x] (println "\n\n\n\n******NEW PARSE\n\n:::=> " x "\n\n") x) - -(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