jeltz/heptagon
1
0
Fork 0
Code Issues Pull requests Releases Activity

Deal with const ref in Java.

Browse source
This commit is contained in:
Léonard Gérard 2011-11-21 11:36:04 +01:00
parent 641b76133d
commit 57f7da94c2
6 changed files with 49 additions and 31 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
compiler/obc/java/java.ml
View file

@ -43,6 +43,7 @@ and class_desc = { cd_fields : field list;
cd_methodes : methode list; }
and var_dec = { vd_type : ty;
vd_alias : bool;
vd_ident : var_ident }
and protection = Ppublic | Pprotected | Pprivate | Ppackage
@ -122,8 +123,8 @@ let java_pervasives = Eclass java_pervasives_name
let mk_var x = Evar x
let mk_var_dec x ty =
{ vd_type = ty; vd_ident = x }
let mk_var_dec x is_alias ty =
{ vd_type = ty; vd_alias = is_alias; vd_ident = x }
let mk_block ?(locals=[]) b =
{ b_locals = locals; b_body = b; }

29
compiler/obc/java/java_main.ml
View file

@ -6,14 +6,13 @@ open Java
open Java_printer
let load_conf () =
(*TODO spill normalize_mem := false ! *)
Compiler_options.do_scalarize := true;
()
(** returns the vd and the pat of a fresh ident from [name] *)
let mk_var ty name =
let mk_var ty is_alias name =
let id = Idents.gen_var "java_main" name in
mk_var_dec id ty, Pvar id, Evar id
mk_var_dec id is_alias ty, Pvar id, Evar id
let program p =
@ -45,10 +44,10 @@ let program p =
let main_methode =
(* step is the current iteration step *)
let vd_step, pat_step, exp_step = mk_var Tint "step" in
let vd_step, pat_step, exp_step = mk_var Tint false "step" in
let vd_args, _, exp_args =
mk_var (Tarray (Tclass (Names.pervasives_qn "String"), [Sint 0])) "args" in
mk_var (Tarray (Tclass (Names.pervasives_qn "String"), [Sint 0])) false "args" in
let get_arg i = Earray_elem(exp_args, [Sint i]) in
@ -62,7 +61,7 @@ let program p =
let vd_main, e_main, q_main, ty_main =
let q_main = Obc2java.qualname_to_package_classe q_main in (*java qual*)
let id = Idents.gen_var "java_main" "main" in
mk_var_dec id (Tclass q_main), Evar id, q_main, ty_main
mk_var_dec id false (Tclass q_main), Evar id, q_main, ty_main
in
let acts =
let out = Eclass(Names.qualname_of_string "java.lang.System.out") in
@ -72,6 +71,9 @@ let program p =
let jsys = Eclass(Names.qualname_of_string "java.lang.System") in
let jminus = pervasives_qn "-" in
(* num args to give to the main *)
let rec num_args = List.length ty_main_args in
(* parse arguments to give to the main *)
let rec parse_args t_l i = match t_l with
| [] -> []
@ -89,17 +91,16 @@ let program p =
let main_args = parse_args ty_main_args 0 in
let parse_max_iteration =
let t_size = List.length ty_main_args in
(* no more arg to give to main, the last one if it exists is the iteration nb *)
Aifelse(Efun(Names.pervasives_qn ">", [ Efield (exp_args, "length"); Sint t_size ]),
Aifelse(Efun(Names.pervasives_qn ">", [ Efield (exp_args, "length"); Sint num_args ]),
(* given max number of iterations *)
mk_block [Aassgn(pat_step,
Emethod_call(jint, "parseInt", [get_arg t_size]))],
Emethod_call(jint, "parseInt", [get_arg num_args]))],
(* default max number of iterations *)
mk_block [Aassgn(pat_step, Evar id_step_dnb)]);
in
let ty_ret = Obc2java.ty NamesEnv.empty ty_main in
let vd_ret, pat_ret, exp_ret = mk_var ty_ret "ret" in
let vd_ret, pat_ret, exp_ret = mk_var ty_ret false "ret" in
let call_main = match ty_ret with
| Tunit -> Aexp(Emethod_call(e_main, "step", []))
| _ -> Anewvar (vd_ret, Emethod_call(e_main, "step", []))
@ -111,9 +112,13 @@ let program p =
in
let vd_t1, e_t1 =
let id = Idents.gen_var "java_main" "t" in
mk_var_dec id Tlong, Evar id
mk_var_dec id false Tlong, Evar id
in
[ Anewvar(vd_main, Enew (Tclass q_main, main_args));
[ Aif(Efun(Names.pervasives_qn "<", [ Efield (exp_args, "length"); Sint num_args ]),
mk_block [Aexp (Emethod_call(out, "printf",
[Sstring "error : not enough arguments.\\n"]));
Areturn Evoid]);
Anewvar(vd_main, Enew (Tclass q_main, main_args));
parse_max_iteration;
Anewvar(vd_t1, Emethod_call(jsys, "currentTimeMillis", []));
Obc2java.fresh_for exp_step main_for_loop;

2
compiler/obc/java/java_printer.ml
View file

@ -62,7 +62,7 @@ and new_init_ty ff t = _ty true true ff t
and ty ff t = _ty false false ff t
and var_dec init ff vd =
if init then
if init & not vd.vd_alias then
fprintf ff "%a %a = %a" ty vd.vd_type var_ident vd.vd_ident exp (Java.default_value vd.vd_type)
else
fprintf ff "%a %a" ty vd.vd_type var_ident vd.vd_ident

16
compiler/obc/java/obc2java.ml
View file

@ -39,7 +39,7 @@ let add_classe, get_classes =
with [body] a function from [var_ident] (the iterator) to [act] list *)
let fresh_for size body =
let i = Idents.gen_var "obc2java" "i" in
let id = mk_var_dec i Tint in
let id = mk_var_dec i false Tint in
Afor (id, Sint 0, size, mk_block (body i))
(** fresh nested Afor from 0 to [size]
@ -54,11 +54,11 @@ let fresh_nfor s_l body =
let rec aux s_l i_l = match s_l with
| [s] ->
let i = Idents.gen_var "obc2java" "i" in
let id = (mk_var_dec i Tint) in
let id = (mk_var_dec i false Tint) in
Afor (id, Sint 0, s, mk_block (body (List.rev (i::i_l))))
| s::s_l ->
let i = Idents.gen_var "obc2java" "i" in
let id = mk_var_dec i Tint in
let id = mk_var_dec i false Tint in
Afor (id, Sint 0, s, mk_block ([aux s_l (i::i_l)]))
| [] -> Misc.internal_error "Fresh nfor called with empty size list"
in
@ -213,7 +213,9 @@ and ty param_env t =
Tarray (tin, s_l)
| Types.Tinvalid -> Misc.internal_error "obc2java invalid type"
and var_dec param_env vd = { vd_type = ty param_env vd.v_type; vd_ident = vd.v_ident }
and var_dec param_env vd = { vd_type = ty param_env vd.v_type;
vd_alias = vd.v_alias;
vd_ident = vd.v_ident }
and var_dec_list param_env vd_l = List.map (var_dec param_env) vd_l
@ -290,7 +292,7 @@ let rec act_list param_env act_l acts =
| Obc.Acall (p_l, obj, Mstep, e_l) ->
let return_ty = p_l |> pattern_list_to_type |> (ty param_env) in
let return_id = Idents.gen_var "obc2java" "out" in
let return_vd = { vd_type = return_ty; vd_ident = return_id } in
let return_vd = mk_var_dec return_id false return_ty in
let ecall = Emethod_call (obj_ref param_env obj, "step", exp_list param_env e_l) in
let assgn = Anewvar (return_vd, ecall) in
let copy_return_to_var i p =
@ -349,7 +351,7 @@ and block param_env ?(locals=[]) ?(end_acts=[]) ob =
let sig_params_to_vds p_l =
let param_to_arg param_env p =
let p_ident = Idents.gen_var "obc2java" (String.uppercase p.Signature.p_name) in
let p_vd = { vd_ident = p_ident; vd_type = ty param_env p.Signature.p_type } in
let p_vd = mk_var_dec p_ident false (ty param_env p.Signature.p_type) in
let param_env = NamesEnv.add p.Signature.p_name p_ident param_env in
p_vd, param_env
in Misc.mapfold param_to_arg NamesEnv.empty p_l
@ -359,7 +361,7 @@ let sig_args_to_vds param_env a_l =
let arg_to_vd { a_name = n; a_type = t } =
let n = match n with None -> "v" | Some s -> s in
let id = Idents.gen_var "obc2java" n in
mk_var_dec id (ty param_env t)
mk_var_dec id false (ty param_env t)
in List.map arg_to_vd a_l
(** [copy_to_this vd_l] creates [this.x = x] for all [x] in [vd_l] *)

4
compiler/obc/obc.ml
View file

@ -76,7 +76,7 @@ type method_name =
type act =
| Aassgn of pattern * exp
| Aop of op_name * exp list
| Aop of op_name * exp list (* TODO c'est un peu bizare ce truc *)
| Acall of pattern list * obj_ref * method_name * exp list
| Acase of exp * (constructor_name * block) list
| Afor of var_dec * exp * exp * block
@ -89,7 +89,7 @@ and block =
and var_dec =
{ v_ident : var_ident;
v_type : ty;
v_alias : bool; (* this var_dec only declare a const pointer, no allocation is done *)
v_alias : bool; (* this var_dec only declare a const pointer, no allocation is needed *)
v_linearity : linearity;
v_mutable : bool;
v_loc : location }

24
compiler/obc/transformations/scalarize.ml
View file

@ -11,12 +11,6 @@
they are only used as reference to the array, no copy is implied :
array assignation after [scalarize] is pointer wise assignation *)
open Misc
open Obc
open Obc_utils
open Obc_mapfold
(** Scalarize the code : any equation t = e with e_ty an array
is transformed into : t_ref = e; for i do t[i] = t_ref[i].
This pass assumes that the backend when encountering t_ref = (e : int^n) will NOT COPY the array
@ -24,11 +18,27 @@ open Obc_mapfold
No t_ref is created if e was an extended value, no calculation is done, so it can be duplicated.
*)
(** Note that Minils gives few opportunities to [Scalarize]
Eop with a unique return value or Earray :
fun pix_2(x :int^3) = (o :int^3^2) let o = [x,x] tel
fun pix2(x :int^3) = () var o : pixel^2; let o = pix_2(x); tel
The latter is a special Acall
*)
open Misc
open Obc
open Obc_utils
open Obc_mapfold
let fresh_for = fresh_for "scalarize"
let act funs () a = match a with
(* TODO | Acall([p], ...) *)
| Aassgn (p, e) ->
(match Modules.unalias_type e.e_ty with
(match Modules.unalias_type p.pat_ty with
| Types.Tarray (t, size) ->
let new_vd, new_eq, w_from_e = match e.e_desc with
| Eextvalue w -> [], [], w