C backend ported to recent API changes in Obc

compiler/TODO.txt

@@ -0,0 +1,6 @@
+- Ne plus forcer l'ordre constantes puis types puis definitions de noeud. Il
+faudra mettre à jour les phases du compilateur et modifier l'ast.
+- Ajouter des constantes locales
+
+- supprimer pinst dans minils
+- heptcheck

compiler/global/names.ml

@@ -43,6 +43,7 @@ module QualEnv = struct
 end
 
 module QualSet = Set.Make (struct type t = qualname let compare = compare end)
+module ModulSet = Set.Make (struct type t = modul let compare = compare end)
 module S = Set.Make (struct type t = string let compare = compare end)
 
 

compiler/minils/main/mls2seq.ml

@@ -38,7 +38,7 @@ let write_obc_file p =
     close_out obc;
     comment "Generation of Obc code"
 
-let targets = [ (*"c", Obc_no_params Cmain.program;*)
+let targets = [ "c", Obc_no_params Cmain.program;
                 "java", Obc Java_main.program;
                 "obc", Obc write_obc_file;
                 "obc_np", Obc_no_params write_obc_file;

compiler/obc/c/c.ml

@@ -75,7 +75,6 @@ and cexpr =
   | Caddrof of clhs (** Take the address of a left-hand-side expression. *)
   | Cstructlit of string * cexpr list (** Structure literal "{ f1, f2, ... }".*)
   | Carraylit of cexpr list (** Array literal [\[e1, e2, ...\]]. *)
-  | Cmethod_call of cexpr * string * cexpr list (** Object member function call with parameters. *)
 and cconst =
   | Ccint of int (** Integer constant. *)
   | Ccfloat of float (** Floating-point number constant. *)
@@ -156,11 +155,14 @@ let rec pp_list f sep fmt l = match l with
 let pp_string fmt s =
   fprintf fmt "%s" (cname_of_name s)
 
-let cname_of_qn q =
-  if q.qual = Pervasives or q.qual = Names.local_qualname then
-    q.name
-  else
-    (q.qual ^ "__" ^ q.name)
+let rec modul_to_cname q = match q with
+  | Pervasives | LocalModule -> ""
+  | Module m -> m ^ "__"
+  | QualModule { qual = q; name = n } ->
+      (modul_to_cname q)^n^"__"
+
+let cname_of_qn qn =
+  (modul_to_cname qn.qual) ^ qn.name
 
 let pp_qualname fmt q =
   pp_string fmt (cname_of_qn q)
@@ -173,7 +175,6 @@ let rec pp_cty fmt cty = match cty with
   | Cty_ptr cty' -> fprintf fmt "%a*" pp_cty cty'
   | Cty_arr (n, cty') -> fprintf fmt "%a[%d]" pp_cty cty' n
   | Cty_void -> fprintf fmt "void"
-  | Cty_future cty' -> fprintf fmt "future<%a>" pp_cty cty'
 
 (** [pp_array_decl cty] returns the base type of a (multidimensionnal) array
     and the string of indices. *)
@@ -243,8 +244,8 @@ and pp_cexpr fmt ce = match ce with
   | Caddrof lhs -> fprintf fmt "&%a" pp_clhs lhs
   | Cstructlit (s, el) ->
       fprintf fmt "(%a){@[%a@]}" pp_string s (pp_list1 pp_cexpr ",") el
-  | Carraylit el ->
-      fprintf fmt "((int []){@[%a@]})" (pp_list1 pp_cexpr ",") el (* TODO master : WRONG *)
+  | Carraylit el -> (* TODO master : WRONG *)
+      fprintf fmt "((int []){@[%a@]})" (pp_list1 pp_cexpr ",") el
 
 and pp_clhs fmt lhs = match lhs with
   | Cvar s -> pp_string fmt s

compiler/obc/c/cgen.ml

@@ -13,6 +13,7 @@ open Misc
 open Names
 open Idents
 open Obc
+open Obc_utils
 open Types
 
 open Modules
@@ -343,7 +344,7 @@ let rec assoc_obj instance obj_env =
   match obj_env with
     | [] -> raise Not_found
     | od :: t ->
-        if od.o_name = instance
+        if od.o_ident = instance
         then od
         else assoc_obj instance t
 
@@ -364,10 +365,10 @@ let step_fun_call var_env sig_info objn out args =
   if sig_info.node_statefull then (
     let mem =
       (match objn with
-         | Oobj o -> Cfield (Cderef (Cvar "self"), local_qn o)
+         | Oobj o -> Cfield (Cderef (Cvar "self"), local_qn (name o))
          | Oarray (o, l) ->
              let l = clhs_of_lhs var_env l in
-               Carray (Cfield (Cderef (Cvar "self"), local_qn o), Clhs l)
+               Carray (Cfield (Cderef (Cvar "self"), local_qn (name o)), Clhs l)
       ) in
       args@[Caddrof out; Caddrof mem]
   ) else
@@ -427,7 +428,7 @@ let rec create_affect_const var_env dest c =
           let dest = Carray (dest, Cconst (Ccint i)) in
           (i - 1, create_affect_const var_env dest c @ affl) in
         snd (List.fold_right create_affect_idx cl (List.length cl - 1, []))
-    | _ -> [Caffect (dest, cexpr_of_exp var_env (mk_exp (Econst c)))]
+    | _ -> [Caffect (dest, cexpr_of_static_exp c)]
 
 (** [cstm_of_act obj_env mods act] translates the Obj action [act] to a list of
     C statements, using the association list [obj_env] to map object names to
@@ -465,9 +466,12 @@ let rec cstm_of_act var_env obj_env act =
                cstm_of_act_list var_env obj_env act) cl in
         [Cswitch (cexpr_of_exp var_env e, ccl)]
 
+    | Ablock b ->
+        cstm_of_act_list var_env obj_env b
+
     (** For composition of statements, just recursively apply our
         translation function on sub-statements. *)
-    | Afor (x, i1, i2, act) ->
+    | Afor ({ v_ident = x; _ }, i1, i2, act) ->
         [Cfor(name x, int_of_static_exp i1,
               int_of_static_exp i2, cstm_of_act_list var_env obj_env act)]
 
@@ -495,10 +499,10 @@ let rec cstm_of_act var_env obj_env act =
         (match obj.o_size with
            | None ->
              [Csexpr (Cfun_call (classn ^ "_reset",
-                [Caddrof (Cfield (Cderef (Cvar "self"), local_qn on))]))]
+                [Caddrof (Cfield (Cderef (Cvar "self"), local_qn (name on)))]))]
            | Some size ->
                let x = gen_symbol () in
-               let field = Cfield (Cderef (Cvar "self"), local_qn on) in
+               let field = Cfield (Cderef (Cvar "self"), local_qn (name on)) in
                let elt = [Caddrof( Carray(field, Clhs (Cvar x)) )] in
                  [Cfor(x, 0, int_of_static_exp size,
                        [Csexpr (Cfun_call (classn ^ "_reset", elt ))] )]
@@ -595,7 +599,7 @@ let mem_decl_of_class_def cd =
       let ty = match od.o_size with
         | Some se -> Cty_arr (int_of_static_exp se, ty)
         | None -> ty in
-        (od.o_name, ty)::l
+        (name od.o_ident, ty)::l
     else
       l
   in
@@ -740,8 +744,8 @@ let cfile_list_of_oprog_ty_decls name oprog =
   filename_types, [types_h; types_c]
 
 let global_file_header name prog =
-  let dependencies = S.elements (Obc_utils.Deps.deps_program prog) in
-  let dependencies = List.map String.uncapitalize dependencies in
+  let dependencies = ModulSet.elements (Obc_utils.Deps.deps_program prog) in
+  let dependencies = List.map modul_to_string dependencies in
 
   let (decls, defs) =
     List.split (List.map cdefs_and_cdecls_of_class_def prog.p_defs) in

compiler/obc/c/cmain.ml

@@ -13,6 +13,7 @@ open Misc
 open Names
 open Idents
 open Obc
+open Obc_utils
 open Types
 open Modules
 open Signature
@@ -258,9 +259,8 @@ let main_skel var_list prologue body =
   }
 
 let mk_main name p =
