From f02532ee408c62dc40170939f0cf4c17050fc421 Mon Sep 17 00:00:00 2001 From: Scott Richmond Date: Thu, 11 Jan 2024 19:42:58 -0500 Subject: [PATCH] Get annoyed by translating my clj parser into janet; start work on a Janet/PEG parser --- janet/clj-loop.janet | 38 +++++++++- janet/parser.janet | 170 +++++++++++++++++++++++++++++++------------ 2 files changed, 160 insertions(+), 48 deletions(-) diff --git a/janet/clj-loop.janet b/janet/clj-loop.janet index 4792832..502f8c7 100644 --- a/janet/clj-loop.janet +++ b/janet/clj-loop.janet @@ -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)))) + + diff --git a/janet/parser.janet b/janet/parser.janet index c9e2152..454ba79 100644 --- a/janet/parser.janet +++ b/janet/parser.janet @@ -33,17 +33,17 @@ (array? seq) (array/slice 1 len)))) (defn some? [val] (not (nil? val))) - + (defn apply-kw-parser [kw tokens] (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))