playground.clj

(ns playground)

(deftype TypedFn
  [signature function] :as this
  clojure.lang.IFn
  (applyTo [args] (apply function args))
  (call    []     (function))
  (invoke  [arg]  (function arg)))

(defmacro fnt
  [signature & body]
  `(TypedFn ~signature (fn ~@body)))

(defmacro defnt
  [name signature & body]
  `(def ~name (TypedFn ~signature (fn ~@body))))

;; types
;; :: A res -> res
;; :: B env -> env
;; :: C (res, env) -> (res, env)

;; :: L (x -> x) -> (x -> (x, y))

;; :: D env -> (res, env)
;; :: E (env -> (res, env)) -> ((res, env) -> (res, env))

(defnt identity-D :C [env] [[] env])

(defn result-D [x y]
  (let [x (if (seq x) x [])]
    (cond
     (seq x) (conj x y)
     (seq y) y
     :else   [])))

(defnt bind-D :E [f]
  (fn [[res env]]
    (let [[res* env*] (f env)]
      [(result-D res res*) env*])))

(defmulti to-D
  (fn [x] (:signature x)))

(defmethod to-D
  :A ([f] (fnt :D [env]
                (let [[res *env] (identity-D env)]
                  [(f res) *env]))))

(defmethod to-D
  :B ([f] (fnt :D [env]
                (let [[res *env] (identity-D env)]
                  [res (f *env)]))))

(defmethod to-D
  :C ([f] (fnt :D [env]
               (f identity-D env))))

(defmethod to-D
  :D ([f] f))

(defn & [& fns]
  (let [f (->> fns
               (map #(-> % to-D bind-D))
               (apply comp))]
    (fn [env] (-> env identity-D f))))