Permalink
Browse files

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

  • Loading branch information...
2 parents a1890e9 + 856d300 commit 378080ff1c8033bb15ed2bd29bf1443e301d7af8 Jake Donham committed Oct 22, 2010
View
@@ -15,6 +15,8 @@ src/ounit/*.ml*
src/ounit/META*
src/stdlib/*.ml*
!src/stdlib/random.ml
+!src/stdlib/primitives.js
+!src/stdlib/support.js
src/jscomp/translclass.ml*
src/jscomp/translcore.ml*
src/jscomp/translobj.ml*
View
@@ -157,11 +157,16 @@ let comp_ccall c es =
| "$call", e::es -> << $e$($list:es$) >>
| "$false", _ -> << false >>
| "$fieldref", [e; Jstring (_loc, id, _)] -> << $e$.$id$ >>
- | "$function", [Jcall (_loc, Jvar _, (Jfun _ as f))] -> f
+ | "$function", [Jcall (_loc, Jvar _, (Jexp_cons (_, _, (Jfun _ as f))))] -> f
(* removes initial dummy arg; see camlinternalOO.ml *)
- | "$dummyargfun", [Jcall (_loc, Jvar (_loc2, v), (Jfun (_loc3, name, (_::args), stmts)))] ->
- Jcall (_loc, Jvar (_loc2, v), (Jfun (_loc3, name, args, stmts)))
+ | "$dummyargfun", [Jcall (_loc,
+ Jvar (_loc2, v),
+ Jexp_cons (_loc3, Jnum (_loc4, numargs), Jfun (_loc5, name, (_::args), stmts)))] ->
+ let numargs = string_of_int (int_of_string numargs - 1) in
+ Jcall (_loc,
+ Jvar (_loc2, v),
+ Jexp_cons (_loc3, Jnum (_loc4, numargs), (Jfun (_loc5, name, args, stmts))))
| "$hashref", [e1; e2] -> << $e1$[$e2$] >>
| "$new", (Jstring (_, id, _))::es -> << new $id:id$($list:es$) >>
@@ -333,7 +338,7 @@ let rec comp_expr tail expr =
| Lfunction (_, args, e) ->
let e = Jfun (_loc, None, List.map jsident_of_ident args, comp_expr_st true e kreturn) in
- << _f($exp:e$) >>
+ << _f($`int:List.length args$, $exp:e$) >>
| Lapply(e, es, _) ->
let app = if tail then "__" else "_" in
@@ -22,7 +22,7 @@
(* *)
(***********************************************************************)
-(* $Id: typecore.ml 10540 2010-06-08 03:20:26Z garrigue $ *)
+(* $Id: typecore.ml 10624 2010-07-12 09:36:07Z garrigue $ *)
(* Typechecking for the core language *)
@@ -702,8 +702,32 @@ let rec is_nonexpansive exp =
Vars.fold (fun _ (mut,_,_) b -> decr count; b && mut = Immutable)
vars true &&
!count = 0
+ | Texp_pack mexp ->
+ is_nonexpansive_mod mexp
| _ -> false
+and is_nonexpansive_mod mexp =
+ match mexp.mod_desc with
+ | Tmod_ident _ -> true
+ | Tmod_functor _ -> true
+ | Tmod_unpack (e, _) -> is_nonexpansive e
+ | Tmod_constraint (m, _, _) -> is_nonexpansive_mod m
+ | Tmod_structure items ->
+ List.for_all
+ (function
+ | Tstr_eval _ | Tstr_primitive _ | Tstr_type _ | Tstr_modtype _
+ | Tstr_open _ | Tstr_cltype _ | Tstr_exn_rebind _ -> true
+ | Tstr_value (_, pat_exp_list) ->
+ List.for_all (fun (_, exp) -> is_nonexpansive exp) pat_exp_list
+ | Tstr_module (_, m) | Tstr_include (m, _) -> is_nonexpansive_mod m
+ | Tstr_recmodule id_mod_list ->
+ List.for_all (fun (_, m) -> is_nonexpansive_mod m) id_mod_list
+ | Tstr_exception _ -> false (* true would be unsound *)
+ | Tstr_class _ -> false (* could be more precise *)
+ )
+ items
+ | Tmod_apply _ -> false
+
and is_nonexpansive_opt = function
None -> true
| Some e -> is_nonexpansive e
@@ -16,48 +16,6 @@
(***********************************************************************)
(* *)
(* Objective Caml *)
-@@ -10,7 +22,7 @@
- (* *)
- (***********************************************************************)
-
--(* $Id: typecore.ml 10624 2010-07-12 09:36:07Z garrigue $ *)
-+(* $Id: typecore.ml 10540 2010-06-08 03:20:26Z garrigue $ *)
-
- (* Typechecking for the core language *)
-
-@@ -690,32 +702,8 @@
- Vars.fold (fun _ (mut,_,_) b -> decr count; b && mut = Immutable)
- vars true &&
- !count = 0
-- | Texp_pack mexp ->
-- is_nonexpansive_mod mexp
- | _ -> false
-
--and is_nonexpansive_mod mexp =
-- match mexp.mod_desc with
-- | Tmod_ident _ -> true
-- | Tmod_functor _ -> true
-- | Tmod_unpack (e, _) -> is_nonexpansive e
-- | Tmod_constraint (m, _, _) -> is_nonexpansive_mod m
-- | Tmod_structure items ->
-- List.for_all
-- (function
-- | Tstr_eval _ | Tstr_primitive _ | Tstr_type _ | Tstr_modtype _
-- | Tstr_open _ | Tstr_cltype _ | Tstr_exn_rebind _ -> true
-- | Tstr_value (_, pat_exp_list) ->
-- List.for_all (fun (_, exp) -> is_nonexpansive exp) pat_exp_list
-- | Tstr_module (_, m) | Tstr_include (m, _) -> is_nonexpansive_mod m
-- | Tstr_recmodule id_mod_list ->
-- List.for_all (fun (_, m) -> is_nonexpansive_mod m) id_mod_list
-- | Tstr_exception _ -> false (* true would be unsound *)
-- | Tstr_class _ -> false (* could be more precise *)
-- )
-- items
-- | Tmod_apply _ -> false
--
- and is_nonexpansive_opt = function
- None -> true
- | Some e -> is_nonexpansive e
@@ -1414,17 +1402,21 @@
let (obj_ty, res_ty) = filter_arrow env method_type "" in
unify env obj_ty desc.val_type;
View
@@ -325,8 +325,10 @@ var caml_string_compare = function (s1, s2) {
else if (oc$$sgt(s1, s2)) return 1;
else return 0;
}
+var caml_sys_close = function () { throw "caml_sys_close"; }
var caml_sys_exit = function () { throw "caml_sys_exit"; }
var init_time = (new Date()).getTime() / 1000;
+var caml_sys_getenv = function () { throw "caml_sys_getenv"; }
var caml_sys_time = function () { return (new Date()).getTime() / 1000 - init_time; }
var caml_sys_get_argv = function () { return $("", $()); } // XXX put something here?
var caml_sys_get_config = function () { return $("js", 32); } // XXX browser name?
View
@@ -65,18 +65,18 @@ function ___m(m, t, a)
while (true) {
var al = a.length;
- var ml = m.length;
+ var ml = m.$oc;
if (al < ml)
{
switch (ml - al) {
- case 1: return _f(function (z) { return m.apply(t, ap(a, arguments)) });
- case 2: return _f(function (z,y) { return m.apply(t, ap(a, arguments)) });
- case 3: return _f(function (z,y,x) { return m.apply(t, ap(a, arguments)) });
- case 4: return _f(function (z,y,x,w) { return m.apply(t, ap(a, arguments)) });
- case 5: return _f(function (z,y,x,w,v) { return m.apply(t, ap(a, arguments)) });
- case 6: return _f(function (z,y,x,w,v,u) { return m.apply(t, ap(a, arguments)) });
- case 7: return _f(function (z,y,x,w,v,u,s) { return m.apply(t, ap(a, arguments)) });
+ case 1: return _f(1, function (z) { return m.apply(t, ap(a, arguments)) });
+ case 2: return _f(2, function (z,y) { return m.apply(t, ap(a, arguments)) });
+ case 3: return _f(3, function (z,y,x) { return m.apply(t, ap(a, arguments)) });
+ case 4: return _f(4, function (z,y,x,w) { return m.apply(t, ap(a, arguments)) });
+ case 5: return _f(5, function (z,y,x,w,v) { return m.apply(t, ap(a, arguments)) });
+ case 6: return _f(6, function (z,y,x,w,v,u) { return m.apply(t, ap(a, arguments)) });
+ case 7: return _f(7, function (z,y,x,w,v,u,s) { return m.apply(t, ap(a, arguments)) });
default: throw "unimplemented";
}
}
@@ -96,7 +96,7 @@ var $in_tail = false;
// tail call
function __m(m, t, args)
{
- if (m.$oc) {
+ if ('$oc' in m) {
if ($in_tail) {
args.$m = m;
args.$t = t;
@@ -118,7 +118,7 @@ function __(t, args) { return __m(t, t, args); }
// non tail call
function _m(m, t, args)
{
- if (m.$oc) {
+ if ('$oc' in m) {
var old_in_tail = $in_tail;
$in_tail = true;
try {
@@ -138,8 +138,8 @@ function _m(m, t, args)
}
function _(t, args) { return _m(t, t, args); }
-function _f(f) {
- f.$oc = true;
+function _f(args, f) {
+ f.$oc = args;
return f;
}

0 comments on commit 378080f

Please sign in to comment.