blob: 2f708867ecff6bdb0beecc0b8545fcf4f5133ba8 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
|
(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)))
|
