Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 293 lines (190 sloc) 9.427 kb
fccc685 Initial open-source release
MLstate authored
1 (*
2 Copyright © 2011 MLstate
3
4 This file is part of OPA.
5
6 OPA is free software: you can redistribute it and/or modify it under the
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
10 OPA is distributed in the hope that it will be useful, but WITHOUT ANY
11 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
13 more details.
14
15 You should have received a copy of the GNU Affero General Public License
16 along with OPA. If not, see <http://www.gnu.org/licenses/>.
17 *)
18
19 (** The main program for the OPA compiler. S3 version. *)
20
21 (* Opening the generic pass system. *)
22 module PH = PassHandler
23
24 (* FIXME: define a module InfixOperators in PassHandler *)
25 (* this could by the only case an 'open' is allowed *)
26 let (|+>) = PH.(|+>)
27 let (|>) = PH.(|>)
28 let (<?>) = PH.(<?>)
29 let (&) = PH.(&)
30 let (|?>) = PH.(|?>)
31 let (or) = PH.(or)
32
33 (* Shorthands for accessing options of compilation *)
34 module If = Main_utils.If
35
36 (* The deprecated passes *)
37 (* FIXME: adapt to the new PassHandler *)
38 module S2 = Passes
39
40 (* S3 implementations. *)
41 module S3 = S3Passes
42
43 (* Set title of generic pass system. *)
44 let _ = PH.set_title "Opa.exe"
45
46 (* Load warnings of opa s3 applications *)
47 let _ = WarningClass.load_set S3Warnings.warning_set
48
49 (* Run all passes *)
50 let () =
51 (**********************************************)
52 (* INITIALIZATION *****************************)
53 PH.init
54
55 |+> ("Welcome", S3.pass_Welcome)
56
57 |+> ("CheckOptions", S3.pass_CheckOptions)
58
59 |+> ("AddStdlibFiles", S3.pass_AddStdlibFiles)
60
61 |> PH.old_handler
62 "OpenFiles" S2.pass_OpenFiles
63
64 |+> ("PreProcess", S3.pass_PreProcess)
65
66 |+> ("Parse", S3.pass_Parse)
67
68 |+> ("RegisterAppSrcCode", S3.pass_RegisterAppSrcCode)
69
70 (**********************************************)
71 (* SURFACE AST PASSES *************************)
72 |> PH.handler ~count_time:false "LoadObjects" (S3.pass_LoadObjects (fun e -> e
73
74 |+> ("BslLoading", S3.pass_BslLoading)
75
76 |+> ("ConvertStructure", S3.pass_ConvertStructure)
77
78 |> PH.old_handler
79 "CheckOptionsConsistency" Pass_CheckOptionsConsistency.process_code
80
81 |+> ("CheckServerEntryPoint", S3.pass_CheckServerEntryPoint)
82
83 |+> ("ParserGeneration", S3.pass_ParserGeneration)
84
85 |+> ("CheckDuplication", S3.pass_CheckDuplication)
86
4692879 @OpaOnWindowsNow [feature] Internationalisation: add @i18n directive and start support fo...
OpaOnWindowsNow authored
87 (* I18n, exit if generating template *)
88 |+> ("I18nAndComputedString", S3.pass_I18nAndComputedString)
89
fccc685 Initial open-source release
MLstate authored
90 |+> ("ConvertStructure2", S3.pass_ConvertStructure2 ())
91
51f92b4 [feature] adding: a no_client_calls directive
Hugo Heuzard authored
92 |+> ("TreatNoClientCalls",S3.pass_TreatNoClientCalls ())
93
fccc685 Initial open-source release
MLstate authored
94 |> PH.old_handler
95 "ReplaceCompileTimeDirective" S2.pass_ReplaceCompileTimeDirective
96
97 |> PH.old_if_handler
98 "StaticInclusionDirectory" S2.pass_static_inclusion_directory
99
100 |> PH.old_if_handler
101 "StaticInclusions" S2.pass_static_inclusions
102
103 |> PH.old_if_handler ~if_:If.server
104 "ServerEntryPoint" S2.pass_resolve_server_entry_point
105
106 (* inserting doctype directive for a collection later
107 currently always enable until an automated test verify that nobody breaks it
108 *)
109 |+> ((*PH.old_if_handler ~if_:If.generate_interface, *)
110 "AddDocApiDirectives", (S3.pass_AddDocApiDirectives ()))
111
112 |> PH.old_if_handler
113 "TupleTypeGeneration" S2.pass_tuple_types
114
115 |+> ("Reorder", (S3.pass_ReorderToplevel ()))
116
117 |+> ("RewriteModules", (S3.pass_RewriteModules ()))
118
119 |> PH.old_if_handler ~if_:If.server
120 "AddingServer" S2.pass_adding_server
121
122 (**********************************************)
123 (* QML AST PASSES *****************************)
124 |+> ("SAtoQML", S3.pass_SaToQml)
125
126 |+> ("AddCSS", S3.pass_AddCSS)
127
128 |+> ("FunActionLifting", S3.pass_FunActionLifting)
129
130 |+> ("TypesDefinitions", S3.pass_TypesDefinitions)
131
132 |+> ("DbSchemaGeneration", S3.pass_DbSchemaGeneration)
133
134 |+> ("DbPathCoercion", S3.pass_DbPathCoercion)
135
136 |+> ("MacroExpansion", S3.pass_MacroExpansion)
137
138 |+> ("Typing", S3.pass_Typing)
139
140 (* Extracting interesting types for documentation *)
141 |+> ("DocApiGeneration", S3.pass_DocApiGeneration)(*~if_:If.generate_interface*)
142
143 |+> ("CheckPatternMatching", S3.pass_CheckPatternMatching)
144
145 |+> ("WarnCoerce", S3.pass_WarnCoerce)
146
147 |+> ("CompileRecursiveValues", S3.pass_CompileRecursiveValues)
148
8edc001 [feature] adding: an @async directive on bindings to perform asynchronou...
Valentin Gatien-Baron authored
149 |+> ("RewriteAsyncLambda", S3.pass_RewriteAsyncLambda)
150
fccc685 Initial open-source release
MLstate authored
151 (*|+> ("Retyping", S3.pass_Retyping)*)
152
153 |+> ("DbAccessorsGeneration", S3.pass_DbAccessorsGeneration)
154
155 |+> ("DbCodeGeneration", S3.pass_DbCodeGeneration)
156
00818f9 [refactor] removing most typing directives sooner
Valentin Gatien-Baron authored
157 (* could be just after typing, if dbgen didn't complain that it can't find its coercions :/ *)
158 |+> ("PurgeTypeDirectivesAfterTyping", S3.pass_PurgeTypeDirectiveAfterTyping)
159
fccc685 Initial open-source release
MLstate authored
160 |> PH.handler ~count_time:false "EndOfSeparateCompilation" (S3.pass_EndOfSeparateCompilation (fun e -> e
161
162 |+> ("BypassHoisting", S3.pass_BypassHoisting)
163
164 |+> ("RegisterFields", S3.pass_RegisterFields)
165
166 |?> (If.undot,
167 "Undot", S3.pass_QmlUndot)
168
169 |+> ("CodingDirectives", S3.pass_CodingDirectives)
170
171 <?> (If.closure,
172 ("EnrichMagic", S3.pass_EnrichMagic),
173 ("EnrichMagicPurge", S3.pass_EnrichMagicPurge))
174
175 |+> ("SimplifyEquality", S3.pass_SimplifyEquality)
176
177 |+> ("SimplifyMagic", S3.pass_SimplifyMagic)
178
179 |+> ("JustReorder1", S3.pass_ReorderEnvGen)
180
181 |> PH.old_if_handler
182 "EarlyLambdaLifting" S2.pass_EarlyLambdaLifting
183
184 (**********************************************)
185 (* SLICED PASSES ******************************)
186 <?> (If.server or If.separated or If.slicer_test,
187 ("Slicing" , S3.pass_SimpleSlicer),
188 ("NoSlicing", S3.pass_NoSlicer))
189
190 |+> ("Assertion", S3.pass_Assertion)
191
192 |?> (PH.neg (If.no_discard_of_unused_stdlib or If.separated),
193 "SlicedCleaning", S3.pass_SlicedCleaning)
194
195 (* Fun action resolution, step 2/3 *)
196 |?> (If.server or If.separated,
197 "FunActionEnvSerialize", S3.pass_FunActionEnvSerialize)
198
199 (* Explicit instantiation *)
200 |?> (If.explicit_instantiation,
201 "ExplicitInstantiation", S3.pass_ExplicitInstantiation)
202
203 |?> (If.explicit_instantiation,
204 "OptimizeExplicitInstantiation", S3.pass_OptimizeExplicitInstantiation)
205
206 (* Fun action resolution, step 3/3 *)
207 |?> (If.server or If.separated,
208 "FunActionJsCallGeneration", S3.pass_FunActionJsCallGeneration)
209
00818f9 [refactor] removing most typing directives sooner
Valentin Gatien-Baron authored
210 |+> ("PurgeTypeDirectivesAfterEi", S3.pass_PurgeTypeDirectiveAfterEi)
fccc685 Initial open-source release
MLstate authored
211
212 |?> (If.explicit_instantiation & (If.server or If.separated),
213 "ResolveRemoteCalls", S3.pass_ResolveRemoteCalls)
214
215 |?> (If.explicit_instantiation,
216 "InsertMemoizedTypes", S3.pass_InsertMemoizedTypes)
217
218 |+> ("JustReorder2", S3.pass_SlicedReorder)
219
220 (* ***********************************************)
221 (* FINAL COMPILATION *****************************)
222 |+> ("SlicedToFinal", S3.pass_SlicedToFinal)
223
224 (* ***********************************************)
225 (* FINAL CLIENT COMPILATION **********************)
226 (* ~precond:[check_ident_final_client] *)
227
228 |?> (If.cps_client,
229 "ClientQmlCpsRewriter", S3.pass_ClientCpsRewriter)
230
231 |?> (If.closure,
232 "ClientQmlLambdaLifting", S3.pass_ClientLambdaLifting)
233
234 (* |?> (If.closure,
235 "ClientQmlUncurry", S3.pass_ClientQmlUncurry)
236
237 |?> (If.closure,
238 "ClientQmlClosure", S3.pass_ClientQmlClosure)*)
239
240 |?> (If.constant_sharing_client,
241 "QmlClientConstantSharing", S3.pass_ClientQmlConstantSharing)
242 (* Insert client code like a js string on server (if
243 necessary) - After that client qml code have no more
244 place to exist and it dropped *)
245 |+> ("JavascriptCompilation", S3.pass_JavascriptCompilation)
246
247 |?> (If.server or If.separated,
248 "ResolveJsIdent", S3.pass_ResolveJsIdent)
249
250 <?> (If.server or If.separated,
251 ("GenerateServerAst", S3.pass_GenerateServerAst true),
252 ("DontGenerateServerAst", S3.pass_GenerateServerAst false))
253
254 (* ***********************************************)
255 (* FINAL SERVER COMPILATION **********************)
256
257 |+> ("CleanLambdaLiftingDirectives", S3.pass_CleanLambdaLiftingDirectives)
258
259 |?> (If.init,
260 "InitializeBslValues", S3.pass_InitializeBslValues)
261
262 |+> ("ServerQmlCpsRewriter", S3.pass_ServerCpsRewriter)
263
264 |> PH.old_if_handler ~if_:If.closure (* ~precond:[check_ident_final] *)
265 "ServerQmlLambdaLifting" (S2.pass_LambdaLifting2 ~typed:false ~side:`server)
266
267 |> PH.old_if_handler ~if_:If.closure
268 "ServerQmlUncurry" (S2.pass_QmlUncurry2 ~typed:false ~side:`server)
269
270 |?> (If.closure,
271 "ServerQmlClosure", S3.pass_ServerQmlClosure)
272
273 |?> (If.constant_sharing,
274 "QmlConstantSharing", S3.pass_QmlConstantSharing)
275
276 |+> ("QmlCompilation", S3.pass_QmlCompilation)
277
278 |+> ("OcamlSplitCode", S3.pass_OcamlSplitCode)
279
280 |+> ("OcamlGeneration", S3.pass_OcamlGeneration)
281
282 |+> ("OcamlCompilation", S3.pass_OcamlCompilation)
283
284 |+> ("CleanUp", S3.pass_CleanUp)
285
286 |+> ("ByeBye", S3.pass_ByeBye)
287
288 |> PH.return )) (* end of the pass endOfSeparateCompilation *)
289 |> PH.return )) (* end of the pass loadObjects *)
290 |> PH.return
291
292 let () = OManager.exit 0
Something went wrong with that request. Please try again.