Fixes and basic Java main.

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
 

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

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 =

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 =

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

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

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

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
-

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

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
 

test/async/java_m

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

test/async/pipline_a.ept

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

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