From 86f743318b824d00b759ec55a1a7e5bb58f37fc0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9onard=20G=C3=A9rard?= Date: Mon, 14 Feb 2011 15:21:57 +0100 Subject: [PATCH] Fixes and basic Java main. --- compiler/global/global_printer.ml | 22 ++-- compiler/main/mls2obc.ml | 7 +- compiler/obc/control.ml | 1 + compiler/obc/java/java.ml | 16 +++ compiler/obc/java/java_main.ml | 63 +++++++++++- compiler/obc/java/java_printer.ml | 45 ++++---- compiler/obc/java/obc2java.ml | 55 +++++----- compiler/obc/obc.ml | 77 -------------- compiler/obc/obc_utils.ml | 97 ++++++++++++++++++ compiler/utilities/global/compiler_options.ml | 4 +- lib/java/jeptagon.jar | Bin 5291 -> 0 bytes test/async/java_m | 4 +- test/async/pipline_a.ept | 10 ++ test/good/t13.ept | 2 +- 14 files changed, 259 insertions(+), 144 deletions(-) delete mode 100644 lib/java/jeptagon.jar diff --git a/compiler/global/global_printer.ml b/compiler/global/global_printer.ml index 91b1f7a..dd4aee3 100644 --- a/compiler/global/global_printer.ml +++ b/compiler/global/global_printer.ml @@ -8,26 +8,30 @@ open Format open Pp_tools -let rec _print_modul ff m = match m with +let rec _aux_print_modul ?(full=false) ff m = match m with | Pervasives -> () | LocalModule -> () - | _ when m = g_env.current_mod -> () + | _ when m = g_env.current_mod && not full -> () | Module m -> fprintf ff "%a." print_name m - | QualModule { qual = m; name = n } -> fprintf ff "%a%a." _print_modul m print_name n + | QualModule { qual = m; name = n } -> fprintf ff "%a%a." (_aux_print_modul ~full:full) m print_name n (** Prints a [modul] with a [.] at the end when not empty *) -let print_modul ff m = match m with +let _print_modul ?(full=false) ff m = match m with | Pervasives -> () | LocalModule -> () - | _ when m = g_env.current_mod -> () + | _ when m = g_env.current_mod && not full -> () | Module m -> fprintf ff "%a" print_name m - | QualModule { qual = m; name = n } -> fprintf ff "%a%a" _print_modul m print_name n + | QualModule { qual = m; name = n } -> fprintf ff "%a%a" (_aux_print_modul ~full:full) m print_name n +let print_full_modul ff m = _print_modul ~full:true ff m +let print_modul ff m = _print_modul ~full:false ff m -let print_qualname ff { qual = q; name = n} = match q with +let _print_qualname ?(full=false) ff { qual = q; name = n} = match q with | Pervasives -> print_name ff n | LocalModule -> print_name ff n - | _ when q = g_env.current_mod -> print_name ff n - | _ -> fprintf ff "%a%a" _print_modul q print_name n + | _ when q = g_env.current_mod && not full -> print_name ff n + | _ -> fprintf ff "%a%a" (_aux_print_modul ~full:full) q print_name n +let print_qualname ff qn = _print_qualname ~full:false ff qn +let print_full_qualname ff qn = _print_qualname ~full:true ff qn let print_shortname ff {name = n} = print_name ff n diff --git a/compiler/main/mls2obc.ml b/compiler/main/mls2obc.ml index 792840b..7c2248d 100644 --- a/compiler/main/mls2obc.ml +++ b/compiler/main/mls2obc.ml @@ -13,9 +13,10 @@ open Names open Idents open Signature open Obc +open Obc_utils +open Obc_mapfold open Types open Static -open Obc_mapfold open Initial @@ -225,9 +226,9 @@ let size_from_call_context c = match c with let empty_call_context = None -(** [si] is the initialization actions used in the reset method. +(** [si] the initialization actions used in the reset method, [j] obj decs - [s] is the list of actions used in the step method. + [s] the actions used in the step method. [v] var decs *) let rec translate_eq map call_context { Minils.eq_lhs = pat; Minils.eq_rhs = e } (v, si, j, s) = diff --git a/compiler/obc/control.ml b/compiler/obc/control.ml index 8bb2a5c..28319a6 100644 --- a/compiler/obc/control.ml +++ b/compiler/obc/control.ml @@ -14,6 +14,7 @@ open Minils open Idents open Misc open Obc +open Obc_utils open Clocks let var_from_name map x = diff --git a/compiler/obc/java/java.ml b/compiler/obc/java/java.ml index fe85372..734c7de 100644 --- a/compiler/obc/java/java.ml +++ b/compiler/obc/java/java.ml @@ -76,6 +76,7 @@ and act = Anewvar of var_dec * exp | Areturn of exp and exp = Eval of pattern + | Ethis | Efun of op_name * exp list | Emethod_call of exp * method_name * exp list | Easync_method_call of exp * method_name * exp list @@ -87,8 +88,10 @@ and exp = Eval of pattern | Sfloat of float | Sbool of bool | Sconstructor of constructor_name + | Sstring of string | Snull + and pattern = Pfield of pattern * field_name | Pclass of class_name | Pvar of var_ident @@ -107,6 +110,19 @@ let default_value ty = match ty with | Tunit -> Evoid | Tarray _ -> Enew_array (ty,[]) + +let java_pervasives = Names.modul_of_string "jeptagon.Pervasives" +let java_pervasives_class = Names.qualname_of_string "jeptagon.Pervasives" + +let java_callable = Names.qualname_of_string "java.util.concurrent.Callable" + +let import_async = [Names.qualname_of_string "java.util.concurrent.Future"; + Names.qualname_of_string "java.util.concurrent.ExecutionException"] + +let throws_async = [Names.qualname_of_string "InterruptedException"; + Names.qualname_of_string "ExecutionException"] + + let mk_var x = Eval (Pvar x) let mk_var_dec x ty = diff --git a/compiler/obc/java/java_main.ml b/compiler/obc/java/java_main.ml index 485d29e..776e2aa 100644 --- a/compiler/obc/java/java_main.ml +++ b/compiler/obc/java/java_main.ml @@ -1,10 +1,69 @@ - +open Misc open Java open Java_printer +(** 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 = let p_java = Obc2java.program p in let dir = Compiler_utils.build_path "java" in Compiler_utils.ensure_dir dir; - output_program dir p_java \ No newline at end of file + + (* Compile and output the nodes *) + output_program dir p_java; + + (* Create a runnable main simulation *) + if !Compiler_options.simulation + then ( + let class_name = Obc2java.fresh_classe (!Compiler_options.simulation_node ^ "_sim") in + Idents.enter_node class_name; + let field_step_dnb, id_step_dnb = + let id = Idents.gen_var "java_main" "default_step_nb" in + mk_field ~static:true ~final:true ~value:(Some (Sint 30000)) Tint id, id + 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 body = + let vd_main, e_main, q_main = + let q_main = !Compiler_options.simulation_node |> Modules.qualify_value |> Obc2java.qualname_to_package_classe + in let id = Idents.gen_var "java_main" "main" in + mk_var_dec id (Tclass q_main), Eval (Pvar id), q_main + in + let acts = + let integer = Eval(Pclass(Names.pervasives_qn "Integer")) in + let args1 = Eval(Parray_elem(pat_args, Sint 1)) in + let out = Eval(Pclass(Names.qualname_of_string "java.lang.System.out")) in + let vd_r, pat_r = mk_var Tint "r" in + let step_call = Anewvar(vd_r, Emethod_call(e_main, "step", [])) in + [ Anewvar(vd_main, Enew (Tclass q_main, [])); + Aifelse( Efun(Names.pervasives_qn ">", [Eval (Pfield (pat_args, "length")); Sint 1]) + , mk_block [Aassgn(pat_step, Emethod_call(integer, "parseInt", [args1]))] + , mk_block [Aassgn(pat_step, Eval (Pvar id_step_dnb))]); + Obc2java.fresh_for (Eval pat_step) + (fun i -> + let printing = + if !Compiler_options.verbose + then [Amethod_call(out, "printf", [Sstring "%d => %d\\n"; Eval (Pvar i); Eval pat_r])] + else [] + in step_call::printing ) + ] + in + mk_block ~locals:[vd_step] acts + in + mk_methode ~static:true ~args:[vd_args] ~throws:throws_async body "main" + in + let c = mk_classe ~imports:import_async ~fields:[field_step_dnb] ~methodes:[main_methode] class_name in + output_program dir [c] + ) + + + + + + + + diff --git a/compiler/obc/java/java_printer.ml b/compiler/obc/java/java_printer.ml index 1025f8b..ca5fdb7 100644 --- a/compiler/obc/java/java_printer.ml +++ b/compiler/obc/java/java_printer.ml @@ -68,6 +68,7 @@ and field ff f = (print_opt2 exp " = ") f.f_value and exp ff = function + | Ethis -> fprintf ff "this" | Eval p -> pattern ff p | Efun (f,e_l) -> op ff (f, e_l) | Emethod_call (o,m,e_l) -> fprintf ff "%a.%a%a" exp o method_name m args e_l @@ -83,6 +84,7 @@ and exp ff = function | Sfloat f -> pp_print_float ff f | Sbool b -> pp_print_bool ff b | Sconstructor c -> constructor_name ff c + | Sstring s -> fprintf ff "\"%s\"" s | Snull -> fprintf ff "null" and op ff (f, e_l) = @@ -101,18 +103,19 @@ and op ff (f, e_l) = | Names.Pervasives -> (match Names.shortname f with |("+" | "-" | "*" | "/" - |"+." | "-." | "*." | "/." - | "=" | "<>" | "<" | "<=" - | ">" | ">=" | "&" | "or") as n -> - let e1,e2 = Misc.assert_2 e_l in - fprintf ff "(@[%a@ %s %a@])" exp e1 (javaop n) exp e2 + |"+." | "-." | "*." | "/." + | "=" | "<>" | "<" | "<=" + | ">" | ">=" | "&" | "or") as n -> + let e1,e2 = Misc.assert_2 e_l in + fprintf ff "(@[%a@ %s %a@])" exp e1 (javaop n) exp e2 | "not" -> let e = Misc.assert_1 e_l in fprintf ff "!%a" exp e | "~-" -> let e = Misc.assert_1 e_l in fprintf ff "-%a" exp e - | _ -> Misc.unsupported "java_printer" 1) + | s -> fprintf ff "jeptagon.Pervasives.%s%a" s args e_l) (* TODO java deal with this correctly + bug when using Pervasives.ggg in the code but works when using ggg directly *) | _ -> fprintf ff "%a%a" Global_printer.print_qualname f args e_l and args ff e_l = fprintf ff "@[(%a)@]" (print_list_r exp """,""") e_l @@ -127,16 +130,18 @@ and pattern ff = function let rec block ff b = fprintf ff "%a%a" (vd_list """;"";") b.b_locals - (print_list_r act """;"";") b.b_body + (print_list_r act """""") b.b_body +(* and switch_hack ff c_b_l = fprintf ff "@[ default :\\Dead code. Hack to prevent \"may not be initialized\" java error.@ %a@ break;@]" block (c_b_l |> List.hd |> snd) +*) and act ff = function - | Anewvar (vd,e) -> fprintf ff "@[<2>%a =@ %a@]" (var_dec false) vd exp e - | Aassgn (p,e) -> fprintf ff "@[<2>%a =@ %a@]" pattern p exp e - | Amethod_call (o,m,e_l) -> fprintf ff "@[%a.%a%a@]" exp o method_name m args e_l + | Anewvar (vd,e) -> fprintf ff "@[<4>%a =@ %a;@]" (var_dec false) vd exp e + | Aassgn (p,e) -> fprintf ff "@[<4>%a =@ %a;@]" pattern p exp e + | Amethod_call (o,m,e_l) -> fprintf ff "@[%a.%a%a;@]" exp o method_name m args e_l | Aasync_method_call _ -> Misc.internal_error "java_printer, Aasync call not translated" 1 | Aswitch (e, c_b_l) -> let pcb ff (c,b) = fprintf ff "@[case %a:@ %a@ break;@]" bare_constructor_name c block b in @@ -148,25 +153,25 @@ and act ff = function exp e (print_list_r pcb """""") c_b_l | Aif (e,bt) -> - fprintf ff "@[@[if (%a) {@ %a@]@ }@]" exp e block bt + fprintf ff "@[if (%a) {@ %a }@]" exp e block bt | Aifelse (e,bt,bf) -> - fprintf ff "@[@[if (%a) {@ %a@ @]}@\n@[else {@ %a@]@ }@]" + fprintf ff "@[@[if (%a) {@ %a@]@ @[} else {@ %a@]@ }@]" exp e block bt block bf - | Ablock b -> fprintf ff "@[{@ %a@ }]" block b + | Ablock b -> if (List.length b.b_body > 0) then fprintf ff "@[@[{@ %a@]@ }@]" block b | Afor (x, i1, i2, b) -> - fprintf ff "@[@[for (%a = %a; %a<%a; %a++) {@ %a@]@ }@]" + fprintf ff "@[@[for (%a = %a; %a<%a; %a++) {@ %a@]@ }@]" (var_dec false) x exp i1 var_ident x.vd_ident exp i2 var_ident x.vd_ident block b - | Areturn e -> fprintf ff "return %a" exp e + | Areturn e -> fprintf ff "return %a;" exp e let methode ff m = - fprintf ff "@[%a%a%a %a @[<2>(%a)@] @[%a@]{@ %a@]@\n}" + fprintf ff "@[%a%a%a %a @[<4>(%a)@] @[%a@]{@ %a@]@\n}" protection m.m_protection static m.m_static ty m.m_returns @@ -176,7 +181,7 @@ let methode ff m = block m.m_body let constructor ff m = - fprintf ff "@[%a%a @[<2>(%a)@] {@\n%a@]@\n}" + fprintf ff "@[%a%a @[<4>(%a)@] {@\n%a@]@\n}" protection m.m_protection method_name m.m_name (print_list_r (var_dec false) """,""") m.m_args @@ -191,13 +196,13 @@ let rec class_desc ff cd = and classe ff c = match c.c_kind with | Cenum c_l -> - fprintf ff "@[<4>%a%aenum %a {@\n%a@]@\n}" + fprintf ff "@\n@[<4>%a%aenum %a {@\n%a@]@\n}" protection c.c_protection static c.c_static bare_class_name c.c_name (print_list_r bare_constructor_name """,""") c_l | Cgeneric cd -> - fprintf ff "@[<4>%a%aclass %a @[%a@]{@\n%a@]@\n}" + fprintf ff "@\n@[<4>%a%aclass %a @[%a@]{@\n%a@]@\n}" protection c.c_protection static c.c_static bare_class_name c.c_name @@ -218,7 +223,7 @@ let output_classe base_dir c = let ff = Format.formatter_of_out_channel oc in pp_set_margin ff 120; fprintf ff "package %a;@\n@[%a@]@\n%a@." - Global_printer.print_modul package + Global_printer.print_full_modul package (print_list_r (fun ff n -> fprintf ff "import %a" class_name n) """;"";") c.c_imports classe c; close_out oc diff --git a/compiler/obc/java/obc2java.ml b/compiler/obc/java/obc2java.ml index 8b12701..aac12f4 100644 --- a/compiler/obc/java/obc2java.ml +++ b/compiler/obc/java/obc2java.ml @@ -21,18 +21,9 @@ open Names open Modules open Signature open Obc +open Obc_utils open Java -let java_pervasives = Names.modul_of_string "jeptagon.Pervasives" -let java_pervasives_class = Names.qualname_of_string "jeptagon.Pervasives" - -let java_callable = Names.qualname_of_string "java.util.concurrent.Callable" - -let import_async = [Names.qualname_of_string "java.util.concurrent.Future"; - Names.qualname_of_string "java.util.concurrent.ExecutionException"] - -let throws_async = [Names.qualname_of_string "InterruptedException"; - Names.qualname_of_string "ExecutionException"] let mk_classe = mk_classe ~imports:import_async @@ -49,10 +40,10 @@ let fresh_for size body = 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 *) -let rec translate_modul ?(full=false) m = match m with +let rec translate_modul m = match m with | Pervasives | LocalModule -> m - | _ when m = g_env.current_mod && not full -> 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 } @@ -67,7 +58,7 @@ let qualname_to_class_name q = (** a [Module.name] becomes a [module.Name] even on current_mod *) let qualname_to_package_classe q = - { qual = translate_modul ~full:true q.qual; name = String.capitalize q.name } + { qual = translate_modul q.qual; name = String.capitalize q.name } (** Create a fresh class qual from a name *) let fresh_classe n = Modules.fresh_value "obc2java" n |> qualname_to_package_classe @@ -356,9 +347,18 @@ let class_def_list classes cd_l = let f = vds_to_fields ~protection:Pprotected v in let e = vds_to_exps v in f, v, e, env + 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()] *) + let reset, reset_mems = + let oreset = find_reset_method cd in + let body = block param_env oreset.Obc.m_body in + let reset_mems = block param_env (remove_resets oreset.Obc.m_body) in + mk_methode body "reset", reset_mems in (* [obj_env] gives the type of an [obj_ident], needed in async because we change the classe for async obj *) - let constructeur, param_env, obj_env = + let constructeur, obj_env = let obj_env = (* In async we change the type of the async objects *) let aux obj_env od = let t = match od.o_async with @@ -367,28 +367,32 @@ let class_def_list classes cd_l = in Idents.Env.add od.o_ident t obj_env in List.fold_left aux Idents.Env.empty cd.cd_objs in + let body = (* TODO java array : also initialize arrays with [ new int[3] ] *) (* Initialize the objects *) let obj_init_act acts od = let params = List.map (static_exp param_env) od.o_params in - let act = match od.o_size with + match od.o_size with | None -> let t = Idents.Env.find od.o_ident obj_env in - [ Aassgn (Pthis od.o_ident, Enew (t, params)) ] + (Aassgn (Pthis od.o_ident, Enew (t, params)))::acts | 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 - [ Aassgn (Pthis od.o_ident, Enew_array (Tarray (t,size), [])); - fresh_for size assgn_elem ] - in act@acts + (Aassgn (Pthis od.o_ident, Enew_array (Tarray (t,size), []))) + :: (fresh_for size assgn_elem) + :: acts in - let acts_init_params = copy_to_this vds_params in - let acts = List.fold_left obj_init_act acts_init_params cd.cd_objs in + (* init member variables *) + let acts = [Ablock reset_mems] in + (* init member objects *) + let acts = List.fold_left obj_init_act acts cd.cd_objs in + (* init static params *) + let acts = (copy_to_this vds_params)@acts in { b_locals = []; b_body = acts } - in - mk_methode ~args:vds_params body (shortname class_name), param_env, obj_env + 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 @@ -415,11 +419,6 @@ let class_def_list classes cd_l = let body = block param_env ~locals:vd_output ~end_acts:[return_act] ostep.Obc.m_body in mk_methode ~throws:throws_async ~args:(var_dec_list param_env ostep.Obc.m_inputs) ~returns:return_ty body "step" in - let reset = - let oreset = find_reset_method cd in - let body = block param_env oreset.Obc.m_body in - mk_methode body "reset" - in let classe = mk_classe ~fields:fields ~constrs:[constructeur] ~methodes:[step;reset] class_name in classe::classes diff --git a/compiler/obc/obc.ml b/compiler/obc/obc.ml index 235dc9c..aa8ab0f 100644 --- a/compiler/obc/obc.ml +++ b/compiler/obc/obc.ml @@ -108,80 +108,3 @@ type program = p_consts : const_dec list; p_defs : class_def list } -let mk_var_dec ?(loc=no_location) ident ty = - { v_ident = ident; v_type = ty; v_loc = loc } - -let mk_exp ?(loc=no_location) ty desc = - { e_desc = desc; e_ty = ty; e_loc = loc } - -let mk_exp_int ?(loc=no_location) desc = - { e_desc = desc; e_ty = Initial.tint; e_loc = loc } - -let mk_exp_bool ?(loc=no_location) desc = - { e_desc = desc; e_ty = Initial.tbool; e_loc = loc } - -let mk_pattern ?(loc=no_location) ty desc = - { pat_desc = desc; pat_ty = ty; pat_loc = loc } - -let mk_pattern_int ?(loc=no_location) desc = - { pat_desc = desc; pat_ty = Initial.tint; pat_loc = loc } - -let mk_pattern_exp ty desc = - let pat = mk_pattern ty desc in - mk_exp ty (Epattern pat) - -let mk_evar ty id = - mk_exp ty (Epattern (mk_pattern ty (Lvar id))) - -let mk_evar_int id = - mk_exp Initial.tint (Epattern (mk_pattern Initial.tint (Lvar id))) - -let mk_block ?(locals=[]) eq_list = - { b_locals = locals; - b_body = eq_list } - -let rec var_name x = - match x.pat_desc with - | Lvar x -> x - | Lmem x -> x - | Lfield(x,_) -> var_name x - | Larray(l, _) -> var_name l - -(** Returns whether an object of name n belongs to - a list of var_dec. *) -let rec vd_mem n = function - | [] -> false - | vd::l -> vd.v_ident = n or (vd_mem n l) - -(** Returns the var_dec object corresponding to the name n - in a list of var_dec. *) -let rec vd_find n = function - | [] -> Format.eprintf "Not found var %s@." (name n); raise Not_found - | vd::l -> - if vd.v_ident = n then vd else vd_find n l - -(** Returns the type of a [var_dec list] *) -let vd_list_to_type vd_l = match vd_l with - | [] -> Types.Tunit - | [vd] -> vd.v_type - | _ -> Tprod (List.map (fun vd -> vd.v_type) vd_l) - -let pattern_list_to_type p_l = match p_l with - | [] -> Types.Tunit - | [p] -> p.pat_ty - | _ -> Tprod (List.map (fun p -> p.pat_ty) p_l) - -let pattern_of_exp e = match e.e_desc with - | Epattern l -> l - | _ -> assert false - -let find_step_method cd = - List.find (fun m -> m.m_name = Mstep) cd.cd_methods -let find_reset_method cd = - List.find (fun m -> m.m_name = Mreset) cd.cd_methods - -let obj_ref_name o = - match o with - | Oobj obj - | Oarray (obj, _) -> obj - diff --git a/compiler/obc/obc_utils.ml b/compiler/obc/obc_utils.ml index aa37f04..b9c2348 100644 --- a/compiler/obc/obc_utils.ml +++ b/compiler/obc/obc_utils.ml @@ -8,12 +8,108 @@ (**************************************************************************) open Names +open Idents +open Location open Misc open Types open Obc open Obc_mapfold open Global_mapfold +let mk_var_dec ?(loc=no_location) ident ty = + { v_ident = ident; v_type = ty; v_loc = loc } + +let mk_exp ?(loc=no_location) ty desc = + { e_desc = desc; e_ty = ty; e_loc = loc } + +let mk_exp_int ?(loc=no_location) desc = + { e_desc = desc; e_ty = Initial.tint; e_loc = loc } + +let mk_exp_bool ?(loc=no_location) desc = + { e_desc = desc; e_ty = Initial.tbool; e_loc = loc } + +let mk_pattern ?(loc=no_location) ty desc = + { pat_desc = desc; pat_ty = ty; pat_loc = loc } + +let mk_pattern_int ?(loc=no_location) desc = + { pat_desc = desc; pat_ty = Initial.tint; pat_loc = loc } + +let mk_pattern_exp ty desc = + let pat = mk_pattern ty desc in + mk_exp ty (Epattern pat) + +let mk_evar ty id = + mk_exp ty (Epattern (mk_pattern ty (Lvar id))) + +let mk_evar_int id = + mk_exp Initial.tint (Epattern (mk_pattern Initial.tint (Lvar id))) + +let mk_block ?(locals=[]) eq_list = + { b_locals = locals; + b_body = eq_list } + +let rec var_name x = + match x.pat_desc with + | Lvar x -> x + | Lmem x -> x + | Lfield(x,_) -> var_name x + | Larray(l, _) -> var_name l + +(** Returns whether an object of name n belongs to + a list of var_dec. *) +let rec vd_mem n = function + | [] -> false + | vd::l -> vd.v_ident = n or (vd_mem n l) + +(** Returns the var_dec object corresponding to the name n + in a list of var_dec. *) +let rec vd_find n = function + | [] -> Format.eprintf "Not found var %s@." (name n); raise Not_found + | vd::l -> + if vd.v_ident = n then vd else vd_find n l + +(** Returns the type of a [var_dec list] *) +let vd_list_to_type vd_l = match vd_l with + | [] -> Types.Tunit + | [vd] -> vd.v_type + | _ -> Tprod (List.map (fun vd -> vd.v_type) vd_l) + +let pattern_list_to_type p_l = match p_l with + | [] -> Types.Tunit + | [p] -> p.pat_ty + | _ -> Tprod (List.map (fun p -> p.pat_ty) p_l) + +let pattern_of_exp e = match e.e_desc with + | Epattern l -> l + | _ -> assert false + +let find_step_method cd = + List.find (fun m -> m.m_name = Mstep) cd.cd_methods +let find_reset_method cd = + List.find (fun m -> m.m_name = Mreset) cd.cd_methods + +let obj_ref_name o = + match o with + | Oobj obj + | Oarray (obj, _) -> obj + +(** Input a block [b] and remove all calls to [Reset] method from it *) +let remove_resets b = + let block funs _ b = + let b,_ = Obc_mapfold.block funs () b in + let is_not_reset a = match a with + | Acall( _,_,Mreset,_) -> false + | _ -> true + in + let b = { b with b_body = List.filter is_not_reset b.b_body } in + b, () + in + let funs = { Obc_mapfold.defaults with block = block } in + let b,_ = block_it funs () b in + b + + +(* module Deps = struct @@ -69,3 +165,4 @@ struct let (_, deps) = Obc_mapfold.program funs S.empty p in S.remove p.p_modname (S.remove Pervasives deps) end +*) \ No newline at end of file diff --git a/compiler/utilities/global/compiler_options.ml b/compiler/utilities/global/compiler_options.ml index 1a0a3ac..adcd62b 100644 --- a/compiler/utilities/global/compiler_options.ml +++ b/compiler/utilities/global/compiler_options.ml @@ -54,10 +54,10 @@ let assert_nodes : name list ref = ref [] let add_assert nd = assert_nodes := nd :: !assert_nodes let simulation = ref false -let simulation_node : name option ref = ref None +let simulation_node : name ref = ref "" let set_simulation_node s = simulation := true; - simulation_node := Some s + simulation_node := s let create_object_file = ref false diff --git a/lib/java/jeptagon.jar b/lib/java/jeptagon.jar deleted file mode 100644 index 8845563780f8de722b45715ac9810b327c1dd7cf..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 5291 zcmbW5cQjnv+s8+5lVEg$nJ`9lq6@(&V;IpAB@$hTUP6d2(W6|67M-Y9v?w8>jH{FA z#ML{|iIU)*`6cg-Soh|S>{(~6Gi&YrIs2UNv-f_UuZAifJ~e=tm>A&bFE0Z)(?|gL z0F+Cg=7s;Tnw z^pXC@wGiYpvo&#XvD4^8qGhS2V_RCXOPA3{OX`l4+5%xx zyyMjP8F?S3d_cj`6fkJuKv1$EkXEp``h_Dyjk^y|z)YB&ky6H-Vj@XU+#+Rvs*(_wC6MjWxZ`$1dQZQy z*6naa*w}VEU1IC;>|!#E zs$LfKq8ddZ2DHE?X46Xrq&LwX1TGx>8mUb2D)-`rmYz6E&I$N}+(M3(?&zV`Op1GZ zW$8`vkIAqR(sp`KdKm`*Xu@2-`Mrg{fA5$vB(5fP(5ZA*A_(`sS%g!^jD3-_k3+wWn?BNa15v05b?$r1iuz0ZlRyI8{jvxBVE|-ayeN{<9#(^r?0@i*=`+3h zO5yro&oZ0DmvUIZJkcv^_ud`E!9`Y&f%ZWfBd0;V;?>u$bV<}7p~|b)=Y||<56zrr zx!g|V4g|^n*2AZ}KNR#7kBNa^l!u=1B13_;Ao-y=$BTM&tGe)hGxW}`@<^2yY5m3) zm;whreQHTq_o~Op01ki3B8|G9VWPT52p7#)D=51DAdlaqWRrPp-mqTK{5AcmX*`>z+&kNDMZ;W2ri2`jl-d?UTP!GD7)))c|^iwS?*u9yJ1+p zR+lOyOfh7|XhnKZpOE|rm4(qWJk5*HORC~#n|qzW z&>oGn)t52$7m@pQkc}IwK<8olgdqT2s1fg!g*vam@o`3i4PJ}!&zhzF9s6ZPd7ja$e_4Zyt?5!Q=fa0CK(1Yd3FW}P=NooQs9iW0ho5&)%S z#p`a|tf_sszWcuuNN9kwNiR&cQAjn&;)%s`3shrJfE|ue7C5^4{xY8QfO5s9ga6Na`PVDqZ!t13%(y@z1xG&QsxW$sta?! zvC|_J^_ZbvNX=v1w?I|3f7Na!yG*U8S*_!-TFdQJ8-wZH4QqqmLjCRgadk;FQ45K~ zJ4zdp-h~i;U`xa#(k6YZMfT&Dx1vD|=4K&aMzpwUvPBp)G%p~z!AsTck!QKtg70U0 zt7H4yEFaLmFGgNkBUj%Rja9xT;P4G3J}Cdns1ns*f@FoNrCmY9k`UmUJ@YdDV=LyG zoP^9Duq!v7&f&kDL!@%RmV(OXv%_>}iNh|Oe&{x9ED9gV>|iGyDh+L;!zw-7O<|af zQJNp`w>MeQZ%S8S7VWGo^`GkU5pXa>0BABvV%aVejN>GSi)#{7BJSuS&+SZo$sBeV zeHbgD$L2JJw~$4#Q6Z~0#a*UTTrhB4lUjRPe@z;X(~KX7SyeKqw5z14q@$#zq^BeU zl527s+{Z&~zG7!%JTDd3-(e*3v21jV?t{apIJ3Q@SJWYimL_R*bTs^2ceUPTKh)nU zo1yuOJ4~0R7!<`i5;-nKy|nNy^|N=+5HD1GWul)Vzh+=0e;0qb-S0%slPld9 zL?!GNcL0=d*AXdTYPn8qHm2M>vPCK4=G`1&+tnH!!@Nx?R_4U|(a1pMy`STgZQRz7 z>Br7#S}lwz-b&u@OG6}woVMI%E@e8{vXB+{P^Z;t-;Yf=vz_dK)=Wqz5B#M-*Cf#maBsm2Bm$usu0z%v7atpWS-CO)6Z@lg zK_X;ip#-cA%8+$t8WYXp(d0)xy?ZH-EWhpy@3R7utn^AsESs7o(S&FYw04jXnl?~a zLr{aJZPx}@bv#3Cr+|&0UMK1id@$`3NdoKyyvfn8K{97pRoUA8pnEk*OxVF{V&HAQ zhw4t;f?fAmlDqH*#rusf{?{ca4h-MFi2JS9 zbXWM-#4xuv!!6PSwtxHCWi^zvX_)I->X|qiGo>#YF&A`(iqR7d)@u)qFV7>Svx1M| zpW@}xo6s?Iid-PQ19zyuZK6X-g3yJiWul5DcTp=!15#Wu6${63S4ajOf}dj-ly53O z$x)a5!5vY|zI&%nUA`DZ?;Sx-^eub z-3-r39H_$E5yOT_)EWS16cZ-%zYG(Gf3Hiv#m7^vJ2$B0sHNezgZQ`=3q$g#Uz?IO zwNx5sHpeT0K)9%n2lsROUzBxAs(#MetRg0-VEKx3!r8Re(GhOn#<8FLx669U=%dB` z?md10%2uD#cvPN%TXC+GYfEXSNa3b&4PDy9U6qCjv7ms;+@@&xQ1|@TY^8DAcA@)M z98?ChCZ6TxzJ-*gZb#ulCE1vjeKz6T-fDRM6@f8~+^|T)_r33WohYJ1lO5dO@e!Em z_S3DGt}==paYYvn)|1VRo%mHx``auDoQ&qC=N_@#vvjL)UwmETbIIzX3+zxU_;&sW zX669^f4pwd5Fu;p=~Mp zS8{Ngc|*+6-Vz1z?)*P(`50o`-QSi?#_CJTHk7yF#RkbD8P_>)Epx@y?jbML95j; z;1tu|P6x3JLi$b#u;dWt5V;$CDaMLeDQ6Vsi#^&g{(^=o4lXs|XV2vS4H2wo@^kyg z1i?Be=ZBs(FtCovk0y<|{b%SI{{%}Q1^l|c z?B8vWv#)`rovki^rWs*A%#TT&qkS*(&(qG> (i fby i, 0 -> !(pre m)) tel + +node main () returns (r:int) +var f: int^100; nf: int^100; x: int; +let + x = 0 fby x+1; + f = x^100; + nf = normalized_movie<<100>>(f); + r = mean<<100>>(nf) +tel + diff --git a/test/good/t13.ept b/test/good/t13.ept index 499cffb..7b64049 100644 --- a/test/good/t13.ept +++ b/test/good/t13.ept @@ -1,6 +1,6 @@ node count(c : int; r : bool) returns (res : int) let -(* res = c fby (if r then 0 else res + c);*) + res = c fby (if r then 0 else res + c); res = 0; tel