blob: 73b018c95021e4f0693c554cd6b8daf2e9a6df57 (
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
|
(.module:
[lux (#- Source)
[control
[monad (#+ do)]
["ex" exception (#+ exception:)]]
[data
["." product]
["." error (#+ Error)]
[text ("text/." Hash<Text>)
format
["." encoding]]
[collection
["." dictionary]]]
[type (#+ :share)]
["." macro]
[world
["." file (#+ File)]]]
[//
["." cli (#+ Configuration)]
[meta
[io
["." context]]]]
[/
["." init]
["." syntax (#+ Aliases)]
["." phase
["." analysis
["." module]
[".A" expression]]
["." translation (#+ Host Bundle)]
["." statement
[".S" total]]
["." extension]]]
## (luxc [cache]
## [cache/description]
## [cache/io])
)
(type: Reader
(-> .Source (Error [.Source Code])))
(def: (reader current-module aliases)
(-> Text Aliases (analysis.Operation Reader))
(function (_ [bundle state])
(let [[cursor offset source-code] (get@ #.source state)]
(#error.Success [[bundle state]
(syntax.parse current-module aliases ("lux text size" source-code))]))))
(def: (read reader)
(-> Reader (analysis.Operation Code))
(function (_ [bundle compiler])
(case (reader (get@ #.source compiler))
(#error.Error error)
(#error.Error error)
(#error.Success [source' output])
(#error.Success [[bundle (set@ #.source source' compiler)]
output]))))
## ## (def: (write-module target-dir file-name module-name module artifacts)
## ## (-> File Text Text Module Artifacts (Process Any))
## ## (do io.Monad<Process>
## ## [_ (monad.map @ (product.uncurry (&io.write target-dir))
## ## (dictionary.entries artifacts))]
## ## (&io.write target-dir
## ## (format module-name "/" cache.descriptor-name)
## ## (encoding.to-utf8 (%code (cache/description.write file-name module))))))
(type: #export (Platform ! anchor expression statement)
{#host (Host expression statement)
#phase (translation.Phase anchor expression statement)
#runtime (translation.Operation anchor expression statement Any)
#file-system (file.System !)})
(type: #export Source
{#name Text
#code Text})
(with-expansions [<Platform> (as-is (Platform ! anchor expression statement))
<Operation> (as-is (statement.Operation anchor expression statement Any))
<Compiler> (as-is (statement.State+ anchor expression statement))
<Bundle> (as-is (Bundle anchor expression statement))]
(def: (begin-module-compilation module-name source)
(All [anchor expression statement]
(-> Text Source <Operation>))
(statement.lift-analysis
(do phase.Monad<Operation>
[_ (module.create (text/hash (get@ #code source)) module-name)
_ (analysis.set-current-module module-name)]
(analysis.set-source-code (init.source (get@ #name source) (get@ #code source))))))
(def: end-module-compilation
(All [anchor expression statement]
(-> Text <Operation>))
(|>> module.set-compiled
statement.lift-analysis))
(def: (module-compilation-iteration reader)
(-> Reader (All [anchor expression statement] <Operation>))
(<| (phase.timed (name-of ..module-compilation-iteration) "ITERATION")
(do phase.Monad<Operation>
[code (statement.lift-analysis
(do @
[code (<| (phase.timed (name-of ..module-compilation-iteration) "syntax")
(..read reader))
#let [[cursor _] code]
_ (analysis.set-cursor cursor)]
(wrap code)))
_ (<| (phase.timed (name-of ..module-compilation-iteration) "PHASE")
(totalS.phase code))]
init.refresh)))
(def: (module-compilation-loop module-name)
(All [anchor expression statement]
(-> Text <Operation>))
(do phase.Monad<Operation>
[reader (statement.lift-analysis
(..reader module-name syntax.no-aliases))]
(function (_ state)
(loop [state state]
(case (module-compilation-iteration reader state)
(#error.Success [state' output])
(recur state')
(#error.Error error)
(if (ex.match? syntax.end-of-file error)
(#error.Success [state []])
(#error.Error error)))))))
(def: (perform-module-compilation module-name source)
(All [anchor expression statement]
(-> Text Source <Operation>))
(do phase.Monad<Operation>
[_ (begin-module-compilation module-name source)
_ (module-compilation-loop module-name)]
(end-module-compilation module-name)))
(def: #export (compile-module platform configuration compiler)
(All [! anchor expression statement]
(-> <Platform> Configuration <Compiler> (! <Compiler>)))
(do (:: (get@ #file-system platform) &monad)
[source (context.read (get@ #file-system platform)
(get@ #cli.sources configuration)
(get@ #cli.module configuration))
## _ (&io.prepare-module target-dir (get@ #cli.module configuration))
## _ (write-module target-dir file-name (get@ #cli.module configuration) module artifacts)
]
(<| (:: @ map product.left)
(:: (get@ #file-system platform) lift)
(phase.run' compiler)
(:share [! anchor expression statement]
{<Platform>
platform}
{<Operation>
(perform-module-compilation (get@ #cli.module configuration) source)}))))
(def: #export (initialize platform configuration translation-bundle)
(All [! anchor expression statement]
(-> <Platform> Configuration <Bundle> (! <Compiler>)))
(|> platform
(get@ #runtime)
statement.lift-translation
(phase.run' (init.state (get@ #host platform)
(get@ #phase platform)
translation-bundle))
(:: error.Functor<Error> map product.left)
(:: (get@ #file-system platform) lift))
## (case (runtimeT.translate ## (initL.compiler (io.run js.init))
## (initL.compiler (io.run hostL.init-host))
## )
## ## (#error.Success [compiler disk-write])
## ## (do @
## ## [_ (&io.prepare-target target)
## ## _ disk-write
## ## ## _ (cache/io.pre-load sources target (commonT.load-definition compiler))
## ## ]
## ## (wrap (|> compiler
## ## (set@ [#.info #.mode] #.Build))))
## (#error.Success [compiler [runtime-bc function-bc]])
## (do @
## [_ (&io.prepare-target target)
## ## _ (&io.write target (format hostL.runtime-class ".class") runtime-bc)
## ## _ (&io.write target (format hostL.function-class ".class") function-bc)
## ## _ (cache/io.pre-load sources target (commonT.load-definition compiler))
## ]
## (wrap (|> compiler
## (set@ [#.info #.mode] #.Build))))
## (#error.Error error)
## (io.fail error))
)
(def: #export (compile platform configuration translation-bundle)
(All [! anchor expression statement]
(-> <Platform> Configuration <Bundle> (! Any)))
(do (:: (get@ #file-system platform) &monad)
[compiler (initialize platform configuration translation-bundle)
_ (compile-module platform (set@ #cli.module syntax.prelude configuration) compiler)
_ (compile-module platform configuration compiler)
## _ (cache/io.clean target ...)
]
(wrap (log! "Compilation complete!"))))
)
|
