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

100 and java scalarized

This commit is contained in:
Léonard Gérard 2011-04-19 18:45:56 +02:00
parent 802178fb28
commit d6240e1c67
21 changed files with 141 additions and 123 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
compiler/heptagon/hept_mapfold.ml
View File

@ -285,7 +285,7 @@ and program_desc_it funs acc pd =
with Fallback -> program_desc funs acc pd
and program_desc funs acc pd = match pd with
| Pconst cd -> let cd, acc = const_dec_it funs acc cd in Pconst cd, acc
| Ptype td -> (*let td, acc = Global_mapfold.ty_it funs.global_funs acc td in Ptype td, acc*) pd, acc
| Ptype td -> pd, acc
| Pnode n -> let n, acc = node_dec_it funs acc n in Pnode n, acc
let defaults = {

2
compiler/main/mls2seq.ml
View File

@ -41,7 +41,7 @@ let write_obc_file p =
let no_conf () = ()
let targets = [ "c",(Obc_no_params Cmain.program, no_conf);
"java", (Obc Java_main.program, Java_main.java_conf);
"java", (Obc Java_main.program, no_conf);
"obc", (Obc write_obc_file, no_conf);
"obc_np", (Obc_no_params write_obc_file, no_conf);
"epo", (Minils write_object_file, no_conf) ]

11
compiler/obc/java/java_main.ml
View File

@ -3,15 +3,14 @@ open Signature
open Java
open Java_printer
let java_conf () =
Compiler_options.do_scalarize := true
(** returns the vd and the pat of a fresh ident from [name] *)
let mk_var ty name =
let id = Idents.gen_var "java_main" name in
mk_var_dec id ty, Pvar id
let program p =
(*Scalarize*)
let p = Compiler_utils.pass "Scalarize" true Scalarize.program p Obc_compiler.pp in
let p_java = Obc2java.program p in
let dir = Compiler_utils.build_path "java" in
Compiler_utils.ensure_dir dir;
@ -30,11 +29,13 @@ let program p =
in
let main_methode =
let vd_step, pat_step = mk_var Tint "step" in
let vd_args, pat_args = mk_var (Tarray (Tclass (Names.pervasives_qn "String"), (Sint 0))) "args" in
let vd_args, pat_args =
mk_var (Tarray (Tclass (Names.pervasives_qn "String"), (Sint 0))) "args" in
let body =
let vd_main, e_main, q_main, ty_main =
let q_main = !Compiler_options.simulation_node |> Modules.qualify_value in (*qual*)
let ty_main = (Modules.find_value q_main).node_outputs |> types_of_arg_list |> Types.prod in
let ty_main =
(Modules.find_value q_main).node_outputs |> types_of_arg_list |> Types.prod in
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), Eval (Pvar id), q_main, ty_main

42
compiler/obc/java/obc2java.ml
View File

