diff options
Diffstat (limited to '')
-rw-r--r-- | src/lang/util.clj | 107 |
1 files changed, 107 insertions, 0 deletions
diff --git a/src/lang/util.clj b/src/lang/util.clj new file mode 100644 index 000000000..1290d91df --- /dev/null +++ b/src/lang/util.clj @@ -0,0 +1,107 @@ +(ns lang.util + (:require [clojure.string :as string] + [clojure.core.match :refer [match]])) + +;; [Interface] +;; [Interface/Utils] +(defn fail* [message] + [::failure message]) + +(defn return* [state value] + [::ok [state value]]) + +;; [Interface/Monads] +(defn fail [message] + (fn [_] + [::failure message])) + +(defn return [value] + (fn [state] + [::ok [state value]])) + +(defn bind [m-value step] + #(let [inputs (m-value %)] + ;; (prn 'bind/inputs inputs) + (match inputs + [::ok [?state ?datum]] + ((step ?datum) ?state) + + [::failure _] + inputs))) + +(defmacro exec [steps return] + (assert (not= 0 (count steps)) "The steps can't be empty!") + (assert (= 0 (rem (count steps) 2)) "The number of steps must be even!") + (reduce (fn [inner [label computation]] + (case label + :let `(let ~computation ~inner) + ;; :when (assert false "Can't use :when") + :when `(if ~computation + ~inner + zero) + ;; else + `(bind ~computation (fn [~label] ~inner)))) + return + (reverse (partition 2 steps)))) + +;; [Interface/Combinators] +(defn try-m [monad] + (fn [state] + (match (monad state) + [::ok [?state ?datum]] + (return* ?state ?datum) + + [::failure _] + (return* state nil)))) + +(defn repeat-m [monad] + (fn [state] + (match (monad state) + [::ok [?state ?head]] + ((exec [tail (repeat-m monad)] + (return (cons ?head tail))) + ?state) + + [::failure _] + (return* state '())))) + +(defn try-all-m [monads] + (fn [state] + (if (empty? monads) + (fail* "No alternative worked!") + (let [output ((first monads) state)] + (match output + [::ok _] + output + :else + (if-let [monads* (seq (rest monads))] + ((try-all-m monads*) state) + output) + ))))) + +(defn map-m [f inputs] + (if (empty? inputs) + (return '()) + (exec [output (f (first inputs)) + outputs (map-m f (rest inputs))] + (return (conj outputs output))))) + +(defn apply-m [monad call-state] + (fn [state] + ;; (prn 'apply-m monad call-state) + (let [output (monad call-state)] + ;; (prn 'output output) + (match output + [::ok [?state ?datum]] + [::ok [state ?datum]] + + [::failure _] + output)))) + +(defn comp-m [f-m g-m] + (exec [temp g-m] + (f-m temp))) + +(defn pass [m-value] + (fn [state] + m-value)) |