Keep grinding; problems now with order/repeats
This commit is contained in:
parent
f97453b813
commit
4ea7a3a23d
|
@ -4,84 +4,76 @@
|
||||||
|
|
||||||
(declare expression pattern)
|
(declare expression pattern)
|
||||||
|
|
||||||
(def separator (choice :separator [:comma :newline]))
|
(def separator (choice :separator [:comma :newline :break]))
|
||||||
|
|
||||||
(def terminator (choice :terminator [:newline :semicolon]))
|
(def separators (quiet (one+ separator)))
|
||||||
|
|
||||||
(defn entries [name sep parser]
|
(def terminator (choice :terminator [:newline :semicolon :break]))
|
||||||
(zero+ (weak (order name [(quiet (one+ sep)) parser]))))
|
|
||||||
|
(def terminators (quiet (one+ terminator)))
|
||||||
|
|
||||||
(def nls? (quiet (zero+ :nls :newline)))
|
(def nls? (quiet (zero+ :nls :newline)))
|
||||||
|
|
||||||
(def splat (group (order :splat [(quiet :splat) :word])))
|
(def splat (group (order-1 :splat [(quiet :splat) :word])))
|
||||||
|
|
||||||
(def splattern (group (order :splat [(quiet :splat) (flat (choice :splatted [:word :ignored :placeholder]))])))
|
(def splattern (group (order-1 :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-pattern-term (choice :tuple-pattern-term [pattern splattern]))
|
(def tuple-pattern-term (flat (choice :tuple-pattern-term [pattern splattern])))
|
||||||
|
|
||||||
(def tuple-pattern-entries (entries :tuple-pattern-enries separator pattern))
|
(def tuple-pattern-entry (order-1 :tuple-pattern-entry [tuple-pattern-term (quiet (one+ separator))]))
|
||||||
|
|
||||||
(def tuple-pattern (group (order :tuple-pattern
|
(def tuple-pattern (group (order-1 :tuple-pattern
|
||||||
[(quiet :lparen)
|
[(quiet :lparen)
|
||||||
(quiet (zero+ separator))
|
(quiet (zero+ separator))
|
||||||
(maybe pattern)
|
(zero+ tuple-pattern-entry)
|
||||||
tuple-pattern-entries
|
|
||||||
(quiet (zero+ separator))
|
|
||||||
(quiet :rparen)])))
|
(quiet :rparen)])))
|
||||||
|
|
||||||
(def list-pattern (group (order :list-pattern
|
(def list-pattern (group (order-1 :list-pattern
|
||||||
[(quiet :lbracket)
|
[(quiet :lbracket)
|
||||||
(quiet (zero+ separator))
|
(quiet (zero+ separator))
|
||||||
(maybe pattern)
|
(zero+ tuple-pattern-entry)
|
||||||
tuple-pattern-entries
|
|
||||||
(quiet (zero+ separator))
|
|
||||||
(quiet :rbracket)])))
|
(quiet :rbracket)])))
|
||||||
|
|
||||||
(def pair-pattern (order :pair-pattern [:keyword pattern]))
|
(def pair-pattern (order-0 :pair-pattern [:keyword pattern]))
|
||||||
|
|
||||||
(def dict-pattern-term (flat (choice :dict-pattern-term [pair-pattern :word splattern])))
|
(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-entry (order-1 :dict-pattern-entry [dict-pattern-term (quiet (one+ separator))]))
|
||||||
|
|
||||||
(def dict-pattern (group (order :dict-pattern
|
(def dict-pattern (group (order-1 :dict-pattern
|
||||||
[(quiet :startdict)
|
[(quiet :startdict)
|
||||||
(quiet (zero+ separator))
|
(quiet (zero+ separator))
|
||||||
(maybe dict-pattern-term)
|
(zero+ dict-pattern-entry)
|
||||||
dict-pattern-entries
|
|
||||||
(quiet (zero+ separator))
|
|
||||||
(quiet :rbrace)
|
(quiet :rbrace)
|
||||||
])))
|
])))
|
||||||
|
|
||||||
(def struct-pattern (group (order :struct-pattern
|
(def struct-pattern (group (order-1 :struct-pattern
|
||||||
[(quiet :startstruct)
|
[(quiet :startstruct)
|
||||||
(quiet (zero+ separator))
|
(quiet (zero+ separator))
|
||||||
(maybe dict-pattern-term)
|
(zero+ dict-pattern-entry)
|
||||||
dict-pattern-entries
|
|
||||||
(quiet (zero+ separator))
|
|
||||||
(quiet :rbrace)
|
(quiet :rbrace)
|
||||||
])))
|
])))
|
||||||
|
|
||||||
(def constraint (order :constraint [:when expression]))
|
(def constraint (order-0 :constraint [(quiet :when) expression]))
|
||||||
|
|
||||||
(def pattern (choice :pattern [literal :ignored :placeholder :word :keyword tuple-pattern dict-pattern struct-pattern list-pattern]))
|
(def pattern (choice :pattern [literal :ignored :placeholder :word :keyword tuple-pattern dict-pattern struct-pattern list-pattern]))
|
||||||
|
|
||||||
(def match-clause (group (order :match-clause
|
(def match-clause (group (order-0 :match-clause
|
||||||
[pattern (maybe constraint) (quiet :rarrow) expression])))
|
[pattern (maybe constraint) (quiet :rarrow) expression])))
|
||||||
|
|
||||||
(def match-entries (entries :match-entries terminator match-clause))
|
(def match-entry (order-0 :match-entry [match-clause (quiet (one+ terminator))]))
|
||||||
|
|
||||||
(def match (group (order :match
|
(def match (group (order-1 :match
|
||||||
[(quiet :match) expression nls?
|
[(quiet :match) expression nls?
|
||||||
(quiet :with) (quiet :lbrace) nls?
|
(quiet :with) (quiet :lbrace)
|
||||||
match-clause
|
(quiet (zero+ terminator))
|
||||||
match-entries
|
(one+ match-entry)
|
||||||
nls?
|
|
||||||
(quiet :rbrace)
|
(quiet :rbrace)
|
||||||
])))
|
])))
|
||||||
|
|
||||||
(def iff (order :if [(quiet :if)
|
(def iff (order-1 :if [(quiet :if)
|
||||||
nls?
|
nls?
|
||||||
expression
|
expression
|
||||||
nls?
|
nls?
|
||||||
|
@ -93,170 +85,137 @@
|
||||||
|
|
||||||
(def cond-lhs (flat (choice :cond-lhs [expression :placeholder :else])))
|
(def cond-lhs (flat (choice :cond-lhs [expression :placeholder :else])))
|
||||||
|
|
||||||
(def cond-clause (group (order :cond-clause [cond-lhs (quiet :rarrow) expression])))
|
(def cond-clause (group (order-0 :cond-clause [cond-lhs (quiet :rarrow) expression])))
|
||||||
|
|
||||||
(def cond-entries (entries :cond-entries terminator cond-clause))
|
(def cond-entry (order-0 :cond-entry [cond-clause (quiet (one+ terminator))]))
|
||||||
|
|
||||||
(def condd (order :cond [(quiet :cond) (quiet :lbrace)
|
(def condd (order-1 :cond [(quiet :cond) (quiet :lbrace)
|
||||||
(quiet (zero+ terminator))
|
|
||||||
cond-clause
|
|
||||||
cond-entries
|
|
||||||
(quiet (zero+ terminator))
|
(quiet (zero+ terminator))
|
||||||
|
(one+ cond-entry)
|
||||||
(quiet :rbrace)]))
|
(quiet :rbrace)]))
|
||||||
|
|
||||||
(def lett (group (order :let [(quiet :let)
|
(def lett (group (order-1 :let [(quiet :let)
|
||||||
pattern
|
pattern
|
||||||
(quiet :equals)
|
(quiet :equals)
|
||||||
nls?
|
nls?
|
||||||
expression])))
|
expression])))
|
||||||
|
|
||||||
(def tuple-entry (weak (order :tuple-entry [(quiet (one+ separator)) expression])))
|
(def tuple-entry (order-1 :tuple-entry [expression separators]))
|
||||||
|
|
||||||
(def tuple-entries (entries :tuple-entries separator expression))
|
(def tuple (group (order-1 :tuple [(quiet :lparen)
|
||||||
|
|
||||||
(def tuple (group (order :tuple
|
|
||||||
[(quiet :lparen)
|
|
||||||
(quiet (zero+ separator))
|
|
||||||
(maybe expression)
|
|
||||||
tuple-entries
|
|
||||||
(quiet (zero+ separator))
|
(quiet (zero+ separator))
|
||||||
|
(zero+ tuple-entry)
|
||||||
(quiet :rparen)])))
|
(quiet :rparen)])))
|
||||||
|
|
||||||
(def list-term (flat (choice :list-term [splat expression])))
|
(def list-term (flat (choice :list-term [splat expression])))
|
||||||
|
|
||||||
(def list-entry (weak (order :list-entry [(quiet (one+ separator)) list-term])))
|
(def list-entry (order-1 :list-entry [list-term separators]))
|
||||||
|
|
||||||
(def list-entries (entries :list-entries separator list-term))
|
(def listt (group (order-1 :list
|
||||||
|
|
||||||
(def listt (group (order :list
|
|
||||||
[(quiet :lbracket)
|
[(quiet :lbracket)
|
||||||
(quiet (zero+ separator))
|
(quiet (zero+ separator))
|
||||||
(maybe list-term)
|
(zero+ list-entry)
|
||||||
list-entries
|
|
||||||
(quiet (zero+ separator))
|
|
||||||
(quiet :rbracket)])))
|
(quiet :rbracket)])))
|
||||||
|
|
||||||
(def sett (group (order :set [
|
(def sett (group (order-1 :set [
|
||||||
(quiet :startset)
|
(quiet :startset)
|
||||||
(quiet (zero+ separator))
|
(quiet (zero+ separator))
|
||||||
(maybe list-term)
|
(zero+ list-entry)
|
||||||
list-entries
|
|
||||||
(quiet (zero+ separator))
|
|
||||||
(quiet :rbrace)])))
|
(quiet :rbrace)])))
|
||||||
|
|
||||||
(def pair (group (order :pair [:keyword expression])))
|
(def pair (group (order-0 :pair [:keyword expression])))
|
||||||
|
|
||||||
(def struct-term (flat (choice :struct-term [:word pair])))
|
(def struct-term (flat (choice :struct-term [:word pair])))
|
||||||
|
|
||||||
(def struct-entry (weak (order :struc-entry [(quiet (one+ separator)) struct-term])))
|
(def struct-entry (order-1 :struct-entry [struct-term separators]))
|
||||||
|
|
||||||
(def struct-entries (entries :struct-entries separator struct-term))
|
(def structt (group (order-1 :struct
|
||||||
|
|
||||||
(def structt (group (order :struct
|
|
||||||
[(quiet :startstruct)
|
[(quiet :startstruct)
|
||||||
(quiet (zero+ separator))
|
(quiet (zero+ separator))
|
||||||
(maybe struct-term)
|
(zero+ struct-entry)
|
||||||
struct-entries
|
|
||||||
(quiet (zero+ separator))
|
|
||||||
(quiet :rbrace)])))
|
(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 (weak (order :dict-entry [(quiet (one+ separator)) dict-term])))
|
(def dict-entry (order-1 :dict-entry [dict-term separators]))
|
||||||
|
|
||||||
(def dict-entries (entries :dict-entries separator dict-term))
|
(def dict (group (order-1 :dict
|
||||||
|
|
||||||
(def dict (group (order :dict
|
|
||||||
[(quiet :startdict)
|
[(quiet :startdict)
|
||||||
(quiet (zero+ separator))
|
(quiet (zero+ separator))
|
||||||
(maybe dict-term)
|
(zero+ dict-entry)
|
||||||
dict-entries
|
|
||||||
(quiet (zero+ separator))
|
|
||||||
(quiet :rbrace)])))
|
(quiet :rbrace)])))
|
||||||
|
|
||||||
(def arg-expr (flat (choice :arg-expr [:placeholder expression])))
|
(def arg-expr (flat (choice :arg-expr [:placeholder expression])))
|
||||||
|
|
||||||
(def arg-entry (weak (order :arg-entry [(quiet (one+ separator)) arg-expr])))
|
(def arg-entry (order-1 :arg-entry [arg-expr separators]))
|
||||||
|
|
||||||
(def arg-entries (entries :arg-entries separator arg-expr))
|
(def arg-tuple (order-1 :arg-tuple
|
||||||
|
|
||||||
(def arg-tuple (order :arg-tuple
|
|
||||||
[(quiet :lparen)
|
[(quiet :lparen)
|
||||||
(quiet (zero+ separator))
|
(quiet (zero+ separator))
|
||||||
(maybe arg-expr)
|
(zero+ arg-entry)
|
||||||
arg-entries
|
|
||||||
(quiet (zero+ separator))
|
|
||||||
(quiet :rparen)]))
|
(quiet :rparen)]))
|
||||||
|
|
||||||
(def synth-root (choice :synth-root [:keyword :word :recur]))
|
(def synth-root (choice :synth-root [:keyword :word :recur]))
|
||||||
|
|
||||||
(def synth-term (choice :synth-term [arg-tuple :keyword]))
|
(def synth-term (choice :synth-term [arg-tuple :keyword]))
|
||||||
|
|
||||||
(def synthetic (order :synthetic [synth-root (zero+ synth-term)]))
|
(def synthetic (order-1 :synthetic [synth-root (zero+ synth-term)]))
|
||||||
|
|
||||||
(def fn-clause (group (order :fn-clause [tuple-pattern (maybe constraint) (quiet :rarrow) expression])))
|
(def fn-clause (group (order-0 :fn-clause [tuple-pattern (maybe constraint) (quiet :rarrow) expression])))
|
||||||
|
|
||||||
(def fn-entry (weak (order :fn-entry [(quiet (one+ terminator)) fn-clause])))
|
(def fn-entry (order-1 :fn-entry [fn-clause terminators]))
|
||||||
|
|
||||||
(def fn-entries (entries :fn-entries terminator fn-clause))
|
(def compound (group (order-1 :compound [(quiet :lbrace)
|
||||||
|
|
||||||
(def compound (group (order :compound [(quiet :lbrace)
|
|
||||||
nls?
|
nls?
|
||||||
(maybe :string)
|
(maybe :string)
|
||||||
nls?
|
(quiet (zero+ terminator))
|
||||||
fn-clause
|
(one+ fn-entry)
|
||||||
fn-entries
|
|
||||||
nls?
|
|
||||||
(quiet :rbrace)
|
(quiet :rbrace)
|
||||||
])))
|
])))
|
||||||
|
|
||||||
(def clauses (flat (choice :clauses [compound fn-clause])))
|
(def clauses (flat (choice :clauses [fn-clause compound])))
|
||||||
|
|
||||||
(def named (group (order :named [:word clauses])))
|
(def named (group (order-1 :named [:word clauses])))
|
||||||
|
|
||||||
(def body (flat (choice :body [fn-clause named])))
|
(def body (flat (choice :body [fn-clause named])))
|
||||||
|
|
||||||
(def fnn (group (order :fn [(quiet :fn) body])))
|
(def fnn (group (order-1 :fn [(quiet :fn) body])))
|
||||||
|
|
||||||
(def block-lines (entries :block-lines terminator expression))
|
(def block-line (order-1 :block-line [expression terminators]))
|
||||||
|
|
||||||
(def block (group (order :block [(quiet :lbrace)
|
(def block (group (order-1 :block [(quiet :lbrace)
|
||||||
nls?
|
(quiet (zero+ terminator))
|
||||||
expression
|
(zero+ block-line)
|
||||||
block-lines
|
(quiet :rbrace)])))
|
||||||
nls? (quiet :rbrace)])))
|
|
||||||
|
(def pipeline (order-0 :pipeline [nls? :pipeline]))
|
||||||
(def pipeline (order :pipeline [nls? :pipeline]))
|
|
||||||
|
(def do-entry (order-0 :do-entry [pipeline expression]))
|
||||||
(def do-entry (weak (order :do-entry [pipeline expression])))
|
|
||||||
|
(def doo (group (order-1 :do [(quiet :do)
|
||||||
(def doo (group (order :do [
|
|
||||||
(quiet :do)
|
|
||||||
expression
|
expression
|
||||||
|
;; should this be zero+?
|
||||||
(one+ do-entry)
|
(one+ do-entry)
|
||||||
])))
|
])))
|
||||||
|
|
||||||
(def reff (group (order :ref [(quiet :ref) :word (quiet :equals) expression])))
|
(def reff (group (order-1 :ref [(quiet :ref) :word (quiet :equals) expression])))
|
||||||
|
|
||||||
(def spawn (group (order :spawn [(quiet :spawn) expression])))
|
(def spawn (group (order-1 :spawn [(quiet :spawn) expression])))
|
||||||
|
|
||||||
(def receive (group (order :receive
|
(def receive (group (order-1 :receive
|
||||||
[(quiet :receive) (quiet :lbrace) nls?
|
[(quiet :receive) (quiet :lbrace)
|
||||||
match-clause
|
(quiet (zero+ terminator))
|
||||||
match-entries
|
(one+ match-entry)
|
||||||
nls?
|
|
||||||
(quiet :rbrace)
|
(quiet :rbrace)
|
||||||
])))
|
])))
|
||||||
|
|
||||||
(def compound-loop (group (order :compound-loop
|
(def compound-loop (group (order-0 :compound-loop
|
||||||
[(quiet :lbrace)
|
[(quiet :lbrace)
|
||||||
nls?
|
(quiet (zero+ terminator))
|
||||||
fn-clause
|
(one+ fn-entry)
|
||||||
fn-entries
|
|
||||||
nls?
|
|
||||||
(quiet :rbrace)])))
|
(quiet :rbrace)])))
|
||||||
|
|
||||||
(def loopp (group (order :loop
|
(def loopp (group (order-1 :loop
|
||||||
[(quiet :loop) tuple (quiet :with)
|
[(quiet :loop) tuple (quiet :with)
|
||||||
(flat (choice :loop-body [fn-clause compound-loop]))])))
|
(flat (choice :loop-body [fn-clause compound-loop]))])))
|
||||||
|
|
||||||
|
@ -279,27 +238,23 @@
|
||||||
tuple
|
tuple
|
||||||
literal])))
|
literal])))
|
||||||
|
|
||||||
(def test (group (order :test [(quiet :test) :string expression])))
|
(def testt (group (order-1 :test [(quiet :test) :string expression])))
|
||||||
|
|
||||||
(def importt (group (order :import [(quiet :import) :string (quiet :as) :word])))
|
(def importt (group (order-1 :import [(quiet :import) :string (quiet :as) :word])))
|
||||||
|
|
||||||
(def nss (group (order :nss [(quiet :ns)
|
(def nss (group (order-1 :nss [(quiet :ns)
|
||||||
:word
|
:word
|
||||||
(quiet :lbrace)
|
(quiet :lbrace)
|
||||||
(quiet (zero+ separator))
|
(quiet (zero+ separator))
|
||||||
(maybe struct-term)
|
|
||||||
(zero+ struct-entry)
|
(zero+ struct-entry)
|
||||||
(quiet (zero+ separator))
|
|
||||||
(quiet :rbrace)])))
|
(quiet :rbrace)])))
|
||||||
|
|
||||||
(def toplevel (flat (choice :toplevel [importt nss expression test])))
|
(def toplevel (flat (choice :toplevel [importt nss expression testt])))
|
||||||
|
|
||||||
(def script-lines (entries :script-lines terminator toplevel))
|
(def script-line (order-0 :script-line [toplevel terminators]))
|
||||||
|
|
||||||
(def script (order :script [nls?
|
(def script (order-0 :script [nls?
|
||||||
toplevel
|
(one+ script-line)
|
||||||
script-lines
|
|
||||||
nls?
|
|
||||||
(quiet :eof)]))
|
(quiet :eof)]))
|
||||||
|
|
||||||
|
|
||||||
|
@ -309,16 +264,16 @@
|
||||||
;; --e.g., give functions better names in the stack trace
|
;; --e.g., give functions better names in the stack trace
|
||||||
;; --I think this might require a macro (::facepalm::)
|
;; --I think this might require a macro (::facepalm::)
|
||||||
;;TODO: fix forward declaration errors
|
;;TODO: fix forward declaration errors
|
||||||
|
;;TODO: in, e.g., script-line (repeated, separated entities -- zero/one+->order), order-0 gives an error before a closing token (in this case, :eof), because it's not a line; but using order-1 parses correctly but swallows orders further down. I need to revisit how no match vs. errors pass through the system, esp. the combination of repeats and orders
|
||||||
|
|
||||||
|
|
||||||
(def eg (:tokens (scan/scan
|
(def eg (:tokens (scan/scan
|
||||||
"receive { _ -> 1; () -> 2 }
|
"{1; 2; 3; (1, _)}"
|
||||||
"
|
|
||||||
)))
|
)))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(def result (apply-parser script eg))
|
(def result (apply-parser block eg))
|
||||||
|
|
||||||
|
|
||||||
(defn report [node]
|
(defn report [node]
|
||||||
|
|
|
@ -44,10 +44,13 @@
|
||||||
|
|
||||||
(defn apply-parser [parser tokens]
|
(defn apply-parser [parser tokens]
|
||||||
(println "Applying parser " (? (:name parser) parser))
|
(println "Applying parser " (? (:name parser) parser))
|
||||||
(cond
|
(let [result (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)
|
||||||
:else (throw (Exception. "`apply-parser` requires a parser"))))
|
:else (throw (Exception. "`apply-parser` requires a parser")))]
|
||||||
|
(println "Parser result " (? (:name parser) parser) (:status result))
|
||||||
|
result
|
||||||
|
))
|
||||||
|
|
||||||
(defn choice [name parsers]
|
(defn choice [name parsers]
|
||||||
{:name name
|
{:name name
|
||||||
|
@ -67,8 +70,9 @@
|
||||||
{:status :none :token (first tokens) :trace [name] :remaining rem-ts}
|
{:status :none :token (first tokens) :trace [name] :remaining rem-ts}
|
||||||
|
|
||||||
:else (recur rem-ps)))))})
|
:else (recur rem-ps)))))})
|
||||||
|
;; TODO - figure out a scheme for zero and one lookahead
|
||||||
(defn order [name parsers]
|
;; Lookahead isn't even the right term here
|
||||||
|
(defn order-1 [name parsers]
|
||||||
{:name name
|
{:name name
|
||||||
:rule (fn order-fn [tokens]
|
:rule (fn order-fn [tokens]
|
||||||
(let [origin (first tokens)
|
(let [origin (first tokens)
|
||||||
|
@ -121,6 +125,49 @@
|
||||||
(:err :none)
|
(:err :none)
|
||||||
(assoc (update result :trace #(conj % name)) :status :err))))))))})
|
(assoc (update result :trace #(conj % name)) :status :err))))))))})
|
||||||
|
|
||||||
|
(defn order-0 [name parsers]
|
||||||
|
{:name name
|
||||||
|
:rule (fn order-fn [tokens]
|
||||||
|
(let [origin (first tokens)]
|
||||||
|
(loop [ps parsers
|
||||||
|
results []
|
||||||
|
ts tokens]
|
||||||
|
(let [result (apply-parser (first ps) ts)
|
||||||
|
res-rem (remaining result)]
|
||||||
|
(if (empty? (rest ps))
|
||||||
|
;; Nothing more: return
|
||||||
|
(case (:status result)
|
||||||
|
:ok {:status :group
|
||||||
|
:type name
|
||||||
|
:data (conj results result)
|
||||||
|
:token origin
|
||||||
|
:remaining res-rem}
|
||||||
|
|
||||||
|
:quiet {:status :group
|
||||||
|
:type name
|
||||||
|
:data results
|
||||||
|
:token origin
|
||||||
|
:remaining res-rem}
|
||||||
|
|
||||||
|
:group {:status :group
|
||||||
|
:type name
|
||||||
|
:data (vec (concat results (:data result)))
|
||||||
|
:token origin
|
||||||
|
:remaining res-rem}
|
||||||
|
|
||||||
|
(:err :none)
|
||||||
|
(assoc (update result :trace #(conj % name)) :status :err))
|
||||||
|
|
||||||
|
;; Still parsers left in the vector: recur
|
||||||
|
(case (:status result)
|
||||||
|
:ok (recur (rest ps) (conj results result) res-rem)
|
||||||
|
:group (recur (rest ps)
|
||||||
|
(vec (concat results (:data result)))
|
||||||
|
res-rem)
|
||||||
|
:quiet (recur (rest ps) results res-rem)
|
||||||
|
(:err :none)
|
||||||
|
(assoc (update result :trace #(conj % name)) :status :err)))))))})
|
||||||
|
|
||||||
(defn quiet [parser]
|
(defn quiet [parser]
|
||||||
{:name (kw+str (? (:name parser) parser) "-quiet")
|
{:name (kw+str (? (:name parser) parser) "-quiet")
|
||||||
:rule (fn quiet-fn [tokens]
|
:rule (fn quiet-fn [tokens]
|
||||||
|
@ -158,11 +205,23 @@
|
||||||
(case (:status first-result)
|
(case (:status first-result)
|
||||||
(:ok :group)
|
(:ok :group)
|
||||||
(let [rest-result (apply-parser rest-parser (remaining first-result))]
|
(let [rest-result (apply-parser rest-parser (remaining first-result))]
|
||||||
|
(case (:status rest-result)
|
||||||
|
|
||||||
|
(:ok :group :quiet)
|
||||||
{:status :group
|
{:status :group
|
||||||
:type name
|
:type name
|
||||||
:data (vec (concat [first-result] (data rest-result)))
|
:data (vec (concat [first-result] (data rest-result)))
|
||||||
:token (first tokens)
|
:token (first tokens)
|
||||||
:remaining (remaining rest-result)})
|
:remaining (remaining rest-result)}
|
||||||
|
|
||||||
|
:none {:status :group :type name
|
||||||
|
:data first-result
|
||||||
|
:token (first tokens)
|
||||||
|
:remaining (remaining rest-result)}
|
||||||
|
|
||||||
|
:err (update rest-result :trace #(conj % name)))
|
||||||
|
|
||||||
|
)
|
||||||
|
|
||||||
:quiet
|
:quiet
|
||||||
(let [rest-result (apply-parser rest-parser (remaining first-result))]
|
(let [rest-result (apply-parser rest-parser (remaining first-result))]
|
||||||
|
@ -203,49 +262,6 @@
|
||||||
(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)))
|
||||||
|
|
||||||
(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:
|
|
||||||
|
|
||||||
Rather, there is one ambiguity: synthetic expressions can start with words or keywords.
|
|
||||||
A bare word can be assimilated to synthetic expressions. Interestingly, so can synthetic.
|
|
||||||
|
|
||||||
The parsing strategy is the same: consume as many things until you can't get anymore.
|
|
||||||
|
|
||||||
The fact that a bare keyword is evaluated like a literal doesn't matter.
|
|
||||||
|
|
||||||
So:
|
|
||||||
literal -> literal
|
|
||||||
keyword -> synthetic
|
|
||||||
word -> synthetic
|
|
||||||
( -> tuple
|
|
||||||
[ -> list
|
|
||||||
#{ -> dict
|
|
||||||
@{ -> struct
|
|
||||||
ns -> ns
|
|
||||||
let -> let
|
|
||||||
do -> pipeline
|
|
||||||
|
|
||||||
etc.
|
|
||||||
|
|
||||||
Because there's now NO lookahead, we can easily distinguish between orderings that don't match at all, and ones which match on the first token.
|
|
||||||
|
|
||||||
Because of that, we can also distinguish between no-match and errors
|
|
||||||
|
|
||||||
")
|
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -36,7 +36,7 @@
|
||||||
;; type system
|
;; type system
|
||||||
;; "data" :data ;; we are going to tear out datatypes for now: see if dynamism works for us
|
;; "data" :data ;; we are going to tear out datatypes for now: see if dynamism works for us
|
||||||
;; others
|
;; others
|
||||||
"repeat" :repeat ;; syntax sugar over "loop": still unclear what this syntax could be
|
;;"repeat" :repeat ;; syntax sugar over "loop": still unclear what this syntax could be
|
||||||
"test" :test
|
"test" :test
|
||||||
"when" :when
|
"when" :when
|
||||||
;; "module" :module ;; not necessary if we don't have datatypes
|
;; "module" :module ;; not necessary if we don't have datatypes
|
||||||
|
@ -113,11 +113,7 @@
|
||||||
(defn- whitespace? [c]
|
(defn- whitespace? [c]
|
||||||
(or (= c \space) (= c \tab)))
|
(or (= c \space) (= c \tab)))
|
||||||
|
|
||||||
;; TODO: update token terminators:
|
(def terminators #{\: \; \newline \{ \} \( \) \[ \] \$ \# \- \= \& \, \> nil \\})
|
||||||
;; remove: \|
|
|
||||||
;; add: \>
|
|
||||||
;; research others
|
|
||||||
(def terminators #{\: \; \newline \{ \} \( \) \[ \] \$ \# \- \= \& \, \| nil \\})
|
|
||||||
|
|
||||||
(defn- terminates? [c]
|
(defn- terminates? [c]
|
||||||
(or (whitespace? c) (contains? terminators c)))
|
(or (whitespace? c) (contains? terminators c)))
|
||||||
|
@ -176,24 +172,29 @@
|
||||||
(digit? curr) (recur (advance scanner) (str num curr) float?)
|
(digit? curr) (recur (advance scanner) (str num curr) float?)
|
||||||
:else (add-error scanner (str "Unexpected " curr " after number " num "."))))))
|
:else (add-error scanner (str "Unexpected " curr " after number " num "."))))))
|
||||||
|
|
||||||
;; TODO: add string interpolation
|
;; TODO: activate string interpolation
|
||||||
;; This still has to be devised
|
|
||||||
(defn- add-string
|
(defn- add-string
|
||||||
[scanner]
|
[scanner]
|
||||||
(loop [scanner scanner
|
(loop [scanner scanner
|
||||||
string ""]
|
string ""
|
||||||
|
interpolate? false]
|
||||||
(let [char (current-char scanner)]
|
(let [char (current-char scanner)]
|
||||||
(case char
|
(case char
|
||||||
\newline (add-error scanner "Unterminated string.")
|
\{ (recur (update (advance scanner)) (str string char) true)
|
||||||
\" (add-token (advance scanner) :string string)
|
; allow multiline strings
|
||||||
|
\newline (recur (update (advance scanner) :line inc) (str string char) interpolate?)
|
||||||
|
\" (if interpolate?
|
||||||
|
;(add-token (advance scanner) :interpolated string)
|
||||||
|
(add-token (advance scanner) :string string)
|
||||||
|
(add-token (advance scanner) :string string))
|
||||||
\\ (let [next (next-char scanner)
|
\\ (let [next (next-char scanner)
|
||||||
scanner (if (= next \newline)
|
scanner (if (= next \newline)
|
||||||
(update scanner :line inc)
|
(update scanner :line inc)
|
||||||
scanner)]
|
scanner)]
|
||||||
(recur (advance (advance scanner)) (str string next)))
|
(recur (advance (advance scanner)) (str string next) interpolate?))
|
||||||
(if (at-end? scanner)
|
(if (at-end? scanner)
|
||||||
(add-error scanner "Unterminated string.")
|
(add-error scanner "Unterminated string.")
|
||||||
(recur (advance scanner) (str string char)))))))
|
(recur (advance scanner) (str string char) interpolate?))))))
|
||||||
|
|
||||||
(defn- add-word
|
(defn- add-word
|
||||||
[char scanner]
|
[char scanner]
|
||||||
|
@ -242,11 +243,13 @@
|
||||||
(case char
|
(case char
|
||||||
;; one-character tokens
|
;; one-character tokens
|
||||||
\( (add-token scanner :lparen)
|
\( (add-token scanner :lparen)
|
||||||
\) (add-token scanner :rparen)
|
;; :break is a special zero-char token before closing braces
|
||||||
|
;; it makes parsing much simpler
|
||||||
|
\) (add-token (add-token scanner :break) :rparen)
|
||||||
\{ (add-token scanner :lbrace)
|
\{ (add-token scanner :lbrace)
|
||||||
\} (add-token scanner :rbrace)
|
\} (add-token (add-token scanner :break) :rbrace)
|
||||||
\[ (add-token scanner :lbracket)
|
\[ (add-token scanner :lbracket)
|
||||||
\] (add-token scanner :rbracket)
|
\] (add-token (add-token scanner :break) :rbracket)
|
||||||
\; (add-token scanner :semicolon)
|
\; (add-token scanner :semicolon)
|
||||||
\, (add-token scanner :comma)
|
\, (add-token scanner :comma)
|
||||||
\newline (add-token (update scanner :line inc) :newline)
|
\newline (add-token (update scanner :line inc) :newline)
|
||||||
|
@ -261,23 +264,6 @@
|
||||||
(digit? next) (add-number char scanner)
|
(digit? next) (add-number char scanner)
|
||||||
:else (add-error scanner (str "Expected -> or negative number after `-`. Got `" char next "`")))
|
:else (add-error scanner (str "Expected -> or negative number after `-`. Got `" char next "`")))
|
||||||
|
|
||||||
;; at current we're not using this
|
|
||||||
;; <-
|
|
||||||
;;\< (if (= next \-)
|
|
||||||
;; (add-token (advance scanner) :larrow)
|
|
||||||
;; (add-error scanner (str "Expected <-. Got " char next)))
|
|
||||||
|
|
||||||
;; |>
|
|
||||||
;; Consider => , with =>> for bind
|
|
||||||
; \| (if (= next \>)
|
|
||||||
; (add-token (advance scanner) :pipeline)
|
|
||||||
; (add-error scanner (str "Expected |>. Got " char next)))
|
|
||||||
|
|
||||||
;; possible additional operator: bind/result
|
|
||||||
;; possible additional operator: bind/some
|
|
||||||
;; oh god, monads
|
|
||||||
;; additional arrow possibilities: >> ||> ~> => !>
|
|
||||||
|
|
||||||
;; dict #{
|
;; dict #{
|
||||||
\# (if (= next \{)
|
\# (if (= next \{)
|
||||||
(add-token (advance scanner) :startdict)
|
(add-token (advance scanner) :startdict)
|
||||||
|
@ -302,8 +288,6 @@
|
||||||
|
|
||||||
;; comments
|
;; comments
|
||||||
;; & starts an inline comment
|
;; & starts an inline comment
|
||||||
;; TODO: include comments in scanned file
|
|
||||||
;; TODO, maybe: add doc comments: &&& (or perhaps a docstring in an fn?)
|
|
||||||
\& (add-comment char scanner)
|
\& (add-comment char scanner)
|
||||||
|
|
||||||
;; keywords
|
;; keywords
|
||||||
|
@ -324,7 +308,7 @@
|
||||||
(cond
|
(cond
|
||||||
(whitespace? char) scanner ;; for now just skip whitespace characters
|
(whitespace? char) scanner ;; for now just skip whitespace characters
|
||||||
(digit? char) (add-number char scanner)
|
(digit? char) (add-number char scanner)
|
||||||
(upper? char) (add-data char scanner)
|
(upper? char) (add-word char scanner) ;; no datatypes for now
|
||||||
(lower? char) (add-word char scanner)
|
(lower? char) (add-word char scanner)
|
||||||
:else (add-error scanner (str "Unexpected character: " char))))))
|
:else (add-error scanner (str "Unexpected character: " char))))))
|
||||||
|
|
||||||
|
@ -334,10 +318,8 @@
|
||||||
(defn scan [source]
|
(defn scan [source]
|
||||||
(loop [scanner (new-scanner source)]
|
(loop [scanner (new-scanner source)]
|
||||||
(if (at-end? scanner)
|
(if (at-end? scanner)
|
||||||
(let [scanner (add-token scanner :eof)]
|
(let [scanner (add-token (add-token scanner :break) :eof)]
|
||||||
{:tokens (:tokens scanner)
|
{:tokens (:tokens scanner)
|
||||||
:errors (:errors scanner)})
|
:errors (:errors scanner)})
|
||||||
(recur (-> scanner (scan-token) (next-token))))))
|
(recur (-> scanner (scan-token) (next-token))))))
|
||||||
|
|
||||||
(scan "2 :three true nil")
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user