Complete parser & ludus grammar!
This commit is contained in:
parent
23e29fdca2
commit
f97453b813
|
|
@ -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)
|
||||
|
|
@ -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)))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user