From e89f1e606bc8c9c425628392adc9c69cec666b5e Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Mon, 22 Dec 2014 19:34:45 +0100 Subject: Represent struct and union types by name instead of by structure. --- cfrontend/PrintCsyntax.ml | 141 +++++++--------------------------------------- 1 file changed, 19 insertions(+), 122 deletions(-) (limited to 'cfrontend/PrintCsyntax.ml') diff --git a/cfrontend/PrintCsyntax.ml b/cfrontend/PrintCsyntax.ml index e1b53af8..8a4d60a5 100644 --- a/cfrontend/PrintCsyntax.ml +++ b/cfrontend/PrintCsyntax.ml @@ -70,12 +70,6 @@ let name_longtype sg = | Signed -> "long long" | Unsigned -> "unsigned long long" -(* Collecting the names and fields of structs and unions *) - -module StructUnion = Map.Make(String) - -let struct_unions = ref StructUnion.empty - (* Declarator (identifier + type) *) let attributes a = @@ -132,12 +126,10 @@ let rec name_cdecl id ty = add_args true args; Buffer.add_char b ')'; name_cdecl (Buffer.contents b) res - | Tstruct(name, fld, a) -> - extern_atom name ^ attributes a ^ name_optid id - | Tunion(name, fld, a) -> - extern_atom name ^ attributes a ^ name_optid id - | Tcomp_ptr(name, a) -> - extern_atom name ^ " *" ^ attributes a ^ id + | Tstruct(name, a) -> + "struct " ^ extern_atom name ^ attributes a ^ name_optid id + | Tunion(name, a) -> + "union " ^ extern_atom name ^ attributes a ^ name_optid id (* Type *) @@ -466,7 +458,7 @@ let print_globvar p id v = fprintf p "@[%s = " (name_cdecl name2 v.gvar_info); begin match v.gvar_info, v.gvar_init with - | (Tint _ | Tlong _ | Tfloat _ | Tpointer _ | Tfunction _ | Tcomp_ptr _), + | (Tint _ | Tlong _ | Tfloat _ | Tpointer _ | Tfunction _), [i1] -> print_init p i1 | _, il -> @@ -482,119 +474,24 @@ let print_globdef p (id, gd) = | Gfun f -> print_fundef p id f | Gvar v -> print_globvar p id v -(* Collect struct and union types *) - -let rec collect_type = function - | Tvoid -> () - | Tint _ -> () - | Tfloat _ -> () - | Tlong _ -> () - | Tpointer(t, _) -> collect_type t - | Tarray(t, _, _) -> collect_type t - | Tfunction(args, res, _) -> collect_type_list args; collect_type res - | Tstruct(id, fld, _) | Tunion(id, fld, _) -> - let s = extern_atom id in - if not (StructUnion.mem s !struct_unions) then begin - struct_unions := StructUnion.add s fld !struct_unions; - collect_fields fld - end - | Tcomp_ptr _ -> () - -and collect_type_list = function - | Tnil -> () - | Tcons(hd, tl) -> collect_type hd; collect_type_list tl - -and collect_fields = function - | Fnil -> () - | Fcons(id, hd, tl) -> collect_type hd; collect_fields tl - -let rec collect_expr e = - collect_type (typeof e); - match e with - | Eloc _ -> assert false - | Evar _ -> () - | Ederef(r, _) -> collect_expr r - | Efield(l, _, _) -> collect_expr l - | Eval _ -> () - | Evalof(l, _) -> collect_expr l - | Eaddrof(l, _) -> collect_expr l - | Eunop(_, r, _) -> collect_expr r - | Ebinop(_, r1, r2, _) -> collect_expr r1; collect_expr r2 - | Ecast(r, _) -> collect_expr r - | Eseqand(r1, r2, _) -> collect_expr r1; collect_expr r2 - | Eseqor(r1, r2, _) -> collect_expr r1; collect_expr r2 - | Econdition(r1, r2, r3, _) -> - collect_expr r1; collect_expr r2; collect_expr r3 - | Esizeof(ty, _) -> collect_type ty - | Ealignof(ty, _) -> collect_type ty - | Eassign(l, r, _) -> collect_expr l; collect_expr r - | Eassignop(_, l, r, _, _) -> collect_expr l; collect_expr r - | Epostincr(_, l, _) -> collect_expr l - | Ecomma(r1, r2, _) -> collect_expr r1; collect_expr r2 - | Ecall(r1, rl, _) -> collect_expr r1; collect_exprlist rl - | Ebuiltin(_, _, rl, _) -> collect_exprlist rl - | Eparen _ -> assert false - -and collect_exprlist = function - | Enil -> () - | Econs(r1, rl) -> collect_expr r1; collect_exprlist rl - -let rec collect_stmt = function - | Sskip -> () - | Sdo e -> collect_expr e - | Ssequence(s1, s2) -> collect_stmt s1; collect_stmt s2 - | Sifthenelse(e, s1, s2) -> collect_expr e; collect_stmt s1; collect_stmt s2 - | Swhile(e, s) -> collect_expr e; collect_stmt s - | Sdowhile(e, s) -> collect_stmt s; collect_expr e - | Sfor(s_init, e, s_iter, s_body) -> - collect_stmt s_init; collect_expr e; - collect_stmt s_iter; collect_stmt s_body - | Sbreak -> () - | Scontinue -> () - | Sswitch(e, cases) -> collect_expr e; collect_cases cases - | Sreturn None -> () - | Sreturn (Some e) -> collect_expr e - | Slabel(lbl, s) -> collect_stmt s - | Sgoto lbl -> () - -and collect_cases = function - | LSnil -> () - | LScons(lbl, s, rem) -> collect_stmt s; collect_cases rem - -let collect_function f = - collect_type f.fn_return; - List.iter (fun (id, ty) -> collect_type ty) f.fn_params; - List.iter (fun (id, ty) -> collect_type ty) f.fn_vars; - collect_stmt f.fn_body - -let collect_globdef (id, gd) = - match gd with - | Gfun(External(_, args, res, _)) -> collect_type_list args; collect_type res - | Gfun(Internal f) -> collect_function f - | Gvar v -> collect_type v.gvar_info - -let collect_program p = - List.iter collect_globdef p.prog_defs - -let declare_struct_or_union p name fld = - fprintf p "%s;@ @ " name - -let print_struct_or_union p name fld = - fprintf p "@[%s {" name; - let rec print_fields = function - | Fnil -> () - | Fcons(id, ty, rem) -> - fprintf p "@ %s;" (name_cdecl (extern_atom id) ty); - print_fields rem in - print_fields fld; +let struct_or_union = function Struct -> "struct" | Union -> "union" + +let declare_composite p (Composite(id, su, m, a)) = + fprintf p "%s %s;@ " (struct_or_union su) (extern_atom id) + +let define_composite p (Composite(id, su, m, a)) = + fprintf p "@[%s %s%s {" + (struct_or_union su) (extern_atom id) (attributes a); + List.iter + (fun (fid, fty) -> + fprintf p "@ %s;" (name_cdecl (extern_atom fid) fty)) + m; fprintf p "@;<0 -2>};@]@ @ " let print_program p prog = - struct_unions := StructUnion.empty; - collect_program prog; fprintf p "@["; - StructUnion.iter (declare_struct_or_union p) !struct_unions; - StructUnion.iter (print_struct_or_union p) !struct_unions; + List.iter (declare_composite p) prog.prog_types; + List.iter (define_composite p) prog.prog_types; List.iter (print_globdef p) prog.prog_defs; fprintf p "@]@." -- cgit