blob: a95412e420491e7881e5adee08c15fffd5ee75ca (
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
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
|
(.module:
[lux (#- function)
[control
monad
["ex" exception (#+ exception:)]]
[data
["." maybe]
["." text
format]
[collection
["." list ("list/." fold monoid monad)]]]
["." type
["." check]]
["." macro]]
["." // (#+ Analysis Operation Phase)
["." scope]
["//." type]
["." inference]
["/." //
["." extension]]])
(exception: #export (cannot-analyse {expected Type} {function Text} {argument Text} {body Code})
(ex.report ["Type" (%type expected)]
["Function" function]
["Argument" argument]
["Body" (%code body)]))
(exception: #export (cannot-apply {function Type} {arguments (List Code)})
(ex.report ["Function" (%type function)]
["Arguments" (|> arguments
list.enumerate
(list/map (.function (_ [idx argC])
(format text.new-line " " (%n idx) " " (%code argC))))
(text.join-with ""))]))
(def: #export (function analyse function-name arg-name body)
(-> Phase Text Text Code (Operation Analysis))
(do ///.monad
[functionT (extension.lift macro.expected-type)]
(loop [expectedT functionT]
(///.with-stack cannot-analyse [expectedT function-name arg-name body]
(case expectedT
(#.Named name unnamedT)
(recur unnamedT)
(#.Apply argT funT)
(case (type.apply (list argT) funT)
(#.Some value)
(recur value)
#.None
(///.fail (ex.construct cannot-analyse [expectedT function-name arg-name body])))
(^template [<tag> <instancer>]
(<tag> _)
(do @
[[_ instanceT] (//type.with-env <instancer>)]
(recur (maybe.assume (type.apply (list instanceT) expectedT)))))
([#.UnivQ check.existential]
[#.ExQ check.var])
(#.Var id)
(do @
[?expectedT' (//type.with-env
(check.read id))]
(case ?expectedT'
(#.Some expectedT')
(recur expectedT')
## Inference
_
(do @
[[input-id inputT] (//type.with-env check.var)
[output-id outputT] (//type.with-env check.var)
#let [functionT (#.Function inputT outputT)]
functionA (recur functionT)
_ (//type.with-env
(check.check expectedT functionT))]
(wrap functionA))
))
(#.Function inputT outputT)
(<| (:: @ map (.function (_ [scope bodyA])
(#//.Function (scope.environment scope) bodyA)))
//.with-scope
## Functions have access not only to their argument, but
## also to themselves, through a local variable.
(scope.with-local [function-name expectedT])
(scope.with-local [arg-name inputT])
(//type.with-type outputT)
(analyse body))
_
(///.fail "")
)))))
(def: #export (apply analyse functionT functionA argsC+)
(-> Phase Type Analysis (List Code) (Operation Analysis))
(<| (///.with-stack cannot-apply [functionT argsC+])
(do ///.monad
[[applyT argsA+] (inference.general analyse functionT argsC+)])
(wrap (//.apply [functionA argsA+]))))
|
