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

…and separated compilation
MLstate · Mar 6, 2012 · 9f38934 · 9f38934
1 parent c6bd36c
commit 9f38934
Show file tree

Hide file tree

Showing 5 changed files with 54 additions and 35 deletions.
diff --git a/opa/main.ml b/opa/main.ml
@@ -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)

diff --git a/opa/pass_DbEngineImportation.ml b/opa/pass_DbEngineImportation.ml
@@ -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
 
diff --git a/opa/pass_DbEngineImportation.mli b/opa/pass_DbEngineImportation.mli
@@ -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
diff --git a/opa/s3Passes.ml b/opa/s3Passes.ml
@@ -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 ->

diff --git a/opa/s3Passes.mli b/opa/s3Passes.mli
@@ -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 :