blob: 1432308f8b915672d2a7fee45e6e3fb63dad3807 (
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
(lux (control monad)
(data [maybe]
[text]
text/format
(coll [list "list/" Fold<List> Monoid<List> Monad<List>]))
[meta #+ Monad<Meta>]
(meta [type]
(type ["tc" check])))
(luxc ["&" base]
(lang ["la" analysis #+ Analysis])
["&;" scope]
(analyser ["&;" common]
["&;" inference])))
## [Analysers]
(def: #export (analyse-function analyse func-name arg-name body)
(-> &;Analyser Text Text Code (Meta Analysis))
(do Monad<Meta>
[functionT meta;expected-type]
(loop [expectedT functionT]
(&;with-stacked-errors
(function [_] (format "Functions require function types: " (type;to-text expectedT)))
(case expectedT
(#;Named name unnamedT)
(recur unnamedT)
(#;Apply argT funT)
(case (type;apply (list argT) funT)
(#;Some value)
(recur value)
#;None
(&;fail (format "Cannot apply type " (%type funT) " to type " (%type argT))))
(#;UnivQ _)
(do @
[[var-id var] (&;with-type-env
tc;existential)]
(recur (maybe;assume (type;apply (list var) expectedT))))
(#;ExQ _)
(&common;with-var
(function [[var-id var]]
(recur (maybe;assume (type;apply (list var) expectedT)))))
(#;Var id)
(do @
[? (&;with-type-env
(tc;concrete? id))]
(if ?
(do @
[expectedT' (&;with-type-env
(tc;read id))]
(recur expectedT'))
## Inference
(&common;with-var
(function [[input-id inputT]]
(&common;with-var
(function [[output-id outputT]]
(do @
[#let [funT (#;Function inputT outputT)]
funA (recur funT)
funT' (&;with-type-env
(tc;clean output-id funT))
concrete-input? (&;with-type-env
(tc;concrete? input-id))
funT'' (if concrete-input?
(&;with-type-env
(tc;clean input-id funT'))
(wrap (type;univ-q +1 (&inference;replace-var input-id +1 funT'))))
_ (&;with-type-env
(tc;check expectedT funT''))]
(wrap funA))
))))))
(#;Function inputT outputT)
(<| (:: @ map (|>. #la;Function))
&;with-scope
## Functions have access not only to their argument, but
## also to themselves, through a local variable.
(&scope;with-local [func-name expectedT])
(&scope;with-local [arg-name inputT])
(&;with-expected-type outputT)
(analyse body))
_
(&;fail "")
)))))
(def: #export (analyse-apply analyse funcT funcA args)
(-> &;Analyser Type Analysis (List Code) (Meta Analysis))
(&;with-stacked-errors
(function [_] (format "Cannot apply function " (%type funcT)
" to args: " (|> args (list/map %code) (text;join-with " "))))
(do Monad<Meta>
[expected meta;expected-type
[applyT argsA] (&inference;apply-function analyse funcT args)
_ (&;with-type-env
(tc;check expected applyT))]
(wrap (la;apply argsA funcA)))))
|