@ -15,8 +15,8 @@
Obc.Oobj and Oarray are simply Pvar and Parray_elem
Obc.Types_alias are dereferenced since no simple type alias is possible in Java *)
(** Requires scalar Obc : [p = e] when [e] is an array is understand as a copy of the reference,
not a copy of the array. *)
(** Requires scalarized Obc :
[p = e] when [e] is an array is understand as a copy of the reference, not a copy of the array.*)
open Format
open Misc
@ -34,19 +34,22 @@ let add_classe, get_classes =
(fun c -> extra_classes := c :: !extra_classes)
,(fun () -> !extra_classes)
(** fresh Afor from 0 to [size] with [body] a function from [var_ident] (the iterator) to [act] list *)
(** fresh Afor from 0 to [size]
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
Afor (id, Sint 0, size, mk_block (body i))
(* current module is not translated to keep track, there is no issue since printed without the qualifier *)
(* current module is not translated to keep track,
there is no issue since printed without the qualifier *)
let rec translate_modul m = match m with
| Pervasives
| LocalModule -> m
| _ when m = g_env.current_mod -> m
| Module n -> Module (String.lowercase n)
| QualModule { qual = q; name = n} -> QualModule { qual = translate_modul q; name = String.lowercase n }
| QualModule { qual = q; name = n} ->
QualModule { qual = translate_modul q; name = String.lowercase n }
(** a [Module.const] becomes a [module.CONSTANTES.CONST] *)
let translate_const_name { qual = m; name = n } =
@ -68,7 +71,8 @@ let qualname_to_package_classe q =
(** Create a fresh class qual from a name *)
let fresh_classe n = Modules.fresh_value "obc2java" n |> qualname_to_package_classe
(** a [Module.Constr] of an [Module.enum] type becomes a [module.Enum.CONSTR] of the [module.Enum] class *)
(** a [Module.Constr] of an [Module.enum] type
becomes a [module.Enum.CONSTR] of the [module.Enum] class *)
let translate_constructor_name_2 q q_ty =
let classe = qualname_to_class_name q_ty in
{ qual = QualModule classe; name = String.uppercase q.name }
@ -109,7 +113,8 @@ let rec static_exp param_env se = match se.Types.se_desc with
in
let se_l = Misc.repeat_list (static_exp param_env see) pow in
Enew_array (ty param_env se.Types.se_ty, se_l)
| Types.Sarray se_l -> Enew_array (ty param_env se.Types.se_ty, List.map (static_exp param_env) se_l)
| Types.Sarray se_l ->
Enew_array (ty param_env se.Types.se_ty, List.map (static_exp param_env) se_l)
| Types.Srecord _ -> eprintf "ojSrecord@."; assert false; (* TODO java *)
| Types.Sop (f, se_l) -> Efun (qualname_to_class_name f, List.map (static_exp param_env) se_l)
@ -270,7 +275,8 @@ let class_def_list classes cd_l =
in
(* [reset] is the reset method of the class,
[reset_mems] is the block to reset the members of the class
without call to the reset method of inner instances, it retains [this.x = 0] but not [this.I.reset()] *)
without call to the reset method of inner instances,
it retains [this.x = 0] but not [this.I.reset()] *)
let reset, reset_mems =
try (* When there exist a reset method *)
let oreset = find_reset_method cd in
@ -280,7 +286,8 @@ let class_def_list classes cd_l =
with Not_found -> (* stub reset method *)
mk_methode (mk_block []) "reset", mk_block []
in
(* [obj_env] gives the type of an [obj_ident], needed in async because we change the classe for async obj *)
(* [obj_env] gives the type of an [obj_ident],
needed in async because we change the classe for async obj *)
let constructeur, obj_env =
let obj_env = (* Mapping between Obc class and Java class, useful at least with asyncs *)
let aux obj_env od =
@ -299,7 +306,9 @@ let class_def_list classes cd_l =
| Some size ->
let size = static_exp param_env size in
let t = Idents.Env.find od.o_ident obj_env in
let assgn_elem i = [ Aassgn (Parray_elem (Pthis od.o_ident, mk_var i), Enew (t, params)) ] in
let assgn_elem i =
[ Aassgn (Parray_elem (Pthis od.o_ident, mk_var i), Enew (t, params)) ]
in
(Aassgn (Pthis od.o_ident, Enew_array (Tarray (t,size), [])))
:: (fresh_for size assgn_elem)
:: acts
@ -324,7 +333,9 @@ let class_def_list classes cd_l =
in mk_methode ~args:vds_params body (shortname class_name), obj_env
in
let fields =
let mem_to_field fields vd = (mk_field ~protection:Pprotected (ty param_env vd.v_type) vd.v_ident) :: fields in
let mem_to_field fields vd =
(mk_field ~protection:Pprotected (ty param_env vd.v_type) vd.v_ident) :: fields
in
let obj_to_field fields od =
let jty = match od.o_size with
| None -> Idents.Env.find od.o_ident obj_env
@ -340,7 +351,8 @@ let class_def_list classes cd_l =
let ostep = find_step_method cd in
let vd_output = var_dec_list param_env ostep.m_outputs in
let return_ty = ostep.m_outputs |> vd_list_to_type |> (ty param_env) in
let return_act = Areturn (match vd_output with
let return_act =
Areturn (match vd_output with
| [] -> Evoid
| [vd] -> Eval (Pvar vd.vd_ident)
| vd_l -> Enew (return_ty, List.map (fun vd -> Eval (Pvar vd.vd_ident)) vd_l))
@ -371,7 +383,8 @@ let type_dec_list classes td_l =
let jty = ty param_env oty in
let field = Idents.ident_of_name (translate_field_name oname) in
(* [translate_field_name] will give the right result anywhere it is used,
since the [ident_of_name] will keep it as it is unique in the class, see [Idents.enter_node classe_name] *)
since the [ident_of_name] will keep it as it is unique in the class,
see [Idents.enter_node classe_name] *)
mk_field jty field
in
(mk_classe ~fields:(List.map mk_field_jfield f_l) classe_name) :: classes
@ -387,7 +400,8 @@ let const_dec_list cd_l = match cd_l with
let param_env = NamesEnv.empty in
let mk_const_field { Obc.c_name = oname ; Obc.c_value = ovalue; Obc.c_type = otype } =
let name = oname |> translate_const_name |> shortname |> Idents.ident_of_name in
(* name should always keep the shortname unchanged since we enter a special node free of existing variables *)
(* name should always keep the shortname unchanged
since we enter a special node free of existing variables *)
(* thus [translate_const_name] will gives the right result anywhere it is used. *)
let value = Some (static_exp param_env ovalue) in
let t = ty param_env otype in

2
compiler/obc/main/obc_compiler.ml
View File

@ -16,6 +16,4 @@ let pp p = if !verbose then Obc_printer.print stdout p
let compile_program p =
(*Control optimization*)
let p = pass "Control optimization" true Control.program p pp in
(* (*Scalarize*)
let p = pass "Scalarize" !do_scalarize Scalarize.program p pp in *)
p

11
compiler/obc/transformations/scalarize.ml
View File

@ -17,15 +17,20 @@ 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
but set a reference to it. *)
let fresh_for = fresh_for "scalarize"
let act funs () a = match a with
| Aassgn (p,e) ->
(match e.e_ty with
| Types.Tarray (t, size) -> (* TODO ayayayaye *)
| Types.Tarray (t, size) ->
(* a reference (alias) to the array, since we could have a full expression *)
let array_ref = Idents.gen_var "scalarize" "a_ref" in
let vd_array_ref = mk_var_dec array_ref (Types.Tmutable p.pat_ty) in
let vd_array_ref = mk_var_dec array_ref p.pat_ty in
(* reference initialization *)
let pat_array_ref = mk_pattern ~loc:e.e_loc p.pat_ty (Lvar array_ref) in
let init_array_ref = Aassgn (pat_array_ref, e) in
@ -38,7 +43,7 @@ let act funs () a = match a with
let a, _ = act_it funs () a in
[a]
in
let copy_array = fresh_for size copy_i in
let copy_array = fresh_for (mk_exp_const_int 0) (mk_exp_static_int size) copy_i in
(* resulting block *)
let block = mk_block ~locals:[vd_array_ref] [init_array_ref; copy_array] in
Ablock block, ()