Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Merge branch 'master' of git@github.com:jaked/ocamljs

  • Loading branch information...
commit 378080ff1c8033bb15ed2bd29bf1443e301d7af8 2 parents a1890e9 + 856d300
authored October 22, 2010
2  .gitignore
@@ -15,6 +15,8 @@ src/ounit/*.ml*
15 15
 src/ounit/META*
16 16
 src/stdlib/*.ml*
17 17
 !src/stdlib/random.ml
  18
+!src/stdlib/primitives.js
  19
+!src/stdlib/support.js
18 20
 src/jscomp/translclass.ml*
19 21
 src/jscomp/translcore.ml*
20 22
 src/jscomp/translobj.ml*
13  src/jscomp/jsgen.ml
@@ -157,11 +157,16 @@ let comp_ccall c es =
157 157
     | "$call", e::es -> << $e$($list:es$) >>
158 158
     | "$false", _ -> << false >>
159 159
     | "$fieldref", [e; Jstring (_loc, id, _)] -> << $e$.$id$ >>
160  
-    | "$function", [Jcall (_loc, Jvar _, (Jfun _ as f))] -> f
  160
+    | "$function", [Jcall (_loc, Jvar _, (Jexp_cons (_, _, (Jfun _ as f))))] -> f
161 161
 
162 162
     (* removes initial dummy arg; see camlinternalOO.ml *)
163  
-    | "$dummyargfun", [Jcall (_loc, Jvar (_loc2, v), (Jfun (_loc3, name, (_::args), stmts)))] ->
164  
-        Jcall (_loc, Jvar (_loc2, v), (Jfun (_loc3, name, args, stmts)))
  163
+    | "$dummyargfun", [Jcall (_loc,
  164
+                              Jvar (_loc2, v),
  165
+                              Jexp_cons (_loc3, Jnum (_loc4, numargs), Jfun (_loc5, name, (_::args), stmts)))] ->
  166
+        let numargs = string_of_int (int_of_string numargs - 1) in
  167
+        Jcall (_loc,
  168
+               Jvar (_loc2, v),
  169
+               Jexp_cons (_loc3, Jnum (_loc4, numargs), (Jfun (_loc5, name, args, stmts))))
165 170
 
166 171
     | "$hashref", [e1; e2] -> << $e1$[$e2$] >>
167 172
     | "$new", (Jstring (_, id, _))::es -> << new $id:id$($list:es$) >>
@@ -333,7 +338,7 @@ let rec comp_expr tail expr =
333 338
 
334 339
     | Lfunction (_, args, e) ->
335 340
         let e = Jfun (_loc, None, List.map jsident_of_ident args, comp_expr_st true e kreturn) in
336  
-        << _f($exp:e$) >>
  341
+        << _f($`int:List.length args$, $exp:e$) >>
337 342
 
338 343
     | Lapply(e, es, _) ->
339 344
         let app = if tail then "__" else "_" in
26  src/jscomp/patches/3.12.0/typecore.ml
@@ -22,7 +22,7 @@
22 22
 (*                                                                     *)
23 23
 (***********************************************************************)
24 24
 
25  
-(* $Id: typecore.ml 10540 2010-06-08 03:20:26Z garrigue $ *)
  25
+(* $Id: typecore.ml 10624 2010-07-12 09:36:07Z garrigue $ *)
26 26
 
27 27
 (* Typechecking for the core language *)
28 28
 
@@ -702,8 +702,32 @@ let rec is_nonexpansive exp =
702 702
       Vars.fold (fun _ (mut,_,_) b -> decr count; b && mut = Immutable)
703 703
         vars true &&
704 704
       !count = 0
  705
+  | Texp_pack mexp ->
  706
+      is_nonexpansive_mod mexp
705 707
   | _ -> false
706 708
 
  709
+and is_nonexpansive_mod mexp =
  710
+  match mexp.mod_desc with
  711
+  | Tmod_ident _ -> true
  712
+  | Tmod_functor _ -> true
  713
+  | Tmod_unpack (e, _) -> is_nonexpansive e
  714
+  | Tmod_constraint (m, _, _) -> is_nonexpansive_mod m
  715
+  | Tmod_structure items ->
  716
+      List.for_all
  717
+        (function
  718
+          | Tstr_eval _ | Tstr_primitive _ | Tstr_type _ | Tstr_modtype _
  719
+          | Tstr_open _ | Tstr_cltype _ | Tstr_exn_rebind _ -> true
  720
+          | Tstr_value (_, pat_exp_list) ->
  721
+              List.for_all (fun (_, exp) -> is_nonexpansive exp) pat_exp_list
  722
+          | Tstr_module (_, m) | Tstr_include (m, _) -> is_nonexpansive_mod m
  723
+          | Tstr_recmodule id_mod_list ->
  724
+              List.for_all (fun (_, m) -> is_nonexpansive_mod m) id_mod_list
  725
+          | Tstr_exception _ -> false (* true would be unsound *)
  726
+          | Tstr_class _ -> false (* could be more precise *)
  727
+        )
  728
+        items
  729
+  | Tmod_apply _ -> false
  730
+
707 731
 and is_nonexpansive_opt = function
708 732
     None -> true
709 733
   | Some e -> is_nonexpansive e
42  src/jscomp/patches/3.12.0/typecore.ml.patch
@@ -16,48 +16,6 @@
16 16
  (***********************************************************************)
17 17
  (*                                                                     *)
18 18
  (*                           Objective Caml                            *)
19  
-@@ -10,7 +22,7 @@
20  
- (*                                                                     *)
21  
- (***********************************************************************)
22  
- 
23  
--(* $Id: typecore.ml 10624 2010-07-12 09:36:07Z garrigue $ *)
24  
-+(* $Id: typecore.ml 10540 2010-06-08 03:20:26Z garrigue $ *)
25  
- 
26  
- (* Typechecking for the core language *)
27  
- 
28  
-@@ -690,32 +702,8 @@
29  
-       Vars.fold (fun _ (mut,_,_) b -> decr count; b && mut = Immutable)
30  
-         vars true &&
31  
-       !count = 0
32  
--  | Texp_pack mexp ->
33  
--      is_nonexpansive_mod mexp
34  
-   | _ -> false
35  
- 
36  
--and is_nonexpansive_mod mexp =
37  
--  match mexp.mod_desc with
38  
--  | Tmod_ident _ -> true
39  
--  | Tmod_functor _ -> true
40  
--  | Tmod_unpack (e, _) -> is_nonexpansive e
41  
--  | Tmod_constraint (m, _, _) -> is_nonexpansive_mod m
42  
--  | Tmod_structure items ->
43  
--      List.for_all
44  
--        (function
45  
--          | Tstr_eval _ | Tstr_primitive _ | Tstr_type _ | Tstr_modtype _
46  
--          | Tstr_open _ | Tstr_cltype _ | Tstr_exn_rebind _ -> true
47  
--          | Tstr_value (_, pat_exp_list) ->
48  
--              List.for_all (fun (_, exp) -> is_nonexpansive exp) pat_exp_list
49  
--          | Tstr_module (_, m) | Tstr_include (m, _) -> is_nonexpansive_mod m
50  
--          | Tstr_recmodule id_mod_list ->
51  
--              List.for_all (fun (_, m) -> is_nonexpansive_mod m) id_mod_list
52  
--          | Tstr_exception _ -> false (* true would be unsound *)
53  
--          | Tstr_class _ -> false (* could be more precise *)
54  
--        )
55  
--        items
56  
--  | Tmod_apply _ -> false
57  
--
58  
- and is_nonexpansive_opt = function
59  
-     None -> true
60  
-   | Some e -> is_nonexpansive e
61 19
 @@ -1414,17 +1402,21 @@
62 20
                    let (obj_ty, res_ty) = filter_arrow env method_type "" in
63 21
                    unify env obj_ty desc.val_type;
2  src/stdlib/primitives.js
@@ -325,8 +325,10 @@ var caml_string_compare = function (s1, s2) {
325 325
   else if (oc$$sgt(s1, s2)) return 1;
326 326
   else return 0;
327 327
 }
  328
+var caml_sys_close = function () { throw "caml_sys_close"; }
328 329
 var caml_sys_exit = function () { throw "caml_sys_exit"; }
329 330
   var init_time = (new Date()).getTime() / 1000;
  331
+var caml_sys_getenv = function () { throw "caml_sys_getenv"; }
330 332
 var caml_sys_time = function () { return (new Date()).getTime() / 1000 - init_time; }
331 333
 var caml_sys_get_argv = function () { return $("", $()); } // XXX put something here?
332 334
 var caml_sys_get_config = function () { return $("js", 32); } // XXX browser name?
24  src/stdlib/support.js
@@ -65,18 +65,18 @@ function ___m(m, t, a)
65 65
 
66 66
   while (true) {
67 67
     var al = a.length;
68  
-    var ml = m.length;
  68
+    var ml = m.$oc;
69 69
 
70 70
     if (al < ml)
71 71
     {
72 72
       switch (ml - al) {
73  
-      case 1: return _f(function (z) { return m.apply(t, ap(a, arguments)) });
74  
-      case 2: return _f(function (z,y) { return m.apply(t, ap(a, arguments)) });
75  
-      case 3: return _f(function (z,y,x) { return m.apply(t, ap(a, arguments)) });
76  
-      case 4: return _f(function (z,y,x,w) { return m.apply(t, ap(a, arguments)) });
77  
-      case 5: return _f(function (z,y,x,w,v) { return m.apply(t, ap(a, arguments)) });
78  
-      case 6: return _f(function (z,y,x,w,v,u) { return m.apply(t, ap(a, arguments)) });
79  
-      case 7: return _f(function (z,y,x,w,v,u,s) { return m.apply(t, ap(a, arguments)) });
  73
+      case 1: return _f(1, function (z) { return m.apply(t, ap(a, arguments)) });
  74
+      case 2: return _f(2, function (z,y) { return m.apply(t, ap(a, arguments)) });
  75
+      case 3: return _f(3, function (z,y,x) { return m.apply(t, ap(a, arguments)) });
  76
+      case 4: return _f(4, function (z,y,x,w) { return m.apply(t, ap(a, arguments)) });
  77
+      case 5: return _f(5, function (z,y,x,w,v) { return m.apply(t, ap(a, arguments)) });
  78
+      case 6: return _f(6, function (z,y,x,w,v,u) { return m.apply(t, ap(a, arguments)) });
  79
+      case 7: return _f(7, function (z,y,x,w,v,u,s) { return m.apply(t, ap(a, arguments)) });
80 80
       default: throw "unimplemented";
81 81
       }
82 82
     }
@@ -96,7 +96,7 @@ var $in_tail = false;
96 96
 // tail call
97 97
 function __m(m, t, args)
98 98
 {
99  
-  if (m.$oc) {
  99
+  if ('$oc' in m) {
100 100
     if ($in_tail) {
101 101
       args.$m = m;
102 102
       args.$t = t;
@@ -118,7 +118,7 @@ function __(t, args) { return __m(t, t, args); }
118 118
 // non tail call
119 119
 function _m(m, t, args)
120 120
 {
121  
-  if (m.$oc) {
  121
+  if ('$oc' in m) {
122 122
     var old_in_tail = $in_tail;
123 123
     $in_tail = true;
124 124
     try {
@@ -138,8 +138,8 @@ function _m(m, t, args)
138 138
 }
139 139
 function _(t, args) { return _m(t, t, args); }
140 140
 
141  
-function _f(f) {
142  
-  f.$oc = true;
  141
+function _f(args, f) {
  142
+  f.$oc = args;
143 143
   return f;
144 144
 }
145 145
 

0 notes on commit 378080f

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