Skip to content
This repository
Browse code

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

…and separated compilation
  • Loading branch information...
commit 9f38934a8bd82f4f9134c5b96fdb594cd4a22cf8 1 parent c6bd36c
Quentin Bourgerie BourgerieQuentin authored
4 opa/main.ml
@@ -69,12 +69,12 @@ let () =
69 69
70 70 |+> ("RegisterAppSrcCode", S3.pass_RegisterAppSrcCode)
71 71
72   - |+> ("DbEngineImportation", S3.pass_DbEngineImportation)
73   -
74 72 (**********************************************)
75 73 (* SURFACE AST PASSES *************************)
76 74 |> PH.handler ~count_time:false "LoadObjects" (S3.pass_LoadObjects (fun e -> e
77 75
  76 + |+> ("DbEngineImportation", S3.pass_DbEngineImportation)
  77 +
78 78 |+> ("BslLoading", S3.pass_BslLoading)
79 79
80 80 |+> ("ConvertStructure", S3.pass_ConvertStructure)
45 opa/pass_DbEngineImportation.ml
@@ -31,7 +31,7 @@ struct
31 31 (* Original ident * stub ident, stub type, expanded stub *)
32 32 type t = DbAst.engine list
33 33
34   - let pass = "ResolveRemoteCalls"
  34 + let pass = "DbEngineImporation"
35 35 let pp f _ = Format.pp_print_string f "<dummy>"
36 36 end
37 37
@@ -49,7 +49,6 @@ let import_packages engine =
49 49 | `db3 -> "stdlib.database.db3"
50 50 | `mongo -> "stdlib.database.mongo"
51 51 in
52   - ObjectFiles.import_package package label;
53 52 ObjectFiles.add_compiler_package package
54 53
55 54 let process_code ~stdlib code =
@@ -60,20 +59,42 @@ let process_code ~stdlib code =
60 59 | Some engine -> [engine]
61 60 in
62 61 let engines =
63   - R.fold_with_name ~deep:true
64   - (fun _ acc t -> t@acc)
  62 + R.fold_with_name ~optional:true ~deep:true
  63 + (fun _name acc t -> t@acc)
65 64 engines
66 65 in
67   - let engines = List.fold_left
68   - (fun acc -> function
69   - | (SA.Database (_, _, opt), _) -> opt.DbAst.backend :: acc
70   - | _ -> acc
71   - ) engines code
  66 + let engines = engines @ !r in
  67 + let padecl, dbdecl, engines = List.fold_left
  68 + (fun (padecl, dbdecl, engines) -> function
  69 + | (SA.Database (_, id::_, opt), _) ->
  70 + padecl,
  71 + Option.map (fun dbdecl -> StringSet.add id dbdecl) dbdecl,
  72 + (opt.DbAst.backend :: engines)
  73 + | (SA.Database (_, _, opt), _) ->
  74 + padecl, None, opt.DbAst.backend :: engines
  75 + | (SA.NewDbDef (DbAst.Db_TypeDecl ((DbAst.Decl_fld p::_), _)), _) ->
  76 + StringSet.add p padecl, dbdecl, engines
  77 + | _ -> padecl, dbdecl, engines
  78 + ) (StringSet.empty, Some StringSet.empty, engines) code
  79 + in
  80 + let engines =
  81 + match dbdecl with
  82 + | None -> engines (* Case if default database *)
  83 + | Some dbdecl ->
  84 + if StringSet.is_empty (StringSet.diff padecl dbdecl) then engines
  85 + else `db3 :: engines (* Some path are not included in a database,
  86 + load default engine. *)
72 87 in
73 88 let engines = List.uniq_unsorted engines in
74   - r := engines;
75   - List.iter import_packages engines;
76   - if ObjectFiles.compilation_mode() = `compilation then R.save engines
  89 + r := engines
  90 +
  91 +let finalize ~stdlib =
  92 + if stdlib then (
  93 + List.iter import_packages !r;
  94 + match ObjectFiles.compilation_mode() with
  95 + | `compilation -> R.save !r
  96 + | _ -> ()
  97 + )
77 98
78 99 let get_engines () = !r
79 100
2  opa/pass_DbEngineImportation.mli
@@ -21,4 +21,6 @@
21 21 *)
22 22 val process_code : stdlib:bool -> ('ident, 'dir) SurfaceAst.code -> unit
23 23
  24 +val finalize : stdlib:bool -> unit
  25 +
24 26 val get_engines : unit -> QmlAst.Db.engine list
27 opa/s3Passes.ml
@@ -507,20 +507,6 @@ let pass_Print =
507 507 e
508 508 )
509 509
510   -let pass_DbEngineImportation =
511   - PassHandler.make_pass
512   - (fun e ->
513   - let (_, user_files) = e.PH.env in
514   - let stdlib = e.PH.options.O.stdlib in
515   - List.iter
516   - (fun pfile ->
517   - Pass_DbEngineImportation.process_code ~stdlib
518   - pfile.SurfaceAstPassesTypes.parsedFile_lcode
519   - ) user_files;
520   - e
521   - )
522   -
523   -
524 510 let pass_LoadObjects k =
525 511 PH.make_pass
526 512 (fun env ->
@@ -557,6 +543,19 @@ let pass_CheckDuplication =
557 543 EnvUtils.create_sa_both_env_uids env both_env
558 544 )
559 545
  546 +let pass_DbEngineImportation =
  547 + PassHandler.make_pass
  548 + (fun e ->
  549 + let files = e.PH.env in
  550 + let stdlib = e.PH.options.O.stdlib in
  551 + List.iter
  552 + (fun (_, _, pfile) ->
  553 + Pass_DbEngineImportation.process_code ~stdlib pfile
  554 + ) files;
  555 + Pass_DbEngineImportation.finalize ~stdlib;
  556 + e
  557 + )
  558 +
560 559 let pass_BslLoading =
561 560 PassHandler.make_pass
562 561 (fun e ->
11 opa/s3Passes.mli
... ... @@ -1,5 +1,5 @@
1 1 (*
2   - Copyright © 2011 MLstate
  2 + Copyright © 2011, 2012 MLstate
3 3
4 4 This file is part of OPA.
5 5
@@ -122,12 +122,9 @@ val pass_RegisterAppSrcCode :
122 122 ) opa_pass
123 123
124 124 val pass_DbEngineImportation :
125   - ((
126   - ( SurfaceAst.parsing_directive SurfaceAstPassesTypes.parsed_file list
127   - * SurfaceAst.parsing_directive SurfaceAstPassesTypes.parsed_file list
128   - ) as 'parsed_files)
129   - ,
130   - 'parsed_files)
  125 + ((((SurfaceAst.nonuid, SurfaceAst.parsing_directive)
  126 + SurfaceAst.code_elt) ObjectFiles.parsed_code) as 'parsed_code
  127 + , 'parsed_code)
131 128 opa_pass
132 129
133 130 val pass_BslLoading :

0 comments on commit 9f38934

Please sign in to comment.
Something went wrong with that request. Please try again.