fix AMD loader

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
 

jscomp/js_config.mli

@@ -21,6 +21,7 @@
 type env = 
   | Browser
   | NodeJS
+  | AmdJS
   | Goog of string option
 
 val get_env : unit -> env

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 -> 

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 = 

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 :

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 */

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;;