Permalink
Browse files

[enhance] compiler: More smarter 'require' graph

  • Loading branch information...
1 parent 2f4f14d commit e970f7549cac91205b81329bbbf8aaf91af2c184 @BourgerieQuentin BourgerieQuentin committed Sep 25, 2012
Showing with 89 additions and 34 deletions.
  1. +85 −2 compiler/opa/pass_ServerJavascriptOptimization.ml
  2. +4 −32 compiler/qml2js/qml2js.ml
@@ -17,10 +17,22 @@
*)
module Format = BaseFormat
+module String = BaseString
module J = JsAst
module C = JsCons
+module S =
+struct
+ type t = string list (* required opx *)
+ let pass = "ServerJavascriptOptimization"
+ let pp fmt opx_requires =
+ Format.fprintf fmt "opx: %a"
+ (Format.pp_list ",@ " Format.pp_print_string) opx_requires
+end
+
+module R = ObjectFiles.Make(S)
+
let export_to_global ident e =
JsCons.Statement.assign
(JsCons.Expr.dot ~own_property:false
@@ -36,6 +48,77 @@ let process_code_elt exported = function
export_to_global i (J.Je_function (l, Some i, p, b))
| x -> x
+let cons_require opx =
+ JsCons.Statement.expr (
+ JsCons.Expr.call ~pure:false
+ (JsCons.Expr.native "require")
+ [(JsCons.Expr.string opx)]
+ )
+
let process_code exported code =
- (* ignore (PassTracker.print ~passname:"ServerJavascriptOptimization" ~printer_id:"js_exported" (JsIdentSet.pp ", " JsPrint.pp#ident) exported); *)
- List.map (process_code_elt exported) code
+ (* Exports idents to global node scope *)
+ let code = List.map (process_code_elt exported) code in
+ (* Adding require *)
+
+ let is_a_real_deps =
+ if ObjectFiles.stdlib_package_names (ObjectFiles.get_current_package_name ()) then
+ (fun _ -> true)
+ else
+ (* Compute real depends in the JavaScript code *)
+ let real_depends =
+ List.fold_left
+ (JsWalk.TStatement.fold
+ (fun real_depends _ -> real_depends)
+ (fun real_depends -> function
+ | J.Je_ident (_, JsIdent.ExprIdent i) ->
+ begin match Ident.safe_get_package_name i with
+ | None -> real_depends
+ | Some p -> StringSet.add p real_depends
+ end
+ | _ -> real_depends)
+ ) StringSet.empty code
+ in
+ Format.eprintf "real_depends: %a\n%!" (StringSet.pp ", " Format.pp_print_string) real_depends;
+ (fun opx -> not (ObjectFiles.stdlib_package_names opx) || StringSet.mem opx real_depends)
+ in
+ let opx_requires =
+ ObjectFiles.fold_dir_name ~packages:true
+ (fun requires opx name ->
+ let opx = Filename.basename opx in
+ if is_a_real_deps (fst name) then (
+ Format.eprintf "Add : %s\n%!" opx;
+ opx :: requires ) else requires)
+ []
+ in
+ Format.eprintf "opx_requires: %a\n%!" (BaseFormat.pp_list ", " Format.pp_print_string) opx_requires;
+ let already_required =
+ (R.fold_with_name ~deep:true ~packages:true
+ (fun pack k saved_requires ->
+ (fun acc ->
+ k (
+ Format.eprintf "acc: %a\n%!" (StringSet.pp ", " Format.pp_print_string) acc;
+ let pname = fst pack in
+ if
+ is_a_real_deps (Filename.basename pname)
+ || StringSet.mem (pname ^ ".opx") acc
+ then (
+ Format.eprintf "Add %s and %a\n%!" (fst pack) (Format.pp_list ", " Format.pp_print_string) saved_requires;
+ StringSet.add_list (List.map Filename.basename saved_requires) acc
+ ) else acc)
+ )
+ ) (fun s -> s)
+ ) StringSet.empty
+ in
+ Format.eprintf "opx_requires: %a\n%!" (BaseFormat.pp_list ", " Format.pp_print_string) opx_requires;
+ let opx_requires =
+ List.filter
+ (fun opx -> not (StringSet.mem opx already_required))
+ opx_requires in
+ Format.eprintf "opx_requires: %a\n%!" (BaseFormat.pp_list ", " Format.pp_print_string) opx_requires;
+ R.save opx_requires;
+ let opx_requires =
+ List.rev_map
+ (fun opx -> cons_require opx)
+ opx_requires in
+ opx_requires @ code
+
View
@@ -230,12 +230,10 @@ struct
type t = {
(* Packages and plugins required by file *)
plugin_requires : BPI.plugin_basename list;
- opx_requires : string list;
}
let pass = "ServerJavascriptCompilation"
- let pp fmt {opx_requires} =
- Format.fprintf fmt "opx: %a"
- (Format.pp_list "@\n@\n" Format.pp_print_string) opx_requires
+ let pp fmt _ =
+ Format.fprintf fmt "<dummy>"
end
module R = ObjectFiles.Make(S)
@@ -301,12 +299,6 @@ struct
let compilation_generation env_opt env_bsl plugin_requires
bundled_plugin env_js_input =
- let already_required =
- R.fold ~deep:true ~packages:true
- (fun acc saved ->
- StringSet.add_list (List.map Filename.basename saved.S.opx_requires) acc
- ) StringSet.empty
- in
let js_init =
if env_opt.modular_plugins then
(* FIXME: there's probably a bug when fixing projections
@@ -318,13 +310,7 @@ struct
List.map snd (get_js_init env_js_input) in
let js_code = js_init @ env_js_input.js_code in
- let opx_requires = ObjectFiles.fold_dir ~packages:true
- (fun requires opx -> opx :: requires) [] in
-
- let save = {S.
- plugin_requires;
- opx_requires;
- } in
+ let save = {S. plugin_requires} in
R.save save;
let runtime_requires =
@@ -339,21 +325,7 @@ struct
require_stm (Some ("__opa_" ^ plugin_name)) (plugin_name ^ ".opp")
) plugin_requires in
- (* Add package dependencies
- NB by not reversing this we were getting bugs in the order of
- the requires *)
- let opx_requires =
- List.map Filename.basename opx_requires in
- let opx_requires =
- List.filter
- (fun opx -> not (StringSet.mem opx already_required))
- opx_requires in
- let opx_requires =
- List.rev_map
- (fun opx -> require_stm None opx)
- opx_requires in
-
- let requires = runtime_requires @ plugin_requires @ opx_requires in
+ let requires = runtime_requires @ plugin_requires in
let print_content fmt =
Format.fprintf fmt "%a\n%s%a\n"
JsPrint.pp_min#code requires

0 comments on commit e970f75

Please sign in to comment.