Skip to content
Browse files

[enhance] compiler: Add compiler packages (Import packages that not p…

…lace in stdlib.core but used by compiler)
  • Loading branch information...
1 parent da0df57 commit 5242af3550ab4099edafbdb2dc9a6ba60fc8244a @BourgerieQuentin BourgerieQuentin committed Jan 23, 2012
View
8 compilerlib/objectFiles.ml
@@ -287,6 +287,7 @@ type compilation_mode = [
]
let compilation_mode_state = ref `prelude
let compilation_mode () = !compilation_mode_state
+let compiler_packages = MutableList.create ()
(* m *)
@@ -1754,11 +1755,18 @@ let stdlib_package_names name =
let stdlib_packages (package_name,_pos) = stdlib_package_names package_name
+let compiler_package (package_name,_pos) =
+ stdlib_package_names package_name ||
+ MutableList.mem package_name compiler_packages
+
let get_paths () = !extrapaths
let import_package packname pos =
MutableList.add more_import_package_names (packname, pos)
+let add_compiler_package packname =
+ MutableList.add compiler_packages packname
+
module Arg =
struct
module Arg = Base.Arg
View
10 compilerlib/objectFiles.mli
@@ -268,6 +268,9 @@ val warning_set : WarningClass.Set.t
val stdlib_packages : package -> bool
val stdlib_package_names : package_name -> bool
+
+val compiler_package : package -> bool
+
(**
Loads the js extra lib with the given basename
*)
@@ -290,4 +293,9 @@ val turn_separated_off : unit -> unit
(**
Force a package importation.
*)
-val import_package : string -> FilePos.pos -> unit
+val import_package : package_name -> FilePos.pos -> unit
+
+(**
+ Use given package as a compiler package.
+*)
+val add_compiler_package : package_name -> unit
View
2 libqmlcompil/qmlTracker.ml
@@ -149,7 +149,7 @@ let printers extract _ =
with_type_id, make_ac Printer.code_with_type;
for_ei_id, make_ac Printer.code_for_ei;
gamma_id, make_gamma Printer.gamma;
- gamma_id, make_stdlib_gamma Printer.gamma;
+ stdlib_gamma_id, make_stdlib_gamma Printer.gamma;
(* waiting for flexibility in passhander options *)
(* tracked_id, make Printer.tracked ; *)
]
View
2 libqmlcompil/qmlTyperErrHandling.ml
@@ -90,7 +90,7 @@ let pp_typer_error ~type_printer ?(highlight_printer = Base.identity)
| TExc.TypeIdentNotFound tid ->
Format.fprintf ppf
"The type@ @{<red>%a@} @ is@ not@ defined.@\n"
- QmlPrint.pp#typeident tid
+ QmlPrint.pp_base#typeident tid
| TExc.DuplicateTypeDefinitions s ->
Format.fprintf ppf
"There@ are@ duplicate@ definitions@ for@ type@ @{<red>%s@} .@\n" s
View
9 opa/checkopacapi.ml
@@ -202,16 +202,17 @@ let stdlib acc code =
(**
Check strict equality between 2 StringSet, with errors reporting.
*)
-let report elt name present absent =
+let report elt name present absent set =
validation_ok := false ;
OManager.printf (
- "[!] The %s @{<bright>%s@} is present in @{<bright>%s@} but not in @{<bright>%s@}@."
+ "[!] The %s @{<bright>%s@} is present in @{<bright>%s@} but not in @{<bright>%s@}@\n@{<bright>%s@} set: %a@.@."
)
- elt name present absent
+ elt name present absent absent
+ (StringSet.pp "," Format.pp_print_string) set
let strict_equality elt name1 name2 set1 set2 =
let iter name1 name2 set1 set2 =
- let error name = report elt name name1 name2 in
+ let error name = report elt name name1 name2 set2 in
StringSet.iter (fun s -> if not (StringSet.mem s set2) then error s) set1
in
iter name1 name2 set1 set2;
View
14 opa/pass_DbEngineImportation.ml
@@ -27,11 +27,13 @@ let process_code code =
(function
| (S.Database _), _ | (S.NewDbDef _), _ -> true
| _ -> false)
- code then
- ObjectFiles.import_package
- (match QmlDbGen.Args.get_engine () with
- | Db.Db3 -> "stdlib.database.db3"
- | Db.Mongo -> "stdlib.database.mongo")
- builtinpos
+ code then (
+ let package = match QmlDbGen.Args.get_engine () with
+ | Db.Db3 -> "stdlib.database.db3"
+ | Db.Mongo -> "stdlib.database.mongo"
+ in
+ ObjectFiles.import_package package builtinpos;
+ ObjectFiles.add_compiler_package package;
+ )
;
code
View
14 opa/pass_TypeDefinition.ml
@@ -34,7 +34,7 @@ module R = ObjectFiles.Make(S)
let process_code register typerEnv code =
let new_gamma = QmlTypes.Env.empty in
let gamma = typerEnv.QmlTypes.gamma in
- let gamma =
+ let (gamma, stdlib) =
(* during pre_linking, the whole gamma is loaded
because dbGen loads the whole database schema *)
let options_packages = ObjectFiles.compilation_mode() = `init in
@@ -45,10 +45,14 @@ let process_code register typerEnv code =
* when u is defined in another package saying type u = v
* when v is defined in another package etc.
*)
- (fun package acc_gamma gamma ->
+ (fun package (acc_gamma, acc_stdlib) gamma ->
let gamma = QmlRefresh.refresh_gamma package gamma in
- QmlTypes.Env.append acc_gamma gamma)
- gamma in
+ let stdlib =
+ if ObjectFiles.compiler_package package then
+ QmlTypes.Env.append acc_stdlib gamma
+ else acc_stdlib
+ in (QmlTypes.Env.append acc_gamma gamma, stdlib))
+ (gamma, QmlTypes.Env.empty) in
let typerEnv = { typerEnv with QmlTypes.gamma = gamma } in
(* Rgeister fields declared on [ty] *)
let rec register_type ty =
@@ -80,4 +84,4 @@ let process_code register typerEnv code =
List.fold_left_filter_map
aux (Q.TypeIdentSet.empty,new_gamma,typerEnv) code in
R.save new_gamma ;
- (local_typedefs, typerEnv, code)
+ (local_typedefs, typerEnv, code, stdlib)
View
2 opa/pass_TypeDefinition.mli
@@ -21,4 +21,4 @@
The first argument is a function for fields registering.
*)
-val process_code : (string -> unit) -> QmlTyper.OfficialTyper.env -> QmlAst.code -> QmlAst.TypeIdentSet.t * QmlTyper.OfficialTyper.env * QmlAst.code
+val process_code : (string -> unit) -> QmlTyper.OfficialTyper.env -> QmlAst.code -> QmlAst.TypeIdentSet.t * QmlTyper.OfficialTyper.env * QmlAst.code * QmlTypes.gamma
View
4 opa/pass_Typing.ml
@@ -78,7 +78,7 @@ let process_code ?(save = true) env =
IdentMap.map (QmlRefresh.refresh_typevars_from_tsc package) map in
let acc_map = IdentMap.safe_merge acc_map map in
let acc_stdlib =
- if ObjectFiles.stdlib_packages package then
+ if ObjectFiles.compiler_package package then
IdentMap.safe_merge acc_stdlib map
else acc_stdlib in
(acc_map, acc_stdlib))
@@ -127,7 +127,7 @@ let process_code ?(save = true) env =
QmlTypes.Env.Ident.to_map final_gamma
else stdlib_map in
let stdlib_gamma =
- QmlTypes.Env.Ident.from_map stdlib_map QmlTypes.Env.empty in
+ QmlTypes.Env.Ident.from_map stdlib_map env.P.stdlib_gamma in
let diff_gamma = QmlTypes.Env.Ident.from_map diff_map initial_gamma in
let typerEnv = { typerEnv with QmlTypes.gamma = diff_gamma } in
{ env with
View
4 opa/s3Passes.ml
@@ -888,9 +888,9 @@ let pass_TypesDefinitions =
let env = ( e.PH.env : 'tmp_env Passes.env_Gen ) in
let typerEnv = env.Passes.typerEnv in
let code = env.Passes.qmlAst in
- let local_typedefs, typerEnv, code = Pass_TypeDefinition.process_code
+ let local_typedefs, typerEnv, code, stdlib_gamma = Pass_TypeDefinition.process_code
(register_fields e.PH.options) typerEnv code in
- let env = { env with Passes.typerEnv = typerEnv ; qmlAst = code; local_typedefs = local_typedefs } in
+ let env = { env with Passes.typerEnv; local_typedefs; stdlib_gamma; qmlAst = code; } in
{ e with PH.env = env }
)

0 comments on commit 5242af3

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