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

Fixes and basic Java main.

Browse source
This commit is contained in:
Léonard Gérard 2011-02-14 15:21:57 +01:00
parent c677f76009
commit 86f743318b
14 changed files with 259 additions and 144 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
compiler/global/global_printer.ml
View file

@ -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

7
compiler/main/mls2obc.ml
View file

@ -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) =

1
compiler/obc/control.ml
View file

@ -14,6 +14,7 @@ open Minils
open Idents
open Misc
open Obc
open Obc_utils
open Clocks
let var_from_name map x =

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

@ -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 =

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

@ -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
(* 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]
)

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

@ -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 "@[<hv 2> 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 "@[<v4>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 "@[<hv>@[<hv 2>if (%a) {@ %a@]@ }@]" exp e block bt
fprintf ff "@[<v 4>if (%a) {@ %a }@]" exp e block bt
| Aifelse (e,bt,bf) ->
fprintf ff "@[<hv>@[<hv 2>if (%a) {@ %a@ @]}@\n@[<hv 2>else {@ %a@]@ }@]"
fprintf ff "@[<v>@[<v4>if (%a) {@ %a@]@ @[<v4>} else {@ %a@]@ }@]"
exp e
block bt
block bf
| Ablock b -> fprintf ff "@[<v2>{@ %a@ }]" block b
| Ablock b -> if (List.length b.b_body > 0) then fprintf ff "@[<v>@[<v4>{@ %a@]@ }@]" block b
| Afor (x, i1, i2, b) ->
fprintf ff "@[<hv>@[<hv 2>for (%a = %a; %a<%a; %a++) {@ %a@]@ }@]"
fprintf ff "@[<hv>@[<hv 4>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 "@[<v4>%a%a%a %a @[<2>(%a)@] @[%a@]{@ %a@]@\n}"
fprintf ff "@[<v4>%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 "@[<v4>%a%a @[<2>(%a)@] {@\n%a@]@\n}"
fprintf ff "@[<v4>%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 @[<h>%a@]{@\n%a@]@\n}"
fprintf ff "@\n@[<4>%a%aclass %a @[<h>%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@[<v>%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

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

@ -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

77
compiler/obc/obc.ml
View file

@ -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

97
compiler/obc/obc_utils.ml
View file

@ -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
*)

4
compiler/utilities/global/compiler_options.ml
View file

@ -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

BIN
lib/java/jeptagon.jar
View file

Binary file not shown.

4
test/async/java_m
View file

@ -1,6 +1,6 @@
#!/bin/bash
cp $@ build/
cp $1 build/
cd build
../../../heptc -target java $@
../../../heptc $2 $3 $4 $5 $6 -target java $1
cd ..

10
test/async/pipline_a.ept
View file

@ -18,3 +18,13 @@ let
(im,trash) = mapfold substr <<n>> (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

2
test/good/t13.ept
View file

@ -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