Skip to content

Instantly share code, notes, and snippets.

@dustingetz

dustingetz/do-via.cljc

Last active Jun 7, 2020
Embed
What would you like to do?
(ns contrib.do
#?(:cljs (:require-macros [contrib.do])))
(defn tag-type [tag]
(some->> (re-matches #"^([A-Z][-a-z]*)(.*)$" (name tag)) second keyword))
(defn typed-tag? [tag]
(not (nil? (tag-type tag))))
(defn typed-action? [val]
(and (vector? val)
(typed-tag? (first val))))
(defn action-tag [val]
(assert (vector? val))
(first val))
(defn action-type [val]
(assert typed-action? val)
(tag-type (action-tag val)))
; ----------------------------
(defprotocol Do-via
(resolver-for [H]))
(def ^:dynamic *stack [])
(def ^:dynamic *resolve {})
(def ^:dynamic *state)
(defmacro via* [R & body]
`(let [R# ~R
fns# (resolver-for R#)]
(assert (every? typed-tag? (keys fns#)))
(let [n# (count *stack)
resolvers#
(->> fns#
(group-by (comp tag-type key))
(reduce-kv (fn [m# k# v#]
(assoc m# k# (into {::nth n#} v#))) {}))]
(binding [*stack (conj *stack R#)
*resolve (merge *resolve resolvers#)]
~@body
))))
(defn ! [& action]
(let [action (vec action)]
(assert (typed-action? action))
(let [R (get *resolve (action-type action))]
(binding [*state (nth *stack (::nth R))]
(as-> ((get R (action-tag action)) action) result
(do (set! *stack (assoc *stack (::nth R) *state))
result))
))))
(defn get-state []
(or *state
(last *stack)))
@dustingetz

This comment has been minimized.

Copy link
Owner Author

@dustingetz dustingetz commented Jun 7, 2020

(defrecord Eval [scope]
  Do-via
  (resolver-for [_]
    ; Free effects
    {:Eval.get-var  (fn [[_ name]] (get (:scope do/*state) name))
     :Eval.set-var! (fn [[_ name val]]
                      (set! do/*state (update do/*state assoc-in [:scope name] val)))}))

(via* (->Eval {'x 42}) ; configure your interpreter
  ; execute effects
  (! :Eval.set-var 'x (inc (! :Eval.get-var 'x))))

It's a free monad. But where did the types go?

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.