diff --git a/compiler/main/hept2mls.ml b/compiler/main/hept2mls.ml index 36f9b13..d45269b 100644 --- a/compiler/main/hept2mls.ml +++ b/compiler/main/hept2mls.ml @@ -207,15 +207,16 @@ let const_dec cd = Minils.c_type = cd.Heptagon.c_type; Minils.c_loc = cd.Heptagon.c_loc; } +let program_desc pd = match pd with + | Heptagon.Ptype td -> Ptype (typedec td) + | Heptagon.Pnode nd -> Pnode (node nd) + | Heptagon.Pconst cd -> Pconst (const_dec cd) + let program { Heptagon.p_modname = modname; Heptagon.p_opened = modules; - Heptagon.p_types = pt_list; - Heptagon.p_nodes = n_list; - Heptagon.p_consts = c_list; } = + Heptagon.p_desc = desc_list } = { p_modname = modname; p_format_version = minils_format_version; p_opened = modules; - p_types = List.map typedec pt_list; - p_nodes = List.map node n_list; - p_consts = List.map const_dec c_list} + p_desc = List.map program_desc desc_list } diff --git a/compiler/main/mls2obc.ml b/compiler/main/mls2obc.ml index fa8249e..0734586 100644 --- a/compiler/main/mls2obc.ml +++ b/compiler/main/mls2obc.ml @@ -641,17 +641,17 @@ let translate_const_def { Minils.c_name = name; Minils.c_value = se; let program { Minils.p_modname = p_modname; Minils.p_opened = p_o; Minils.p_desc = pd; } = build_anon pd; - + let program_desc pd acc = match pd with | Minils.Pnode n when not (Itfusion.is_anon_node n.Minils.n_name) -> Pclass (translate_node n) :: acc - (* dont't translate anonymous nodes, they will be inlined TODO ?? inline obc code hein ?*) + (* dont't translate anonymous nodes, they will be inlined *) | Minils.Pnode n -> acc | Minils.Ptype t -> Ptype (translate_ty_def t) :: acc | Minils.Pconst c -> Pconst (translate_const_def c) :: acc in - let p_desc = List.fold_right program_desc [] pd in + let p_desc = List.fold_right program_desc pd [] in { p_modname = p_modname; - p_opened = p_module_list; + p_opened = p_o; p_desc = p_desc } diff --git a/compiler/main/mls2seq.ml b/compiler/main/mls2seq.ml index a9ad8ca..f488e96 100644 --- a/compiler/main/mls2seq.ml +++ b/compiler/main/mls2seq.ml @@ -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, Java_main.java_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) ] diff --git a/compiler/minils/analysis/clocking.ml b/compiler/minils/analysis/clocking.ml index cf84242..3b3d774 100644 --- a/compiler/minils/analysis/clocking.ml +++ b/compiler/minils/analysis/clocking.ml @@ -186,6 +186,10 @@ let typing_node ({ n_input = i_list; n_output = List.map set_clock o_list; n_local = List.map set_clock l_list }) -let program (({ p_nodes = p_node_list } as p)) = - { (p) with p_nodes = List.map typing_node p_node_list; } +let program p = + let program_desc pd = match pd with + | Pnode nd -> Pnode (typing_node nd) + | _ -> pd + in + { p with p_desc = List.map program_desc p.p_desc; } diff --git a/compiler/obc/c/cmain.ml b/compiler/obc/c/cmain.ml index b3598f7..d5961af 100644 --- a/compiler/obc/c/cmain.ml +++ b/compiler/obc/c/cmain.ml @@ -260,9 +260,10 @@ let main_skel var_list prologue body = let mk_main name p = if !Compiler_options.simulation then ( + let classes = program_classes p in let n_names = !Compiler_options.assert_nodes in let find_class n = - try List.find (fun cd -> cd.cd_name.name = n) p.p_classes + try List.find (fun cd -> cd.cd_name.name = n) classes with Not_found -> Format.eprintf "Unknown node %s.@." n; exit 1 in diff --git a/compiler/obc/obc_printer.ml b/compiler/obc/obc_printer.ml index fbd9bcb..03e3833 100644 --- a/compiler/obc/obc_printer.ml +++ b/compiler/obc/obc_printer.ml @@ -179,13 +179,14 @@ let print_const_dec ff c = fprintf ff "const %a = %a@." print_qualname c.c_name print_static_exp c.c_value -let print_prog ff { p_opened = modules; p_types = types; - p_consts = consts; p_classes = classes; } = +let print_prog_desc ff pd = match pd with + | Pclass cd -> print_class_def ff cd; fprintf ff "@\n@\n" + | Pconst cd -> print_const_dec ff cd + | Ptype td -> print_type_def ff td + +let print_prog ff { p_opened = modules; p_desc = descs } = List.iter (print_open_module ff) modules; - List.iter (print_type_def ff) types; - List.iter (print_const_dec ff) consts; - fprintf ff "@\n"; - List.iter (fun cdef -> (print_class_def ff cdef; fprintf ff "@\n@\n")) classes + List.iter (print_prog_desc ff) descs let print oc p = let ff = formatter_of_out_channel oc in