diff options
author | Eduardo Julian | 2014-12-11 01:24:39 -0400 |
---|---|---|
committer | Eduardo Julian | 2014-12-11 01:24:39 -0400 |
commit | 9e2f13474246faebc0ab3126208b99acd715ec3c (patch) | |
tree | e0552c37b1165aa3f881ea12aa7aa2f4c9465dbf /src/lang/type.clj | |
parent | 58bfb46ba16fc1db07e501be6fcc0c940ec7a350 (diff) |
+ Added an analysis phase.
+ Added a type-system.
Diffstat (limited to 'src/lang/type.clj')
-rw-r--r-- | src/lang/type.clj | 81 |
1 files changed, 80 insertions, 1 deletions
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))) |