Skip to content
This repository
Newer
Older
100644 289 lines (188 sloc) 9.247 kb
fccc6851 »
2011-06-21 Initial open-source release
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
87 |+> ("ConvertStructure2", S3.pass_ConvertStructure2 ())
88
89 |> PH.old_handler
90 "ReplaceCompileTimeDirective" S2.pass_ReplaceCompileTimeDirective
91
92 |> PH.old_if_handler
93 "StaticInclusionDirectory" S2.pass_static_inclusion_directory
94
95 |> PH.old_if_handler
96 "StaticInclusions" S2.pass_static_inclusions
97
98 |> PH.old_if_handler ~if_:If.server
99 "ServerEntryPoint" S2.pass_resolve_server_entry_point
100
101 (* inserting doctype directive for a collection later
102 currently always enable until an automated test verify that nobody breaks it
103 *)
104 |+> ((*PH.old_if_handler ~if_:If.generate_interface, *)
105 "AddDocApiDirectives", (S3.pass_AddDocApiDirectives ()))
106
107 |> PH.old_if_handler
108 "TupleTypeGeneration" S2.pass_tuple_types
109
110 |+> ("Reorder", (S3.pass_ReorderToplevel ()))
111
112 |+> ("RewriteModules", (S3.pass_RewriteModules ()))
113
114 |> PH.old_if_handler ~if_:If.server
115 "AddingServer" S2.pass_adding_server
116
117 (**********************************************)
118 (* QML AST PASSES *****************************)
119 |+> ("SAtoQML", S3.pass_SaToQml)
120
121 |+> ("AddCSS", S3.pass_AddCSS)
122
123 |+> ("FunActionLifting", S3.pass_FunActionLifting)
124
125 |+> ("TypesDefinitions", S3.pass_TypesDefinitions)
126
127 |+> ("DbSchemaGeneration", S3.pass_DbSchemaGeneration)
128
129 |+> ("DbPathCoercion", S3.pass_DbPathCoercion)
130
131 |+> ("MacroExpansion", S3.pass_MacroExpansion)
132
133 |+> ("Typing", S3.pass_Typing)
134
135 (* Extracting interesting types for documentation *)
136 |+> ("DocApiGeneration", S3.pass_DocApiGeneration)(*~if_:If.generate_interface*)
137
138 |+> ("CheckPatternMatching", S3.pass_CheckPatternMatching)
139
140 |+> ("WarnCoerce", S3.pass_WarnCoerce)
141
142 |+> ("CompileRecursiveValues", S3.pass_CompileRecursiveValues)
143
144 (*|+> ("Retyping", S3.pass_Retyping)*)
145
146 |+> ("DbAccessorsGeneration", S3.pass_DbAccessorsGeneration)
147
148 |+> ("DbCodeGeneration", S3.pass_DbCodeGeneration)
149
150 |> PH.handler ~count_time:false "EndOfSeparateCompilation" (S3.pass_EndOfSeparateCompilation (fun e -> e
151
152 |+> ("BypassHoisting", S3.pass_BypassHoisting)
153
154 |+> ("RegisterFields", S3.pass_RegisterFields)
155
156 |?> (If.undot,
157 "Undot", S3.pass_QmlUndot)
158
159 |+> ("CodingDirectives", S3.pass_CodingDirectives)
160
161 <?> (If.closure,
162 ("EnrichMagic", S3.pass_EnrichMagic),
163 ("EnrichMagicPurge", S3.pass_EnrichMagicPurge))
164
165 |+> ("SimplifyEquality", S3.pass_SimplifyEquality)
166
167 |+> ("SimplifyMagic", S3.pass_SimplifyMagic)
168
169 |+> ("JustReorder1", S3.pass_ReorderEnvGen)
170
171 |> PH.old_if_handler
172 "EarlyLambdaLifting" S2.pass_EarlyLambdaLifting
173
174 (**********************************************)
175 (* SLICED PASSES ******************************)
176 |> PH.old_if_handler ~if_:(PH.neg (If.separated or If.server))
177 "NoSlicerRemoveJsIdent" S2.pass_PurgeS3Directives
178
179 <?> (If.server or If.separated or If.slicer_test,
180 ("Slicing" , S3.pass_SimpleSlicer),
181 ("NoSlicing", S3.pass_NoSlicer))
182
183 |+> ("Assertion", S3.pass_Assertion)
184
185 |?> (PH.neg (If.no_discard_of_unused_stdlib or If.separated),
186 "SlicedCleaning", S3.pass_SlicedCleaning)
187
188 (* Fun action resolution, step 2/3 *)
189 |?> (If.server or If.separated,
190 "FunActionEnvSerialize", S3.pass_FunActionEnvSerialize)
191
192 (* Explicit instantiation *)
193 |?> (If.explicit_instantiation,
194 "ExplicitInstantiation", S3.pass_ExplicitInstantiation)
195
196 |?> (If.explicit_instantiation,
197 "OptimizeExplicitInstantiation", S3.pass_OptimizeExplicitInstantiation)
198
199 (* Fun action resolution, step 3/3 *)
200 |?> (If.server or If.separated,
201 "FunActionJsCallGeneration", S3.pass_FunActionJsCallGeneration)
202
203 |+> ("PurgeTypeDirectives", S3.pass_PurgeTypeDirective)
204
205 |?> (If.explicit_instantiation & (If.server or If.separated),
206 "ResolveRemoteCalls", S3.pass_ResolveRemoteCalls)
207
208 |?> (If.explicit_instantiation,
209 "InsertMemoizedTypes", S3.pass_InsertMemoizedTypes)
210
211 |+> ("JustReorder2", S3.pass_SlicedReorder)
212
213 (* ***********************************************)
214 (* FINAL COMPILATION *****************************)
215 |+> ("SlicedToFinal", S3.pass_SlicedToFinal)
216
217 (* ***********************************************)
218 (* FINAL CLIENT COMPILATION **********************)
219 (* ~precond:[check_ident_final_client] *)
220
221 |?> (If.cps_client,
222 "ClientQmlCpsRewriter", S3.pass_ClientCpsRewriter)
223
224 |?> (If.closure,
225 "ClientQmlLambdaLifting", S3.pass_ClientLambdaLifting)
226
227 (* |?> (If.closure,
228 "ClientQmlUncurry", S3.pass_ClientQmlUncurry)
229
230 |?> (If.closure,
231 "ClientQmlClosure", S3.pass_ClientQmlClosure)*)
232
233 |?> (If.constant_sharing_client,
234 "QmlClientConstantSharing", S3.pass_ClientQmlConstantSharing)
235 (* Insert client code like a js string on server (if
236 necessary) - After that client qml code have no more
237 place to exist and it dropped *)
238 |+> ("JavascriptCompilation", S3.pass_JavascriptCompilation)
239
240 |?> (If.server or If.separated,
241 "ResolveJsIdent", S3.pass_ResolveJsIdent)
242
243 <?> (If.server or If.separated,
244 ("GenerateServerAst", S3.pass_GenerateServerAst true),
245 ("DontGenerateServerAst", S3.pass_GenerateServerAst false))
246
247 (* ***********************************************)
248 (* FINAL SERVER COMPILATION **********************)
249
250 |?> (PH.neg (If.separated or If.server),
251 "NoSlicerCleanClientBypass", S3.pass_Remove_client_bypass)
252
253 |+> ("CleanLambdaLiftingDirectives", S3.pass_CleanLambdaLiftingDirectives)
254
255 |?> (If.init,
256 "InitializeBslValues", S3.pass_InitializeBslValues)
257
258 |+> ("ServerQmlCpsRewriter", S3.pass_ServerCpsRewriter)
259
260 |> PH.old_if_handler ~if_:If.closure (* ~precond:[check_ident_final] *)
261 "ServerQmlLambdaLifting" (S2.pass_LambdaLifting2 ~typed:false ~side:`server)
262
263 |> PH.old_if_handler ~if_:If.closure
264 "ServerQmlUncurry" (S2.pass_QmlUncurry2 ~typed:false ~side:`server)
265
266 |?> (If.closure,
267 "ServerQmlClosure", S3.pass_ServerQmlClosure)
268
269 |?> (If.constant_sharing,
270 "QmlConstantSharing", S3.pass_QmlConstantSharing)
271
272 |+> ("QmlCompilation", S3.pass_QmlCompilation)
273
274 |+> ("OcamlSplitCode", S3.pass_OcamlSplitCode)
275
276 |+> ("OcamlGeneration", S3.pass_OcamlGeneration)
277
278 |+> ("OcamlCompilation", S3.pass_OcamlCompilation)
279
280 |+> ("CleanUp", S3.pass_CleanUp)
281
282 |+> ("ByeBye", S3.pass_ByeBye)
283
284 |> PH.return )) (* end of the pass endOfSeparateCompilation *)
285 |> PH.return )) (* end of the pass loadObjects *)
286 |> PH.return
287
288 let () = OManager.exit 0
Something went wrong with that request. Please try again.