blob: 76effa0dca3cffc8979c9eec61c598bfb0d0d5e7 (
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
103
104
105
106
|
(.module:
[lux (#- function)
[abstract
monad]
[control
["ex" exception (#+ exception:)]]
[data
["." maybe]
["." text
format]
[collection
["." list ("#@." fold monoid monad)]]]
["." type
["." check]]
["." macro]]
["." // #_
["#." scope]
["#." type]
["#." inference]
["#/" //
["#." extension]
[//
["/" analysis (#+ Analysis Operation Phase)]]]])
(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 {functionT Type} {functionC Code} {arguments (List Code)})
(ex.report ["Function type" (%type functionT)]
["Function" (%code functionC)]
["Arguments" (|> arguments
list.enumerate
(list@map (.function (_ [idx argC])
(format (%n idx) " " (%code argC))))
(text.join-with text.new-line))]))
(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 functionC argsC+)
(-> Phase Type Analysis Code (List Code) (Operation Analysis))
(<| (/.with-stack cannot-apply [functionT functionC argsC+])
(do ///.monad
[[applyT argsA+] (//inference.general analyse functionT argsC+)])
(wrap (/.apply [functionA argsA+]))))
|
