New primitive: caml_alloc_dummy_function ... caml_alloc_dummy_function takes the function arity as a second argument. This new information can be used by js_of_ocaml to perform better optimization.
From: Hugo Heuzard <hugo.heuzard@gmail.com> git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@15592 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02master
parent
b0b1922aac
commit
2922831951
|
@ -128,6 +128,7 @@ type rhs_kind =
|
|||
| RHS_block of int
|
||||
| RHS_floatblock of int
|
||||
| RHS_nonrec
|
||||
| RHS_function of int * int
|
||||
;;
|
||||
|
||||
let rec check_recordwith_updates id e =
|
||||
|
@ -140,7 +141,7 @@ let rec check_recordwith_updates id e =
|
|||
|
||||
let rec size_of_lambda = function
|
||||
| Lfunction(kind, params, body) as funct ->
|
||||
RHS_block (1 + IdentSet.cardinal(free_variables funct))
|
||||
RHS_function (1 + IdentSet.cardinal(free_variables funct), List.length params)
|
||||
| Llet (Strict, id, Lprim (Pduprecord (kind, size), _), body)
|
||||
when check_recordwith_updates id body ->
|
||||
begin match kind with
|
||||
|
@ -540,19 +541,25 @@ let rec comp_expr env exp sz cont =
|
|||
Kconst(Const_base(Const_int blocksize)) ::
|
||||
Kccall("caml_alloc_dummy", 1) :: Kpush ::
|
||||
comp_init (add_var id (sz+1) new_env) (sz+1) rem
|
||||
| (id, exp, RHS_function (blocksize,arity)) :: rem ->
|
||||
Kconst(Const_base(Const_int arity)) ::
|
||||
Kpush ::
|
||||
Kconst(Const_base(Const_int blocksize)) ::
|
||||
Kccall("caml_alloc_dummy_function", 2) :: Kpush ::
|
||||
comp_init (add_var id (sz+1) new_env) (sz+1) rem
|
||||
| (id, exp, RHS_nonrec) :: rem ->
|
||||
Kconst(Const_base(Const_int 0)) :: Kpush ::
|
||||
comp_init (add_var id (sz+1) new_env) (sz+1) rem
|
||||
and comp_nonrec new_env sz i = function
|
||||
| [] -> comp_rec new_env sz ndecl decl_size
|
||||
| (id, exp, (RHS_block _ | RHS_floatblock _)) :: rem ->
|
||||
| (id, exp, (RHS_block _ | RHS_floatblock _ | RHS_function _)) :: rem ->
|
||||
comp_nonrec new_env sz (i-1) rem
|
||||
| (id, exp, RHS_nonrec) :: rem ->
|
||||
comp_expr new_env exp sz
|
||||
(Kassign (i-1) :: comp_nonrec new_env sz (i-1) rem)
|
||||
and comp_rec new_env sz i = function
|
||||
| [] -> comp_expr new_env body sz (add_pop ndecl cont)
|
||||
| (id, exp, (RHS_block _ | RHS_floatblock _)) :: rem ->
|
||||
| (id, exp, (RHS_block _ | RHS_floatblock _ | RHS_function _)) :: rem ->
|
||||
comp_expr new_env exp sz
|
||||
(Kpush :: Kacc i :: Kccall("caml_update_dummy", 2) ::
|
||||
comp_rec new_env sz (i-1) rem)
|
||||
|
|
|
@ -153,6 +153,12 @@ CAMLprim value caml_alloc_dummy(value size)
|
|||
return caml_alloc (wosize, 0);
|
||||
}
|
||||
|
||||
CAMLprim value caml_alloc_dummy_function(value size,value arity)
|
||||
{
|
||||
/* the arity argument is used by the js_of_ocaml runtime */
|
||||
return caml_alloc_dummy(size);
|
||||
}
|
||||
|
||||
CAMLprim value caml_alloc_dummy_float (value size)
|
||||
{
|
||||
mlsize_t wosize = Int_val(size) * Double_wosize;
|
||||
|
|
Loading…
Reference in New Issue