blob: 998c658aca28581d7167e971f417c388de24931d (
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
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
|
(.module:
lux
(lux (control [monad #+ do]
["ex" exception #+ exception:])
(data [product]
[maybe]
["e" error #+ Error]
[bool "bool/" Eq<Bool>]
[text "text/" Hash<Text>]
text/format
(coll [list "list/" Fold<List>]
(dictionary ["dict" unordered #+ Dict])
(set ["set" unordered #+ Set])))
(lang [syntax #+ Aliases])
[io #+ Process "process/" Monad<Process>]
(concurrency [atom #+ Atom atom])
(world [file #+ File]
[blob #+ Blob]))
[///io]
[//description]
[//influences]
[//])
(do-template [<name>]
[(exception: #export (<name> {message Text})
message)]
[Module-Is-Not-Cached]
[Cannot-Pre-Load-Cache-More-Than-Once]
[Cannot-Delete-Cached-File]
[Cannot-Load-Definition]
)
(def: cache
(Atom //.Cache)
(atom //.empty))
(def: #export (load name)
(-> Text (Process Module))
(do io.Monad<IO>
[cache (atom.read cache)]
(case (dict.get name cache)
(#.Some module)
(process/wrap module)
#.None
(io.throw Module-Is-Not-Cached name))))
(def: #export (cached target-dir)
(-> File (Process (List File)))
(do io.Monad<Process>
[roots (file.files target-dir)
root-modules (monad.map @ (: (-> File (Process (List File)))
(function (recur file)
(do @
[is-dir? (file.directory? file)]
(if is-dir?
(do @
[subs (file.files file)
cached-subs (monad.map @ recur subs)]
(wrap (list& (maybe.assume (///io.module target-dir file))
(list.concat cached-subs))))
(wrap (list))))))
roots)]
(wrap (list.concat root-modules))))
(def: (delete file)
(-> File (Process Top))
(do io.Monad<Process>
[deleted? (file.delete file)]
(if deleted?
(wrap [])
(io.throw Cannot-Delete-Cached-File file))))
(def: (un-install target-dir module-name)
(-> File Text (Process Top))
(do io.Monad<Process>
[#let [module-dir (///io.file target-dir module-name)]
files (file.files module-dir)
can-delete-module-dir? (<| (:: @ map (list.every? (bool/= true)))
(monad.map @ (function (_ file)
(do @
[? (file.directory? file)]
(if ?
(wrap false)
(do @
[_ (delete file)]
(wrap true)))))
files))]
(if can-delete-module-dir?
(delete module-dir)
(wrap []))))
(def: no-aliases Aliases (dict.new text.Hash<Text>))
(def: (source description)
(-> Text Source)
[["" +1 +0] +0 description])
(def: (load-module source-dirs target-dir module-name)
(-> (List File) File Text (Process (List [Text Module])))
(do io.Monad<Process>
[#let [_ (log! (format "load-module #0: " module-name))]
description (file.read (///io.file target-dir (format module-name "/" //.descriptor-name)))
#let [_ (log! (format "load-module #1: " module-name))]]
(case (do e.Monad<Error>
[#let [_ (log! (format "load-module #1 #0: " module-name))]
[_ description] (syntax.read "" no-aliases (source (///io.blob-to-text description)))
#let [_ (log! (format "load-module #1 #1: " module-name))]]
(//description.read description))
(#e.Success [lux-file module])
(do @
[#let [_ (log! (format "load-module #2: " module-name " " lux-file))]
[file-name current-source-code] (///io.read source-dirs module-name)
#let [_ (log! (format "load-module #3: " module-name " " file-name))]]
(if (and (text/= lux-file file-name)
(n/= (get@ #.module-hash module)
(text/hash current-source-code)))
(wrap (list [module-name module]))
(do @
[_ (un-install target-dir module-name)]
(wrap (list)))))
(#e.Error error)
(do @
[#let [_ (log! "load-module #2 ERROR")]
_ (un-install target-dir module-name)]
(wrap (list))))))
(type: Loader (-> Ident Blob (Error Top)))
(def: (install target-dir load-def module-name module)
(-> File Loader Text Module (Process Module))
(do io.Monad<Process>
[definitions (monad.map @ (: (-> [Text Definition] (Process [Text Definition]))
(function (_ [def-name [def-type def-annotations _]])
(do @
[def-blob (file.read (///io.file target-dir (format module-name "/" def-name)))
#let [def-ident [module-name def-name]]]
(case (load-def def-ident def-blob)
(#e.Success def-value)
(wrap [def-name [def-type def-annotations def-value]])
(#e.Error error)
(io.throw Cannot-Load-Definition
(format "Definition: " (%ident def-ident) "\n"
" Error:\n" error "\n"))))))
(get@ #.definitions module))]
(wrap (set@ #.definitions definitions module))))
(def: (pre-load' source-dirs target-dir load-def)
(-> (List File) File Loader (Process //.Cache))
(do io.Monad<Process>
[#let [_ (log! "pre-load' #0")]
cached (cached target-dir)
#let [_ (log! (format "pre-load' #1 " (%list %t cached)))]
candidate-cache (|> cached
(monad.map @ (load-module source-dirs target-dir))
(:: @ map (|>> list.concat
(dict.from-list text.Hash<Text>))))
#let [_ (log! "pre-load' #2")]
#let [candidate-entries (dict.entries candidate-cache)
raw-influences (list/fold (function (_ [candidate-name candidate-module] influences)
(list/fold (//influences.track candidate-name)
influences
(get@ #.imports candidate-module)))
//influences.empty
candidate-entries)
pruned-influences (list/fold (function (_ [candidate-name candidate-module] influences)
(if (list.every? (function (_ module-name)
(dict.contains? module-name candidate-cache))
(get@ #.imports candidate-module))
influences
(//influences.untrack candidate-name influences)))
raw-influences
candidate-entries)
valid-cache (list/fold (function (_ candidate cache)
(if (dict.contains? candidate pruned-influences)
cache
(dict.remove candidate cache)))
candidate-cache
(dict.keys candidate-cache))]
#let [_ (log! "pre-load' #3")]]
(|> (dict.entries valid-cache)
(monad.map @ (function (_ [module-name module])
(do @
[#let [_ (log! (format " PRE INSTALL: " module-name))]
loaded-module (install target-dir load-def module-name module)
#let [_ (log! (format "POST INSTALL: " module-name))]]
(wrap [module-name loaded-module]))))
(:: @ map (dict.from-list text.Hash<Text>)))))
(def: (set-cache cache)
(-> //.Cache (Process Top))
(do io.Monad<IO>
[swapped? (atom.compare-and-swap //.empty cache ..cache)]
(if swapped?
(wrap (#e.Success []))
(io.throw Cannot-Pre-Load-Cache-More-Than-Once ""))))
(def: #export (pre-load source-dirs target-dir load-def)
(-> (List File) File Loader (Process Top))
(do io.Monad<Process>
[loaded-cache (pre-load' source-dirs (///io.platform-target target-dir) load-def)]
(set-cache loaded-cache)))
(def: #export (clean target-dir wanted-modules)
(-> File (Set Text) (Process Top))
(do io.Monad<Process>
[cached (cached target-dir)
_ (|> cached
(list.filter (bool.complement (set.member? wanted-modules)))
(monad.map @ (un-install target-dir)))]
(wrap [])))
|