-  match (!Compiler_options.simulation_node, !Compiler_options.assert_nodes) with
-    | (None, []) -> []
-    | (_, n_names) ->
+  if !Compiler_options.simulation then (
+      let n_names = !Compiler_options.assert_nodes in
       let find_class n =
         try List.find (fun cd -> cd.cd_name.name = n) p.p_defs
         with Not_found ->
@@ -275,18 +275,16 @@ let mk_main name p =
           (var @ var_l, res :: res_l, step :: step_l) in
         List.fold_right add a_classes ([], [], []) in
 
-      let (_, var_l, res_l, step_l) =
-        (match !Compiler_options.simulation_node with
-           | None -> (n_names, var_l, res_l, step_l)
-           | Some n ->
-               let (nvar_l, res, nstep_l) =
-                 main_def_of_class_def (find_class n) in
-               (n :: n_names, nvar_l @ var_l,
-                res :: res_l, nstep_l @ step_l)) in
+      let n = !Compiler_options.simulation_node in
+      let (nvar_l, res, nstep_l) = main_def_of_class_def (find_class n) in
+      let (var_l, res_l, step_l) =
+        (nvar_l @ var_l, res :: res_l, nstep_l @ step_l) in
 
       [("_main.c", Csource [main_skel var_l res_l step_l]);
        ("_main.h", Cheader ([name], []))];
-;;
+  ) else
+    []
+
 
 
 (******************************)
@@ -297,7 +295,8 @@ let translate name prog =
   (global_file_header modname prog) @ (mk_main name prog)
 
 let program p =
-  let filename = filename_of_name (cname_of_name p.p_modname) in
+  let filename =
+    filename_of_name (cname_of_name (modul_to_string p.p_modname)) in
   let dirname = build_path (filename ^ "_c") in
   let dir = clean_dir dirname in
   let c_ast = translate filename p in

compiler/obc/obc_utils.ml

@@ -109,11 +109,12 @@ let remove_resets b =
   b
 
 
-(*
 module Deps =
 struct
 
-  let deps_longname deps { qual = modn; } = S.add modn deps
+  let deps_longname deps qn = match qn.qual with
+    | Module _ | QualModule _ -> ModulSet.add qn.qual deps
+    | _ -> deps
 
   let deps_static_exp_desc funs deps sedesc =
     let (sedesc, deps) = Global_mapfold.static_exp_desc funs deps sedesc in
@@ -162,7 +163,6 @@ struct
       act = deps_act;
       obj_dec = deps_obj_dec;
     } in
-    let (_, deps) = Obc_mapfold.program funs S.empty p in
-    S.remove p.p_modname (S.remove Pervasives deps)
+    let (_, deps) = Obc_mapfold.program funs ModulSet.empty p in
+    ModulSet.remove p.p_modname deps
 end
-*)

compiler/utilities/global/compiler_utils.ml

@@ -58,7 +58,8 @@ let silent_pass d enabled f p =
   then do_silent_pass d f p
   else p
 
-
+let filename_of_name n =
+  String.uncapitalize n
 
 let build_path suf =
   match !target_path with