blob: 5403026cb9a650b4dac6936e2f0ca1aa48c80fea (
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
|
(;module:
lux
(lux (control monad
["ex" exception #+ exception:])
(data [maybe]
[text]
text/format
(coll [list "list/" Fold<List> Monoid<List> Monad<List>]))
[meta]
(meta [code]
[type]
(type ["tc" check])))
(luxc ["&" lang]
(lang ["&;" scope]
["la" analysis #+ Analysis]
(analysis ["&;" common]
["&;" inference])
[";L" variable #+ Variable])))
(exception: #export Invalid-Function-Type)
(exception: #export Cannot-Apply-Function)
## [Analysers]
(def: #export (analyse-function analyse func-name arg-name body)
(-> &;Analyser Text Text Code (Meta Analysis))
(do meta;Monad<Meta>
[functionT meta;expected-type]
(loop [expectedT functionT]
(&;with-stacked-errors
(function [_] (Invalid-Function-Type (%type expectedT)))
(case expectedT
(#;Named name unnamedT)
(recur unnamedT)
(#;Apply argT funT)
(case (type;apply (list argT) funT)
(#;Some value)
(recur value)
#;None
(&;throw Invalid-Function-Type (%type expectedT)))
(^template [<tag> <instancer>]
(<tag> _)
(do @
[[_ instanceT] (&;with-type-env <instancer>)]
(recur (maybe;assume (type;apply (list instanceT) expectedT)))))
([#;UnivQ tc;existential]
[#;ExQ tc;var])
(#;Var id)
(do @
[?expectedT' (&;with-type-env
(tc;read id))]
(case ?expectedT'
(#;Some expectedT')
(recur expectedT')
_
## Inference
(do @
[[input-id inputT] (&;with-type-env tc;var)
[output-id outputT] (&;with-type-env tc;var)
#let [funT (#;Function inputT outputT)]
funA (recur funT)
_ (&;with-type-env
(tc;check expectedT funT))]
(wrap funA))
))
(#;Function inputT outputT)
(<| (:: @ map (function [[scope bodyA]]
(` ("lux function" [(~@ (list/map code;int (variableL;environment scope)))]
(~ bodyA)))))
&;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 [_]
(Cannot-Apply-Function (format " Function: " (%type funcT) "\n"
"Arguments:" (|> args
list;enumerate
(list/map (function [[idx argC]]
(format "\n " (%n idx) " " (%code argC))))
(text;join-with "")))))
(do meta;Monad<Meta>
[[applyT argsA] (&inference;general analyse funcT args)]
(wrap (la;apply argsA funcA)))))
|
