blob: 820024153b2178fe559d5283d3d3ca234aa286ad (
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
|
(.module:
lux
(lux (control [monad #+ do]
["p" parser]
["ex" exception #+ exception:]
pipe)
(concurrency [promise #+ Promise]
[stm #+ Var STM])
(data ["e" error #+ Error]
[maybe]
[product]
[text "text/" Eq<Text>]
text/format
(coll [list "list/" Functor<List> Fold<List>]
(dictionary ["dict" unordered #+ Dict])))
[macro]
(macro [code]
["s" syntax])
[io #+ IO Process io]
[host])
(luxc ["&" lang]
(lang [".L" module])))
(do-template [<name>]
[(exception: #export (<name> {message Text})
message)]
[Invalid-Imports]
[Module-Cannot-Import-Itself]
[Circular-Dependency]
)
(host.import: (java/util/concurrent/Future a)
(get [] #io a))
(host.import: (java/util/concurrent/CompletableFuture a)
(new [])
(complete [a] boolean)
(#static [a] completedFuture [a] (CompletableFuture a)))
(type: Import
{#module Text
#alias Text})
(def: import (s.Syntax Import) (s.tuple (p.seq s.text s.text)))
(def: compilations
(Var (Dict Text (CompletableFuture (Error Lux))))
(stm.var (dict.new text.Hash<Text>)))
(def: (promise-to-future promise)
(All [a] (-> (Promise a) (Future a)))
(let [future (CompletableFuture::new [])]
(exec (:: promise.Functor<Promise> map
(function (_ value) (CompletableFuture::complete [value] future))
promise)
future)))
(def: from-io
(All [a] (-> (IO a) (Process a)))
(:: io.Monad<IO> map (|>> #e.Success)))
(def: (translate-dependency translate-module dependency compiler)
(-> (-> Text Lux (Process Lux))
(-> Text Lux (IO (Future (Error Lux)))))
(<| (Future::get [])
promise-to-future
(do promise.Monad<Promise>
[[new? future] (stm.commit (: (STM [Bit (CompletableFuture (Error Lux))])
(do stm.Monad<STM>
[current-compilations (stm.read compilations)]
(case (dict.get dependency current-compilations)
(#.Some ongoing)
(wrap [false ongoing])
#.None
(do @
[#let [pending (: (CompletableFuture (Error Lux))
(CompletableFuture::new []))]
_ (stm.write (dict.put dependency pending current-compilations)
compilations)]
(wrap [true pending]))))))]
(if new?
(exec (promise.future (io (CompletableFuture::complete [(io.run (translate-module dependency compiler))]
future)))
(wrap future))
(wrap future)))))
(def: compiled?
(-> Module Bit)
(|>> (get@ #.module-state)
(case>
(^or #.Cached #.Compiled)
true
_
false)))
(def: (merge-modules current-module from-dependency from-current)
(-> Text (List [Text Module]) (List [Text Module]) (List [Text Module]))
(|> from-dependency
(list.filter (|>> product.right compiled?))
(list/fold (function (_ [dep-name dep-module] total) (&.pl-put dep-name dep-module total))
from-current)))
(def: (merge-compilers current-module dependency total)
(-> Text Lux Lux Lux)
(|> total
(update@ #.modules (merge-modules current-module (get@ #.modules dependency)))
(set@ #.seed (get@ #.seed dependency))))
(def: #export (translate-imports translate-module annotations)
(-> (-> Text Lux (Process Lux))
Code
(Meta (Process Lux)))
(do macro.Monad<Meta>
[_ (moduleL.set-annotations annotations)
current-module macro.current-module-name
imports (let [imports (|> (macro.get-tuple-ann (ident-for #.imports) annotations)
(maybe.default (list)))]
(case (s.run imports (p.some import))
(#e.Success imports)
(wrap imports)
(#e.Error error)
(&.throw Invalid-Imports (%code (code.tuple imports)))))
dependencies (monad.map @ (: (-> [Text Text] (Meta (IO (Future (Error Lux)))))
(function (_ [dependency alias])
(do @
[_ (&.assert Module-Cannot-Import-Itself current-module
(not (text/= current-module dependency)))
already-seen? (moduleL.exists? dependency)
circular-dependency? (if already-seen?
(moduleL.active? dependency)
(wrap false))
_ (&.assert Circular-Dependency (format "From: " current-module "\n"
" To: " dependency)
(not circular-dependency?))
_ (moduleL.import dependency)
_ (if (text/= "" alias)
(wrap [])
(moduleL.alias alias dependency))
compiler macro.get-compiler]
(if already-seen?
(wrap (io (CompletableFuture::completedFuture [(#e.Success compiler)])))
(wrap (translate-dependency translate-module dependency compiler))))))
imports)
compiler macro.get-compiler]
(wrap (do io.Monad<Process>
[dependencies (monad.seq io.Monad<Process> (list/map from-io dependencies))
dependencies (|> dependencies
(list/map (Future::get []))
(monad.seq io.Monad<Process>))]
(wrap (list/fold (merge-compilers current-module) compiler dependencies))))))
|
