twc/ludus
4
0
Fork 0
Code Issues 32 Pull Requests Packages Projects 8 Releases Wiki Activity

Get annoyed by translating my clj parser into janet; start work on a Janet/PEG parser

Browse Source
This commit is contained in:
Scott Richmond 2024-01-11 19:42:58 -05:00
parent f4d09afed6
commit f02532ee40
2 changed files with 160 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
janet/clj-loop.janet
View File

@ -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))))

168
janet/parser.janet
View File

@ -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))