Get annoyed by translating my clj parser into janet; start work on a Janet/PEG parser
This commit is contained in:
parent
f4d09afed6
commit
f02532ee40
|
@ -2,7 +2,7 @@
|
|||
``A drop-in replacement for Clojure's loop form. Useful for the current project of converting Clojure code to Janet.
|
||||
``
|
||||
[bindings & body]
|
||||
(assert (even? (length bindings)))
|
||||
(assert (even? (length bindings)) "Binding tuple must have an even number of terms")
|
||||
(def names @[])
|
||||
(def args @[])
|
||||
(loop [i :range [0 (length bindings)]]
|
||||
|
@ -11,3 +11,39 @@
|
|||
(array/push args (get bindings i))))
|
||||
~(do (defn recur [,;names] ,;body) (recur ,;args)))
|
||||
|
||||
(defmacro defn+
|
||||
[name & clauses]
|
||||
~(defn ,name [& args]
|
||||
(print "before do")
|
||||
(do
|
||||
(def arities @{})
|
||||
(def clauses ,clauses)
|
||||
(def bindingses (map first clauses))
|
||||
(def bodies (map |(slice $ 1) clauses))
|
||||
(print "before loop")
|
||||
(loop [i :range [0 (length clauses)]]
|
||||
(def bindings (get bindingses i))
|
||||
(def arity (length bindings))
|
||||
(assert (not (get arities i)) "Clauses must have different arities")
|
||||
(def body (get bodies i))
|
||||
(def clause ~(fn ,name ,bindings ,;body))
|
||||
(put $arities arity clause))
|
||||
(print "before quasiquote")
|
||||
(fn [& args]
|
||||
(def arity (length args))
|
||||
(def clause (get arities arity))
|
||||
(assert clause "No clause with that arity")
|
||||
(clause ;args)))))
|
||||
|
||||
(defn+ add
|
||||
([] 0)
|
||||
([x] x)
|
||||
([x y] (+ x y)))
|
||||
|
||||
(macex1
|
||||
'(defn+ add
|
||||
([] 0)
|
||||
([x] x)
|
||||
([x y] (+ x y))))
|
||||
|
||||
|
||||
|
|
|
@ -38,12 +38,12 @@
|
|||
(let [token (first tokens)]
|
||||
#(if (= kw (get token :type)) (println "Matched " kw))
|
||||
(if (= kw (get token :type))
|
||||
{:status :ok
|
||||
@{:status :ok
|
||||
:type kw
|
||||
:data (if (some? (value token)) [(value token)] [])
|
||||
:data (if (some? (value token)) @[(value token)] @[])
|
||||
:token token
|
||||
:remaining (rest tokens)}
|
||||
{:status :none :token token :trace [kw] :remaining (rest tokens)})))
|
||||
@{:status :none :token token :trace [kw] :remaining (rest tokens)})))
|
||||
|
||||
(defn apply-fn-parser [parser tokens]
|
||||
(let [rule (get parser :rule) name (get parser :name) result (rule tokens)]
|
||||
|
@ -65,7 +65,7 @@
|
|||
(defn choice [name parsers]
|
||||
{:name name
|
||||
:rule (fn choice-fn [tokens]
|
||||
(defn recur [ps]
|
||||
(clj-loop [ps parsers]
|
||||
(let [result (apply-parser (first ps) tokens)
|
||||
rem-ts (remaining result)
|
||||
rem-ps (rest ps)]
|
||||
|
@ -79,9 +79,7 @@
|
|||
(empty? rem-ps)
|
||||
{:status :none :token (first tokens) :trace [name] :remaining rem-ts}
|
||||
|
||||
:else (recur rem-ps))))
|
||||
|
||||
(recur parsers))})
|
||||
:else (recur rem-ps)))))})
|
||||
|
||||
(defn order-1 [name parsers]
|
||||
{:name name
|
||||
|
@ -98,19 +96,19 @@
|
|||
res-rem (remaining result)]
|
||||
(if (empty? (rest ps))
|
||||
(case (get result :status)
|
||||
:ok {:status :group
|
||||
:ok @{:status :group
|
||||
:type name
|
||||
:data (array/push results result)
|
||||
:token origin
|
||||
:remaining res-rem}
|
||||
|
||||
:quiet {:status :group
|
||||
:quiet @{:status :group
|
||||
:type name
|
||||
:data results
|
||||
:token origin
|
||||
:remaining res-rem}
|
||||
|
||||
:group {:status :group
|
||||
:group @{:status :group
|
||||
:type name
|
||||
:data (array/concat results (get result :data))
|
||||
:token origin
|
||||
|
@ -143,19 +141,19 @@
|
|||
(if (empty? (rest ps))
|
||||
## Nothing more: return
|
||||
(case (get result :status)
|
||||
:ok {:status :group
|
||||
:ok @{:status :group
|
||||
:type name
|
||||
:data (array/push results result)
|
||||
:token origin
|
||||
:remaining res-rem}
|
||||
|
||||
:quiet {:status :group
|
||||
:quiet @{:status :group
|
||||
:type name
|
||||
:data results
|
||||
:token origin
|
||||
:remaining res-rem}
|
||||
|
||||
:group {:status :group
|
||||
:group @{:status :group
|
||||
:type name
|
||||
:data (array/concat results (get result :data))
|
||||
:token origin
|
||||
|
@ -178,7 +176,6 @@
|
|||
(error (string "Got bad result: " (get result :status)))))))
|
||||
(recur parsers [] tokens)))})
|
||||
|
||||
#### Start here
|
||||
(defn weak-order [name parsers]
|
||||
{:name name
|
||||
:rule (fn order-fn [tokens]
|
||||
|
@ -191,19 +188,19 @@
|
|||
(if (empty? (rest ps))
|
||||
## Nothing more: return
|
||||
(case (get result :status)
|
||||
:ok {:status :group
|
||||
:ok @{:status :group
|
||||
:type name
|
||||
:data (array/push results result)
|
||||
:token origin
|
||||
:remaining res-rem}
|
||||
|
||||
:quiet {:status :group
|
||||
:quiet @{:status :group
|
||||
:type name
|
||||
:data results
|
||||
:token origin
|
||||
:remaining res-rem}
|
||||
|
||||
:group {:status :group
|
||||
:group @{:status :group
|
||||
:type name
|
||||
:data (array/concat results (get result :data))
|
||||
:token origin
|
||||
|
@ -231,12 +228,7 @@
|
|||
(put result :status :quiet)
|
||||
result)))})
|
||||
|
||||
### Start here
|
||||
### How to write variadic functions here that preserve this logic
|
||||
### Janet doesn't allow for Clojure's multiple clauses, :(
|
||||
(defn zero+
|
||||
([parser] (zero+ (pname parser) parser))
|
||||
([name parser]
|
||||
(defn zero+/2 [name parser]
|
||||
{:name (kw+str name "-zero+")
|
||||
:rule (fn zero+fn [tokens]
|
||||
(clj-loop [results []
|
||||
|
@ -247,15 +239,37 @@
|
|||
:group (recur (array/concat results (get result :data)) (remaining result))
|
||||
:quiet (recur results (remaining result))
|
||||
:err (update result :trace |(array/push $ name))
|
||||
:none {:status :group
|
||||
:none @{:status :group
|
||||
:type name
|
||||
:data results
|
||||
:token (first tokens)
|
||||
:remaining ts}))))}))
|
||||
:remaining ts}))))})
|
||||
|
||||
(defn one+
|
||||
([parser] (one+ (pname parser) parser))
|
||||
([name parser]
|
||||
(defn zero+/1 [parser] (zero+/2 (pname parser) parser))
|
||||
|
||||
(defn zero+ [& args]
|
||||
(def arity (length args))
|
||||
(if (= 1 arity) (zero+/1 ;args) (zero+/2 ;args)))
|
||||
|
||||
# ([parser] (zero+ (pname parser) parser))
|
||||
# ([name parser]
|
||||
# {:name (kw+str name "-zero+")
|
||||
# :rule (fn zero+fn [tokens]
|
||||
# (clj-loop [results []
|
||||
# ts tokens]
|
||||
# (let [result (apply-parser parser ts)]
|
||||
# (case (get result :status)
|
||||
# :ok (recur (array/push results result) (remaining result))
|
||||
# :group (recur (array/concat results (get result :data)) (remaining result))
|
||||
# :quiet (recur results (remaining result))
|
||||
# :err (update result :trace |(array/push $ name))
|
||||
# :none {:status :group
|
||||
# :type name
|
||||
# :data results
|
||||
# :token (first tokens)
|
||||
# :remaining ts}))))}))
|
||||
|
||||
(defn one+/2 [name parser]
|
||||
{:name (kw+str name "-one+")
|
||||
:rule (fn one+fn [tokens]
|
||||
(let [first-result (apply-parser parser tokens)
|
||||
|
@ -287,26 +301,88 @@
|
|||
:token (first tokens)
|
||||
:remaining (remaining rest-result)})
|
||||
|
||||
(:err :none) first-result)))}))
|
||||
(:err :none) first-result)))})
|
||||
|
||||
(defn maybe
|
||||
([parser] (maybe (pname parser) parser))
|
||||
([name parser]
|
||||
{:name (kw+str name "-maybe")
|
||||
:rule (fn maybe-fn [tokens]
|
||||
(let [result (apply-parser parser tokens)]
|
||||
(if (pass? result)
|
||||
result
|
||||
{:status :group :type name :data [] :token (first tokens) :remaining tokens}
|
||||
)))}))
|
||||
(defn one+/1 [parser] (one+/2 (pname parser) parser))
|
||||
|
||||
(defn flat
|
||||
([parser] (flat (pname parser) parser))
|
||||
([name parser]
|
||||
{:name (kw+str name "-flat")
|
||||
:rule (fn flat-fn [tokens]
|
||||
(let [result (apply-parser parser tokens)]
|
||||
(if (pass? result) (first (get result :data)) result)))}))
|
||||
(defn one+ [& args]
|
||||
(def arity (length args))
|
||||
(if (= 1 arity) (one+/1 ;args) (one+/2 ;args)))
|
||||
|
||||
# (defn one+
|
||||
# ([parser] (one+ (pname parser) parser))
|
||||
# ([name parser]
|
||||
# {:name (kw+str name "-one+")
|
||||
# :rule (fn one+fn [tokens]
|
||||
# (let [first-result (apply-parser parser tokens)
|
||||
# rest-parser (zero+ name parser)]
|
||||
# (case (get first-result :status)
|
||||
# (:ok :group)
|
||||
# (let [rest-result (apply-parser rest-parser (remaining first-result))]
|
||||
# (case (get rest-result :status)
|
||||
|
||||
# (:ok :group :quiet)
|
||||
# {:status :group
|
||||
# :type name
|
||||
# :data (array/concat (get first-result :data) (data rest-result))
|
||||
# :token (first tokens)
|
||||
# :remaining (remaining rest-result)}
|
||||
|
||||
# :none {:status :group :type name
|
||||
# :data first-result
|
||||
# :token (first tokens)
|
||||
# :remaining (remaining rest-result)}
|
||||
|
||||
# :err (update rest-result :trace |(array/push % name))))
|
||||
|
||||
# :quiet
|
||||
# (let [rest-result (apply-parser rest-parser (remaining first-result))]
|
||||
# {:status :quiet
|
||||
# :type name
|
||||
# :data []
|
||||
# :token (first tokens)
|
||||
# :remaining (remaining rest-result)})
|
||||
|
||||
# (:err :none) first-result)))}))
|
||||
|
||||
(defn maybe/2 [name parser])
|
||||
|
||||
(defn maybe/1 [parser] (maybe/2 (pname parser) parser))
|
||||
|
||||
(defn maybe [& args]
|
||||
(def arity (length args))
|
||||
(if (= 1 arity) (maybe/1 ;args) (maybe/2 ;args)))
|
||||
|
||||
# (defn maybe
|
||||
# ([parser] (maybe (pname parser) parser))
|
||||
# ([name parser]
|
||||
# {:name (kw+str name "-maybe")
|
||||
# :rule (fn maybe-fn [tokens]
|
||||
# (let [result (apply-parser parser tokens)]
|
||||
# (if (pass? result)
|
||||
# result
|
||||
# {:status :group :type name :data [] :token (first tokens) :remaining tokens}
|
||||
# )))}))
|
||||
|
||||
(defn flat/2 [name parser])
|
||||
|
||||
(defn flat/1 [parser] (flat/2 (pname parser) parser))
|
||||
|
||||
(defn flat [& args]
|
||||
(def arity (length args))
|
||||
(if (= 1 arity) (flat/1 ;args) (flat/2 ;args)))
|
||||
|
||||
# (defn flat
|
||||
# ([parser] (flat (pname parser) parser))
|
||||
# ([name parser]
|
||||
# {:name (kw+str name "-flat")
|
||||
# :rule (fn flat-fn [tokens]
|
||||
# (let [result (apply-parser parser tokens)]
|
||||
# (if (pass? result) (first (get result :data)) result)))}))
|
||||
|
||||
(defn group/2 [name parser])
|
||||
|
||||
(defn group/1 [])
|
||||
|
||||
(defn group
|
||||
([parser] (group (pname parser) parser))
|
||||
|
|
Loading…
Reference in New Issue
Block a user