From 7ef3ce6b932f9d49747b13fb7ba8248761935415 Mon Sep 17 00:00:00 2001 From: Hongbo Zhang Date: Mon, 18 Apr 2016 17:47:16 -0400 Subject: [PATCH] fix AMD loader --- jscomp/js_config.ml | 7 ++- jscomp/js_config.mli | 1 + jscomp/js_dump.ml | 4 +- jscomp/js_program_loader.ml | 1 + jscomp/test/.depend | 4 ++ jscomp/test/pq_test.js | 106 ++++++++++++++++++++++++++++++++++++ jscomp/test/pq_test.ml | 26 +++++++++ 7 files changed, 147 insertions(+), 2 deletions(-) create mode 100644 jscomp/test/pq_test.js create mode 100644 jscomp/test/pq_test.ml diff --git a/jscomp/js_config.ml b/jscomp/js_config.ml index 91d639384c..4a3e426a2c 100644 --- a/jscomp/js_config.ml +++ b/jscomp/js_config.ml @@ -22,6 +22,7 @@ type env = | Browser | NodeJS + | AmdJS | Goog of string option let default_env = ref NodeJS @@ -35,6 +36,8 @@ let cmd_set_module str = match str with | "commonjs" -> default_env := NodeJS | "amdjs" -> + default_env := AmdJS + | "browser-internal" -> (* used internal *) default_env := Browser | _ -> if Ext_string.starts_with str "goog" then @@ -58,7 +61,9 @@ let cmd_set_module str = let get_goog_package_name () = match !default_env with | Goog x -> x - | Browser | NodeJS -> None + | Browser + | AmdJS + | NodeJS -> None let default_gen_tds = ref false diff --git a/jscomp/js_config.mli b/jscomp/js_config.mli index 16ce8a667e..5850edf4e2 100644 --- a/jscomp/js_config.mli +++ b/jscomp/js_config.mli @@ -21,6 +21,7 @@ type env = | Browser | NodeJS + | AmdJS | Goog of string option val get_env : unit -> env diff --git a/jscomp/js_dump.ml b/jscomp/js_dump.ml index 366df856e2..584fb1e93d 100644 --- a/jscomp/js_dump.ml +++ b/jscomp/js_dump.ml @@ -1592,8 +1592,10 @@ let pp_deps_program ( program : J.deps_program) (f : Ext_pp.t) = P.string f L.strict_directive; P.newline f ; ignore (match Js_config.get_env () with + | AmdJS -> + amd_program f program | Browser -> - (node_program f program) + node_program f program | NodeJS -> begin match Sys.getenv "OCAML_AMD_MODULE" with | exception Not_found -> diff --git a/jscomp/js_program_loader.ml b/jscomp/js_program_loader.ml index ba73f59f60..f2b26897fe 100644 --- a/jscomp/js_program_loader.ml +++ b/jscomp/js_program_loader.ml @@ -53,6 +53,7 @@ let string_of_module_id (x : Lam_module_ident.t) : string = "./runtime/" ^ Filename.chop_extension target else "./stdlib/" ^ Filename.chop_extension target + | AmdJS | NodeJS -> if Ext_string.starts_with id.name "Caml_" then let path = diff --git a/jscomp/test/.depend b/jscomp/test/.depend index c5b980358f..91e7aaa67c 100644 --- a/jscomp/test/.depend +++ b/jscomp/test/.depend @@ -284,6 +284,8 @@ obj_test.cmo : mt.cmi obj_test.cmx : mt.cmx of_string_test.cmo : mt.cmi of_string_test.cmx : mt.cmx +pq_test.cmo : +pq_test.cmx : pr_regression_test.cmo : mt.cmi pr_regression_test.cmx : mt.cmx primitive_reg_test.cmo : @@ -824,6 +826,8 @@ obj_test.cmo : mt.cmi obj_test.cmj : mt.cmj of_string_test.cmo : mt.cmi of_string_test.cmj : mt.cmj +pq_test.cmo : +pq_test.cmj : pr_regression_test.cmo : mt.cmi pr_regression_test.cmj : mt.cmj primitive_reg_test.cmo : diff --git a/jscomp/test/pq_test.js b/jscomp/test/pq_test.js new file mode 100644 index 0000000000..bb2d596cbd --- /dev/null +++ b/jscomp/test/pq_test.js @@ -0,0 +1,106 @@ +// Generated CODE, PLEASE EDIT WITH CARE +'use strict'; + +var Caml_builtin_exceptions = require("../runtime/caml_builtin_exceptions"); + +function insert(queue, prio, elt) { + if (queue) { + var right = queue[3]; + var left = queue[2]; + var e = queue[1]; + var p = queue[0]; + if (prio <= p) { + return /* Node */[ + prio, + elt, + insert(right, p, e), + left + ]; + } + else { + return /* Node */[ + p, + e, + insert(right, prio, elt), + left + ]; + } + } + else { + return /* Node */[ + prio, + elt, + /* Empty */0, + /* Empty */0 + ]; + } +} + +var Queue_is_empty = { + 0: "Pq_test.PrioQueue.Queue_is_empty", + 1: Caml_builtin_exceptions.get_id(), + length: 2, + tag: 248 +}; + +function remove_top(param) { + if (param) { + var left = param[2]; + if (param[3]) { + if (left) { + var right = param[3]; + var rprio = right[0]; + var lprio = left[0]; + if (lprio <= rprio) { + return /* Node */[ + lprio, + left[1], + remove_top(left), + right + ]; + } + else { + return /* Node */[ + rprio, + right[1], + left, + remove_top(right) + ]; + } + } + else { + return param[3]; + } + } + else { + return left; + } + } + else { + throw Queue_is_empty; + } +} + +function extract(queue) { + if (queue) { + return /* tuple */[ + queue[0], + queue[1], + remove_top(queue) + ]; + } + else { + throw Queue_is_empty; + } +} + +var PrioQueue = /* module */[ + /* Empty */0, + insert, + Queue_is_empty, + remove_top, + extract +]; + +exports.PrioQueue = PrioQueue; +/* No side effect */ diff --git a/jscomp/test/pq_test.ml b/jscomp/test/pq_test.ml new file mode 100644 index 0000000000..e0ac4b37f7 --- /dev/null +++ b/jscomp/test/pq_test.ml @@ -0,0 +1,26 @@ +module PrioQueue = + struct + type priority = int + type 'a queue = Empty | Node of priority * 'a * 'a queue * 'a queue + let empty = Empty + let rec insert queue prio elt = + match queue with + Empty -> Node(prio, elt, Empty, Empty) + | Node(p, e, left, right) -> + if prio <= p + then Node(prio, elt, insert right p e, left) + else Node(p, e, insert right prio elt, left) + exception Queue_is_empty + let rec remove_top = function + Empty -> raise Queue_is_empty + | Node(prio, elt, left, Empty) -> left + | Node(prio, elt, Empty, right) -> right + | Node(prio, elt, (Node(lprio, lelt, _, _) as left), + (Node(rprio, relt, _, _) as right)) -> + if lprio <= rprio + then Node(lprio, lelt, remove_top left, right) + else Node(rprio, relt, left, remove_top right) + let extract = function + Empty -> raise Queue_is_empty + | Node(prio, elt, _, _) as queue -> (prio, elt, remove_top queue) + end;;