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