Skip to content
Browse files

[fix] compiler, database: export database ident into gamma only for d…

…atabase declared in current package
  • Loading branch information...
1 parent 3bb1e06 commit 1b343b364c560032bcab8e07aad851fe045a5704 @BourgerieQuentin BourgerieQuentin committed Feb 16, 2012
Showing with 21 additions and 13 deletions.
  1. +4 −0 libqmlcompil/dbGen/schema_private.ml
  2. +2 −1 libqmlcompil/qmlDbGen.ml
  3. +15 −12 qmlpasses/pass_DbSchemaGeneration.ml
View
4 libqmlcompil/dbGen/schema_private.ml
@@ -85,6 +85,7 @@ type database_def = {
(* eg. [(/a,/b); (/alias,/deep/data)] *)
options: Db.options list;
schema: t;
+ package : ObjectFiles.package_name;
virtual_path : (Q.ident * Q.ty * Q.ty) PathMap.t;
}
type meta_schema = database_def StringListMap.t
@@ -703,6 +704,7 @@ let register_new_db_value ~name_default_values t gamma (label, value) =
path_aliases = [];
options = [];
schema = SchemaGraphLib.initial_schema ~context;
+ package = ObjectFiles.get_current_package_name ();
virtual_path = PathMap.empty } t
else
t
@@ -753,6 +755,7 @@ let register_db_declaration t (label, ident, p, opts) =
path_aliases = [];
options = opts;
schema = SchemaGraphLib.initial_schema ~context;
+ package = ObjectFiles.get_current_package_name ();
virtual_path = PathMap.empty;
} t)
| [Db.Decl_fld point] ->
@@ -762,6 +765,7 @@ let register_db_declaration t (label, ident, p, opts) =
path_aliases = [];
options = opts;
schema = SchemaGraphLib.initial_schema ~context;
+ package = ObjectFiles.get_current_package_name ();
virtual_path = PathMap.empty;
} t)
| _ -> error "Unhandled DB definition"
View
3 libqmlcompil/qmlDbGen.ml
@@ -120,6 +120,7 @@ module Schema = struct
Sch.path_aliases = [];
Sch.options = [];
Sch.schema = Schema_io.from_gml_string s;
+ Sch.package = "dummy_from_gml";
Sch.virtual_path = Sch.PathMap.empty;
})
let to_dot t chan =
@@ -153,7 +154,7 @@ module Schema = struct
ident = decl.Sch.ident;
dbty = decl.Sch.ty;
options = decl.Sch.options;
- package = "todo" (*TODO*);
+ package = decl.Sch.package;
}
let get_db_declaration schema =
View
27 qmlpasses/pass_DbSchemaGeneration.ml
@@ -231,18 +231,21 @@ let process_code gamma _annotmap schema code =
match ObjectFiles.compilation_mode () with
| `init -> gamma
| _ ->
- List.fold_left
- (fun gamma database ->
- let ty = fst (QmlTypes.type_of_type gamma (database.DbSchema.dbty)) in
- let _ =
- #<If:DBGEN_DEBUG>
- OManager.printf "Adding database (%a) %a to gamma\n%!"
- QmlPrint.pp#ty ty
- QmlPrint.pp#ident database.DbSchema.ident
- #<End>;
- in
- QmlTypes.Env.Ident.add database.DbSchema.ident (QmlTypes.Scheme.quantify ty) gamma)
- gamma (DbSchema.get_db_declaration schema)
+ let current = ObjectFiles.get_current_package_name () in
+ List.fold_left
+ (fun gamma database ->
+ if database.DbSchema.package = current then
+ let ty = fst (QmlTypes.type_of_type gamma (database.DbSchema.dbty)) in
+ let _ =
+ #<If:DBGEN_DEBUG>
+ OManager.printf "Adding database (%a) %a to gamma\n%!"
+ QmlPrint.pp#ty ty
+ QmlPrint.pp#ident database.DbSchema.ident
+ #<End>;
+ in
+ QmlTypes.Env.Ident.add database.DbSchema.ident (QmlTypes.Scheme.quantify ty) gamma
+ else gamma
+ ) gamma (DbSchema.get_db_declaration schema)
in
let _ = R.save partial_schema in

0 comments on commit 1b343b3

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