blob: c30f612256ef3ee43769479b68388dbaf3deb6dd (
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
|
(;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>]
[dict #+ Dict]))
[macro]
(macro [code]
["s" syntax])
[io #+ IO Process io]
[host])
(luxc ["&" lang]
(lang [";L" module])))
(exception: #export Invalid-Imports)
(exception: #export Module-Cannot-Import-Itself)
(exception: #export 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 Compiler))))
(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 Compiler (Process Compiler))
(-> Text Compiler (IO (Future (Error Compiler)))))
(<| (Future.get [])
promise-to-future
(do promise;Monad<Promise>
[[new? future] (stm;commit (: (STM [Bool (CompletableFuture (Error Compiler))])
(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 Compiler))
(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 Bool)
(|>. (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 Compiler Compiler Compiler)
(|> total
(update@ #;modules (merge-modules current-module (get@ #;modules dependency)))
(set@ #;seed (get@ #;seed dependency))))
(def: #export (translate-imports translate-module annotations)
(-> (-> Text Compiler (Process Compiler))
Code
(Meta (Process Compiler)))
(do macro;Monad<Meta>
[_ (moduleL;set-annotations annotations)
current-module macro;current-module-name
#let [_ (log! (format "{translate-imports} " current-module))]
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 Compiler)))))
(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))))))
|
