Permalink
Browse files

[fix] compiler, database: Some fix about database engine importation …

…and separated compilation
  • Loading branch information...
BourgerieQuentin committed Mar 6, 2012
1 parent c6bd36c commit 9f38934a8bd82f4f9134c5b96fdb594cd4a22cf8
Showing with 54 additions and 35 deletions.
  1. +2 −2 opa/main.ml
  2. +33 −12 opa/pass_DbEngineImportation.ml
  3. +2 −0 opa/pass_DbEngineImportation.mli
  4. +13 −14 opa/s3Passes.ml
  5. +4 −7 opa/s3Passes.mli
View
@@ -69,12 +69,12 @@ let () =
|+> ("RegisterAppSrcCode", S3.pass_RegisterAppSrcCode)
- |+> ("DbEngineImportation", S3.pass_DbEngineImportation)
-
(**********************************************)
(* SURFACE AST PASSES *************************)
|> PH.handler ~count_time:false "LoadObjects" (S3.pass_LoadObjects (fun e -> e
+ |+> ("DbEngineImportation", S3.pass_DbEngineImportation)
+
|+> ("BslLoading", S3.pass_BslLoading)
|+> ("ConvertStructure", S3.pass_ConvertStructure)
@@ -31,7 +31,7 @@ struct
(* Original ident * stub ident, stub type, expanded stub *)
type t = DbAst.engine list
- let pass = "ResolveRemoteCalls"
+ let pass = "DbEngineImporation"
let pp f _ = Format.pp_print_string f "<dummy>"
end
@@ -49,7 +49,6 @@ let import_packages engine =
| `db3 -> "stdlib.database.db3"
| `mongo -> "stdlib.database.mongo"
in
- ObjectFiles.import_package package label;
ObjectFiles.add_compiler_package package
let process_code ~stdlib code =
@@ -60,20 +59,42 @@ let process_code ~stdlib code =
| Some engine -> [engine]
in
let engines =
- R.fold_with_name ~deep:true
- (fun _ acc t -> t@acc)
+ R.fold_with_name ~optional:true ~deep:true
+ (fun _name acc t -> t@acc)
engines
in
- let engines = List.fold_left
- (fun acc -> function
- | (SA.Database (_, _, opt), _) -> opt.DbAst.backend :: acc
- | _ -> acc
- ) engines code
+ let engines = engines @ !r in
+ let padecl, dbdecl, engines = List.fold_left
+ (fun (padecl, dbdecl, engines) -> function
+ | (SA.Database (_, id::_, opt), _) ->
+ padecl,
+ Option.map (fun dbdecl -> StringSet.add id dbdecl) dbdecl,
+ (opt.DbAst.backend :: engines)
+ | (SA.Database (_, _, opt), _) ->
+ padecl, None, opt.DbAst.backend :: engines
+ | (SA.NewDbDef (DbAst.Db_TypeDecl ((DbAst.Decl_fld p::_), _)), _) ->
+ StringSet.add p padecl, dbdecl, engines
+ | _ -> padecl, dbdecl, engines
+ ) (StringSet.empty, Some StringSet.empty, engines) code
+ in
+ let engines =
+ match dbdecl with
+ | None -> engines (* Case if default database *)
+ | Some dbdecl ->
+ if StringSet.is_empty (StringSet.diff padecl dbdecl) then engines
+ else `db3 :: engines (* Some path are not included in a database,
+ load default engine. *)
in
let engines = List.uniq_unsorted engines in
- r := engines;
- List.iter import_packages engines;
- if ObjectFiles.compilation_mode() = `compilation then R.save engines
+ r := engines
+
+let finalize ~stdlib =
+ if stdlib then (
+ List.iter import_packages !r;
+ match ObjectFiles.compilation_mode() with
+ | `compilation -> R.save !r
+ | _ -> ()
+ )
let get_engines () = !r
@@ -21,4 +21,6 @@
*)
val process_code : stdlib:bool -> ('ident, 'dir) SurfaceAst.code -> unit
+val finalize : stdlib:bool -> unit
+
val get_engines : unit -> QmlAst.Db.engine list
View
@@ -507,20 +507,6 @@ let pass_Print =
e
)
-let pass_DbEngineImportation =
- PassHandler.make_pass
- (fun e ->
- let (_, user_files) = e.PH.env in
- let stdlib = e.PH.options.O.stdlib in
- List.iter
- (fun pfile ->
- Pass_DbEngineImportation.process_code ~stdlib
- pfile.SurfaceAstPassesTypes.parsedFile_lcode
- ) user_files;
- e
- )
-
-
let pass_LoadObjects k =
PH.make_pass
(fun env ->
@@ -557,6 +543,19 @@ let pass_CheckDuplication =
EnvUtils.create_sa_both_env_uids env both_env
)
+let pass_DbEngineImportation =
+ PassHandler.make_pass
+ (fun e ->
+ let files = e.PH.env in
+ let stdlib = e.PH.options.O.stdlib in
+ List.iter
+ (fun (_, _, pfile) ->
+ Pass_DbEngineImportation.process_code ~stdlib pfile
+ ) files;
+ Pass_DbEngineImportation.finalize ~stdlib;
+ e
+ )
+
let pass_BslLoading =
PassHandler.make_pass
(fun e ->
View
@@ -1,5 +1,5 @@
(*
- Copyright © 2011 MLstate
+ Copyright © 2011, 2012 MLstate
This file is part of OPA.
@@ -122,12 +122,9 @@ val pass_RegisterAppSrcCode :
) opa_pass
val pass_DbEngineImportation :
- ((
- ( SurfaceAst.parsing_directive SurfaceAstPassesTypes.parsed_file list
- * SurfaceAst.parsing_directive SurfaceAstPassesTypes.parsed_file list
- ) as 'parsed_files)
- ,
- 'parsed_files)
+ ((((SurfaceAst.nonuid, SurfaceAst.parsing_directive)
+ SurfaceAst.code_elt) ObjectFiles.parsed_code) as 'parsed_code
+ , 'parsed_code)
opa_pass
val pass_BslLoading :

0 comments on commit 9f38934

Please sign in to comment.