+ Added an analysis phase.

+ Added a type-system.

4 files changed, 393 insertions, 95 deletions

diff --git a/src/lang/analyser.clj b/src/lang/analyser.clj
new file mode 100644
index 000000000..a7f6a7dd5
--- /dev/null
+++ b/src/lang/analyser.clj
@@ -0,0 +1,191 @@
+(ns lang.analyser
+  (:refer-clojure :exclude [resolve])
+  (:require [clojure.core.match :refer [match]]
+            (lang [util :as &util :refer [exec return* return fail fail*
+                                          repeat-m try-m try-all-m map-m
+                                          apply-m within]]
+                  [parser :as &parser]
+                  [type :as &type])))
+
+(declare analyse-form)
+
+;; [Util]
+(defn ^:private with-env [env monad]
+  (fn [state]
+    (let [=return (monad (update-in state [:env] merge env))]
+      (match =return
+        [::&util/ok [?state ?value]]
+        [::&util/ok [(assoc ?state :env (:env state)) ?value]]
+        
+        _
+        =return))))
+
+(def ^:private module-name
+  (fn [state]
+    [::&util/ok [state (:name state)]]))
+
+(defn ^:private resolve [ident]
+  (fn [state]
+    (if-let [=ident (get-in state [:env ident])]
+      [::&util/ok [state =ident]]
+      [::&util/failure (str "Unresolved identifier: " ident)])))
+
+(defn ^:private define [name desc]
+  (fn [state]
+    [::&util/ok [(assoc-in state [:defs (:name state) name] desc) nil]]))
+
+(defn ^:private annotated [form type]
+  {:form form
+   :type type})
+
+(defmacro ^:private defanalyser [name match return]
+  `(def ~name
+     (fn [{[token# & left#] :forms :as state#}]
+       (match token#
+         ~match
+         (~return (assoc state# :forms left#))
+         _#
+         (fail* (str "Unmatched token: " token#))))))
+
+(defn analyse-form* [form]
+  (fn [state]
+    (let [old-forms (:forms state)
+          =return (analyse-form (assoc state :forms (list form)))]
+      (match =return
+        [::&util/ok [?state ?value]]
+        [::&util/ok [(assoc ?state :forms old-forms) ?value]]
+        
+        _
+        =return))))
+
+(defanalyser analyse-boolean
+  [::&parser/boolean ?boolean]
+  (return (annotated [::literal ?boolean] [::&type/object "java.lang.Boolean" []])))
+
+(defanalyser analyse-string
+  [::&parser/string ?string]
+  (return (annotated [::literal ?string] [::&type/object "java.lang.String" []])))
+
+(defanalyser analyse-variant
+  [::&parser/tagged ?tag ?value]
+  (exec [=value (analyse-form* ?value)]
+    (return (annotated [::variant ?tag =value] [::&type/variant ?tag (:type =value)]))))
+
+(defanalyser analyse-ident
+  [::&parser/ident ?name]
+  (exec [=ident (resolve ?name)]
+    (return (annotated [::ident ?name] =ident))))
+
+(defanalyser analyse-ann-class
+  [::&parser/ann-class ?class ?members]
+  (return (annotated [::ann-class ?class ?members] ::&type/nothing)))
+
+(defanalyser analyse-static-access
+  [::&parser/static-access ?class ?member]
+  (return (annotated [::static-access ?class ?member] ::&type/nothing)))
+
+(defanalyser analyse-dynamic-access
+  [::&parser/dynamic-access ?object ?member]
+  (exec [=object (analyse-form* ?object)]
+    (match ?member
+      [::&parser/fn-call [::&parser/ident ?method] ?args]
+      (exec [=args (map-m analyse-form* ?args)]
+        (return (annotated [::dynamic-access =object [?method =args]] ::&type/nothing))))))
+
+(defanalyser analyse-fn-call
+  [::&parser/fn-call [::&parser/ident ?fn] ?args]
+  (exec [name module-name
+         =args (map-m analyse-form* ?args)]
+    (return (annotated [::call [name ?fn] =args] ::&type/nothing))))
+
+(defanalyser analyse-if
+  [::&parser/if ?test ?then ?else]
+  (exec [=test (analyse-form* ?test)
+         =then (analyse-form* ?then)
+         =else (analyse-form* ?else)]
+    (return (annotated [::if =test =then =else] ::&type/nothing))))
+
+(defanalyser analyse-defclass
+  [::&parser/defclass ?name ?fields]
+  (let [=members {:fields (into {} (for [[class field] ?fields]
+                                     [field {:access ::public
+                                             :type class}]))}
+        =class [::class ?name =members]]
+    (exec [name module-name]
+      (return (annotated [::defclass [name ?name] =members] ::&type/nothing)))))
+
+(defanalyser analyse-definterface
+  [::&parser/definterface ?name ?members]
+  (let [=members {:methods (into {} (for [[method [inputs output]] ?members]
+                                      [method {:access ::public
+                                               :type [inputs output]}]))}
+        =interface [::interface ?name =members]]
+    (exec [name module-name]
+      (return (annotated [::definterface [name ?name] =members] ::&type/nothing)))))
+
+(defanalyser analyse-def
+  [::&parser/def ?usage ?value]
+  (match ?usage
+    [::&parser/ident ?name]
+    (exec [=value (analyse-form* ?value)
+           _ (define ?name {:mode ::constant
+                            :access ::public
+                            :type =value})]
+      (return (annotated [::def ?name =value] ::&type/nothing)))
+
+    [::&parser/fn-call [::&parser/ident ?name] ?args]
+    (let [args (for [a ?args]
+                 (match a
+                   [::&parser/ident ?ident]
+                   ?ident))]
+      (exec [[=function =args =return] (within :types (&type/fresh-function (count args)))
+             :let [_ (prn '[=function =args =return] [=function =args =return])]
+             :let [env (-> {}
+                           (assoc ?name =function)
+                           (into (map vector args =args)))
+                   _ (prn 'env env)]
+             =value (with-env env
+                      (analyse-form* ?value))
+             :let [_ (prn '=value =value)]
+             =function (within :types (exec [_ (&type/solve =return (:type =value))]
+                                        (&type/clean =function)))
+             :let [_ (prn '=function =function)]
+             _ (define ?name {:mode ::function
+                              :access ::public
+                              :type =function})]
+        (return (annotated [::def [?name args] =value] ::&type/nothing))))
+    ))
+
+(defanalyser analyse-module
+  [::&parser/module]
+  (exec [name module-name]
+    (return (annotated [::module name] ::&type/nothing))))
+
+(def ^:private analyse-form
+  (try-all-m [analyse-boolean
+              analyse-string
+              analyse-variant
+              analyse-ident
+              analyse-ann-class
+              analyse-static-access
+              analyse-dynamic-access
+              analyse-fn-call
+              analyse-if
+              analyse-defclass
+              analyse-definterface
+              analyse-def
+              analyse-module]))
+
+;; [Interface]
+(defn analyse [module-name tokens]
+  (match ((repeat-m analyse-form) {:name module-name,
+                                   :forms tokens
+                                   :env {}
+                                   :types &type/+init+})
+    [::&util/ok [?state ?forms]]
+    (if (empty? (:forms ?state))
+      ?forms
+      (assert false (str "Unconsumed input: " (pr-str (:forms ?state)))))
+    
+    [::&util/failure ?message]
+    (assert false ?message)))
diff --git a/src/lang/compiler.clj b/src/lang/compiler.clj
index dbc088668..1976c48e9 100644
--- a/src/lang/compiler.clj
+++ b/src/lang/compiler.clj
@@ -2,7 +2,9 @@
   (:refer-clojure :exclude [compile])
   (:require [clojure.string :as string]
             [clojure.core.match :refer [match]]
-            [lang.parser :as &parser]
+            (lang [type :as &type]
+                  [parser :as &parser]
+                  [analyser :as &analyser])
             :reload)
   (:import (org.objectweb.asm Opcodes
                               Label
@@ -12,21 +14,18 @@
 (declare compile-form)
 
 ;; [Utils/General]
+(def ^:private +variant-class+ "test2.Tagged")
+
 (defmacro ^:private defcompiler [name match body]
   `(defn ~name [~'*state*]
-     (let [~'*name* (:name ~'*state*)
-           ~'*writer* (:writer ~'*state*)
-           ~'*form* (:form ~'*state*)]
-       (match ~'*form*
+     (let [~'*writer* (:writer ~'*state*)]
+       (match (:form (:form ~'*state*))
          ~match
          (do ~body
            true)
          _#
          false))))
 
-(defn compile-form* [writer form]
-  (compile-form {:writer writer, :form form}))
-
 (defn ^:private unwrap-ident [ident]
   (match ident
     [::&parser/ident ?label]
@@ -40,78 +39,98 @@
 (defn ^:private ->class [class]
   (string/replace class #"\." "/"))
 
+(def ^:private ->package ->class)
+
 (defn ^:private ->type-signature [class]
   (case class
     "Void" "V"
     ;; else
     (str "L" (->class class) ";")))
 
+(defn ^:private ->java-sig [type]
+  (match type
+    [::&type/object ?name []]
+    (->type-signature ?name)
+
+    [::&type/variant ?tag ?value]
+    (->type-signature +variant-class+)))
+
 ;; [Utils/Compilers]
-(defcompiler ^:private compile-boolean
-  [::&parser/boolean ?boolean]
-  (if ?boolean
-    (.visitLdcInsn *writer* (int 1))
-    (.visitLdcInsn *writer* (int 0))))
+(defcompiler ^:private compile-literal
+  [::&analyser/literal ?literal]
+  (cond (string? ?literal)
+        (.visitLdcInsn *writer* ?literal)
+
+        (instance? java.lang.Boolean ?literal)
+        (if ?literal
+          ;; (.visitLdcInsn *writer* (int 1))
+          (.visitFieldInsn *writer* Opcodes/GETSTATIC (->class "java.lang.Boolean") "TRUE" (->type-signature "java.lang.Boolean"))
+          ;; (.visitLdcInsn *writer* (int 0))
+          (.visitFieldInsn *writer* Opcodes/GETSTATIC (->class "java.lang.Boolean") "FALSE" (->type-signature "java.lang.Boolean")))
 
-(defcompiler ^:private compile-string
-  [::&parser/string ?string]
-  (.visitLdcInsn *writer* ?string))
+        :else
+        (assert false (str "[Unknown literal type] " ?literal " : " (class ?literal)))))
 
 (defcompiler ^:private compile-ident
-  [::&parser/ident ?name]
+  [::&analyser/ident ?name]
   (doto *writer*
-    (.visitVarInsn Opcodes/ALOAD (int 0)))
-  ;; nil
-  )
+    (.visitVarInsn Opcodes/ALOAD (int 0))))
 
-(defcompiler ^:private compile-fn-call
-  [::&parser/fn-call [::&parser/ident ?fn] ?args]
+(defcompiler ^:private compile-call
+  [::&analyser/call [?owner-class ?fn] ?args]
   (do (doseq [arg ?args]
         (compile-form (assoc *state* :form arg)))
     (doto *writer*
-      (.visitMethodInsn Opcodes/INVOKESTATIC (->class *name*) ?fn "(Ljava/lang/Object;)Ljava/lang/Object;"))))
+      (.visitMethodInsn Opcodes/INVOKESTATIC (->class ?owner-class) ?fn "(Ljava/lang/Object;)Ljava/lang/Object;"))))
 
 (defcompiler ^:private compile-static-access
-  [::&parser/static-access ?class ?member]
+  [::&analyser/static-access ?class ?member]
   (doto *writer*
     (.visitFieldInsn Opcodes/GETSTATIC (->class ?class) ?member (->type-signature "java.io.PrintStream"))))
 
 (defcompiler ^:private compile-dynamic-access
-  [::&parser/dynamic-access ?object ?access]
-  (let [=object (compile-form (assoc *state* :form ?object))
-        method (match ?access
-                 [::&parser/fn-call [::&parser/ident ?method] ?args]
-                 (do (doseq [arg ?args]
-                       (compile-form (assoc *state* :form arg)))
-                   ?method))]
+  [::&analyser/dynamic-access ?object [?method ?args]]
+  (do (compile-form (assoc *state* :form ?object))
+    (doseq [arg ?args]
+      (compile-form (assoc *state* :form arg)))
     (doto *writer*
-      (.visitMethodInsn Opcodes/INVOKEVIRTUAL (->class "java.io.PrintStream") method "(Ljava/lang/Object;)V"))))
+      (.visitMethodInsn Opcodes/INVOKEVIRTUAL (->class "java.io.PrintStream") ?method "(Ljava/lang/Object;)V"))))
 
 (defcompiler ^:private compile-ann-class
-  [::&parser/ann-class ?class ?members]
+  [::&analyser/ann-class ?class ?members]
   nil)
 
 (defcompiler ^:private compile-if
-  [::&parser/if ?test ?then ?else]
+  [::&analyser/if ?test ?then ?else]
   (let [else-label (new Label)
         end-label (new Label)]
-    (compile-form (assoc *state* :form ?test))
-    (.visitJumpInsn *writer* Opcodes/IFEQ else-label)
-    (compile-form (assoc *state* :form ?then))
+    (println "PRE")
+    (assert (compile-form (assoc *state* :form ?test)) "CAN't COMPILE TEST")
+    (doto *writer*
+      (.visitMethodInsn Opcodes/INVOKEVIRTUAL (->class "java.lang.Boolean") "booleanValue" "()Z")
+      (.visitJumpInsn Opcodes/IFEQ else-label))
+    (assert (compile-form (assoc *state* :form ?then)) "CAN't COMPILE THEN")
     (doto *writer*
       (.visitJumpInsn Opcodes/GOTO end-label)
       (.visitLabel else-label))
-    (compile-form (assoc *state* :form ?else))
+    (assert (compile-form (assoc *state* :form ?else)) "CAN't COMPILE ELSE")
     (.visitLabel *writer* end-label)))
 
 (defcompiler ^:private compile-def
-  [::&parser/def ?form ?body]
+  [::&analyser/def ?form ?body]
   (match ?form
-    [::&parser/fn-call [::&parser/ident ?name] ?args]
+    (?name :guard string?)
+    (let [=type (:type ?body)
+          _ (prn '?body ?body)]
+      (doto (.visitField *writer* (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) ?name (->java-sig =type) nil nil)
+        (.visitEnd)))
+
+    [?name ?args]
     (if (= "main" ?name)
       (let [=method (doto (.visitMethod *writer* (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) ?name "([Ljava/lang/String;)V" nil nil)
                       (.visitCode))]
-        (compile-form (assoc *state* :writer =method :form ?body))
+        (prn 'FN/?body ?body)
+        (assert (compile-form (assoc *state* :writer =method :form ?body)) (str "Body couldn't compile: " (pr-str ?body)))
         (doto =method
           (.visitInsn Opcodes/RETURN)
           (.visitMaxs 0 0)
@@ -123,23 +142,21 @@
           (.visitInsn Opcodes/ARETURN)
           (.visitMaxs 0 0)
           (.visitEnd))))
-    [::&parser/ident ?name]
-    (doto (.visitField *writer* (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) ?name "Ljava/lang/Object;" nil nil)
-      (.visitEnd))
     ))
 
 (defcompiler ^:private compile-module
-  [::&parser/module]
+  [::&analyser/module ?name]
   (.visit *writer* Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
-          (->class *name*) nil "java/lang/Object" nil))
+          (->class ?name) nil "java/lang/Object" nil))
 
 (defcompiler ^:private compile-defclass
-  [::&parser/defclass ?name ?fields]
-  (let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
+  [::&analyser/defclass [?package ?name] ?members]
+  (let [parent-dir (->package ?package)
+        =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
                  (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
-                         (->class (str *name* "." ?name)) nil "java/lang/Object" nil))]
-    (doseq [[class field] ?fields]
-      (doto (.visitField =class Opcodes/ACC_PUBLIC field (->type-signature class) nil nil)
+                         (str parent-dir "/" ?name) nil "java/lang/Object" nil))]
+    (doseq [[field props] (:fields ?members)]
+      (doto (.visitField =class Opcodes/ACC_PUBLIC field (->type-signature (:type props)) nil nil)
         (.visitEnd)))
     (doto (.visitMethod =class Opcodes/ACC_PUBLIC "<init>" "()V" nil nil)
       (.visitCode)
@@ -149,46 +166,45 @@
       (.visitMaxs 0 0)
       (.visitEnd))
     (.visitEnd =class)
-    (let [parent-dir (->class *name*)]
-      (.mkdirs (java.io.File. parent-dir))
-      (with-open [stream (java.io.BufferedOutputStream. (java.io.FileOutputStream. (str parent-dir "/" ?name ".class")))]
-        (.write stream (.toByteArray =class))))))
+    (.mkdirs (java.io.File. parent-dir))
+    (with-open [stream (java.io.BufferedOutputStream. (java.io.FileOutputStream. (str parent-dir "/" ?name ".class")))]
+      (.write stream (.toByteArray =class)))))
 
 (defcompiler ^:private compile-definterface
-  [::&parser/definterface ?name ?members]
-  (let [=interface (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
+  [::&analyser/definterface [?package ?name] ?members]
+  (let [parent-dir (->package ?package)
+        =interface (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
                      (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_ABSTRACT Opcodes/ACC_INTERFACE)
-                             (->class (str *name* "." ?name)) nil "java/lang/Object" nil))]
-    (doseq [[?method [?args ?return]] ?members
-            :let [signature (str "(" (reduce str "" (map ->type-signature ?args)) ")" (->type-signature ?return))]]
+                             (str parent-dir "/" ?name) nil "java/lang/Object" nil))]
+    (doseq [[?method ?props] (:methods ?members)
+            :let [[?args ?return] (:type ?props)
+                  signature (str "(" (reduce str "" (map ->type-signature ?args)) ")" (->type-signature ?return))]]
       (.visitMethod =interface (+ Opcodes/ACC_PUBLIC) ?method signature nil nil))
     (.visitEnd =interface)
-    (let [parent-dir (->class *name*)]
-      (.mkdirs (java.io.File. parent-dir))
-      (with-open [stream (java.io.BufferedOutputStream. (java.io.FileOutputStream. (str parent-dir "/" ?name ".class")))]
-        (.write stream (.toByteArray =interface))))))
-
-(let [+tagged+ "test2/Tagged"]
-  (defcompiler ^:private compile-tagged
-    [::&parser/tagged ?tag ?value]
-    (do (prn 'compile-tagged ?tag ?value)
-      (doto *writer*
-        (.visitTypeInsn Opcodes/NEW +tagged+)
-        (.visitInsn Opcodes/DUP)
-        (.visitMethodInsn Opcodes/INVOKESPECIAL +tagged+ "<init>" "()V")
-        (.visitInsn Opcodes/DUP)
-        (.visitLdcInsn ?tag)
-        (.visitFieldInsn Opcodes/PUTFIELD +tagged+ "tag" "Ljava/lang/String;")
-        (.visitInsn Opcodes/DUP))
-      (compile-form (assoc *state* :form ?value))
-      (doto *writer*
-        (.visitFieldInsn Opcodes/PUTFIELD +tagged+ "value" "Ljava/lang/Object;"))
-      )))
-
-(let [+compilers+ [compile-boolean
-                   compile-string
+    (.mkdirs (java.io.File. parent-dir))
+    (with-open [stream (java.io.BufferedOutputStream. (java.io.FileOutputStream. (str parent-dir "/" ?name ".class")))]
+      (.write stream (.toByteArray =interface)))))
+
+(defcompiler ^:private compile-variant
+  [::&analyser/variant ?tag ?value]
+  (let [variant-class* (->class +variant-class+)]
+    (prn 'compile-variant ?tag ?value)
+    (doto *writer*
+      (.visitTypeInsn Opcodes/NEW variant-class*)
+      (.visitInsn Opcodes/DUP)
+      (.visitMethodInsn Opcodes/INVOKESPECIAL variant-class* "<init>" "()V")
+      (.visitInsn Opcodes/DUP)
+      (.visitLdcInsn ?tag)
+      (.visitFieldInsn Opcodes/PUTFIELD variant-class* "tag" "Ljava/lang/String;")
+      (.visitInsn Opcodes/DUP))
+    (assert (compile-form (assoc *state* :form ?value)) (pr-str "Can't compile value: " ?value))
+    (doto *writer*
+      (.visitFieldInsn Opcodes/PUTFIELD variant-class* "value" "Ljava/lang/Object;"))
+    ))
+
+(let [+compilers+ [compile-literal
                    compile-ident
-                   compile-fn-call
+                   compile-call
                    compile-static-access
                    compile-dynamic-access
                    compile-ann-class
@@ -197,10 +213,11 @@
                    compile-module
                    compile-defclass
                    compile-definterface
-                   compile-tagged]]
+                   compile-variant]]
   (defn ^:private compile-form [state]
     (prn 'compile-form/state state)
-    (some #(% state) +compilers+)))
+    (or (some #(% state) +compilers+)
+        (assert false (str "Can't compile: " (pr-str (:form state)))))))
 
 ;; [Interface]
 (defn compile [class-name inputs]
@@ -209,8 +226,7 @@
         ;; (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
         ;;          (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
         ;;                  "output" nil "java/lang/Object" nil))
-        state {:name class-name
-               :writer =class
+        state {:writer =class
                :form nil}]
     ;; (doto (.visitMethod =class Opcodes/ACC_PUBLIC "<init>" "()V" nil nil)
     ;;   (.visitCode)
@@ -223,19 +239,22 @@
       (when (not (compile-form (assoc state :form input)))
         (assert false input)))
     ;; (doall (map #(compile-form (assoc state :form %)) inputs))
+    (prn 'inputs inputs)
     (when-let [constants (seq (for [input inputs
-                                    :let [payload (match input
-                                                    [::&parser/def [::&parser/ident ?name] ?body]
+                                    :let [payload (match (:form input)
+                                                    [::&analyser/def (?name :guard string?) ?body]
                                                     [?name ?body]
                                                     _
                                                     nil)]
                                     :when payload]
                                 payload))]
       (let [=init (doto (.visitMethod =class Opcodes/ACC_PUBLIC "<clinit>" "()V" nil nil)
-                    (.visitCode))]
+                    (.visitCode))
+            state* (assoc state :writer =init)
+            class-name* (->class class-name)]
         (doseq [[?name ?body] constants]
-          (do (compile-form (assoc state :writer =init :form ?body))
-            (.visitFieldInsn =init Opcodes/PUTSTATIC (->class class-name) ?name "Ljava/lang/Object;")))
+          (do (assert (compile-form (assoc state* :form ?body)) (str "Couldn't compile init: " (pr-str ?body)))
+            (.visitFieldInsn =init Opcodes/PUTSTATIC class-name* ?name (->java-sig (:type ?body)))))
         (doto =init
           (.visitInsn Opcodes/RETURN)
           (.visitMaxs 0 0)
diff --git a/src/lang/type.clj b/src/lang/type.clj
index cab0ebeec..2f708867e 100644
--- a/src/lang/type.clj
+++ b/src/lang/type.clj
@@ -1,4 +1,83 @@
-(ns lang.type)
+(ns lang.type
+  (:refer-clojure :exclude [resolve])
+  (:require [clojure.core.match :refer [match]]
+            [lang.util :as &util :refer [exec return* return fail fail*
+                                         repeat-m try-m try-all-m map-m
+                                         apply-m]]))
 
+;; [Util]
+(def ^:private success (return nil))
 
+(defn ^:private resolve [id]
+  (fn [state]
+    (if-let [top+bottom (get-in state [::mappings id])]
+      [::&util/ok [state top+bottom]]
+      [::&util/failure (str "Unknown type-var: " id)])))
 
+(defn ^:private update [id top bottom]
+  (fn [state]
+    (if-let [top+bottom (get-in state [::mappings id])]
+      [::&util/ok [(assoc-in state [::mappings id] [top bottom]) nil]]
+      [::&util/failure (str "Unknown type-var: " id)])))
+
+;; [Interface]
+(def +init+ {::counter 0
+             ::mappings {}})
+
+(def fresh-var
+  (fn [state]
+    (let [id (::counter state)]
+      [::&util/ok [(-> state
+                       (update-in [::counter] inc)
+                       (assoc-in [::mappings id] [::any ::nothing]))
+                   [::var id]]])))
+
+(defn fresh-function [num-args]
+  (exec [=args (map-m (constantly fresh-var) (range num-args))
+         =return fresh-var
+         :let [=function [::function =args =return]]]
+    (return [=function =args =return])))
+
+(defn solve [expected actual]
+  (match [expected actual]
+    [::any _]
+    success
+
+    [_ ::nothing]
+    success
+
+    [_ [::var ?id]]
+    (exec [[=top =bottom] (resolve ?id)]
+      (try-all-m [(exec [_ (solve expected =top)]
+                    success)
+                  (exec [_ (solve =top expected)
+                         _ (solve expected =bottom)
+                         _ (update ?id expected =bottom)]
+                    success)]))
+
+    [[::var ?id] _]
+    (exec [[=top =bottom] (resolve ?id)]
+      (try-all-m [(exec [_ (solve =bottom actual)]
+                    success)
+                  (exec [_ (solve actual =bottom)
+                         _ (solve =top actual)
+                         _ (update ?id =top actual)]
+                    success)]))
+
+    [_ _]
+    (fail (str "Can't solve types: " (pr-str expected actual)))
+    ))
+
+(defn clean [type]
+  (match type
+    [::var ?id]
+    (exec [[=top =bottom] (resolve ?id)]
+      (clean =top))
+
+    [::function ?args ?return]
+    (exec [=args (map-m clean ?args)
+           =return (clean ?return)]
+      (return [::function =args =return]))
+
+    _
+    (return type)))
diff --git a/src/lang/util.clj b/src/lang/util.clj
index d9745e9ab..ec93ac27f 100644
--- a/src/lang/util.clj
+++ b/src/lang/util.clj
@@ -112,3 +112,12 @@
 (def get-state
   (fn [state]
     (return* state state)))
+
+(defn within [slot monad]
+  (fn [state]
+    (let [=return (monad (get state slot))]
+      (match =return
+        [::ok [?state ?value]]
+        [::ok [(assoc state slot ?state) ?value]]
+        _
+        =return))))