let fpp_item predicate pp_tau tau_of_ctype_logic pp_term fmt x =
function
| Formula.Cons k ->
fprintf fmt "Definition %s:Z:= %d.@\n" x k
| Formula.Function ([], t) ->
fprintf fmt "Parameter %s: %a.@\n" x pp_tau t
| Formula.Function (tl, t) ->
fprintf fmt "Parameter %s: @[<hov 0>%a -> %a@].@\n" x (pp_typelist pp_tau) tl pp_tau t
| Formula.Predicate [] ->
fprintf fmt "Parameter %s: Prop.@\n" x
| Formula.Predicate tl ->
fprintf fmt "Parameter %s: @[<hov 0>%a -> Prop.@]@\n" x (pp_typelist pp_tau) tl
| Formula.FunctionDef (xs,tr,exp) ->
Format.fprintf fmt "@[<hv 2>Definition %s (%a) : %a :=@ @[<hov 0>%a.@]@]@\n"
x (pp_list (pp_param pp_tau)) xs pp_tau tr pp_term exp
| Formula.PredicateDef (xs,prop) ->
Format.fprintf fmt "@[<hv 2>Definition %s (%a): Prop :=@ @[<hov 0>%a.@]@]@\n"
x (pp_list (pp_param pp_tau)) xs predicate prop
| Formula.Axiom p ->
begin
match Fol_norm.compile p with
| Pred p' -> fprintf fmt "@[<hv 2>Axiom %s:@ %a.@\n@]@\n" x predicate p'
| Conv (defs,p') ->
fpp_lf_let pp_tau pp_term fmt defs ;
fprintf fmt "@[<hv 2>Axiom %s:@ %a.@\n@]@\n" x predicate p'
end
| Formula.Type 0 ->
fprintf fmt "Definition %s:=Set.@\n" x
| Formula.Type n ->
fprintf fmt "@[<hov 2>Definition %s:=Set" x;
for k=1 to n do fprintf fmt " -> Set" done ;
fprintf fmt ".@]@\n"
| Formula.Trecord c ->
let rname = String.capitalize c.Cil_types.cname in
if c.Cil_types.cstruct then
begin
fprintf fmt "@[<hov 2> Record %s : Set := mk%s@\n" rname rname ;
fprintf fmt "{ @\n" ;
fpp_fields pp_tau tau_of_ctype_logic fmt c.Cil_types.cfields ;
fprintf fmt "}.@]@\n"
end
else
begin
fprintf fmt "@[<hov 2> Definition %s:=Set.@\n" rname;
let l = c.Cil_types.cfields in
List.iter (fun f ->
let fd = field f in
let t = tau_of_ctype_logic f.Cil_types.ftype in
Format.pp_print_newline fmt () ;
fprintf fmt "Parameter %s: %s -> %a.@\n "
(get_ufield f) rname pp_tau t;
Format.pp_print_newline fmt () ;
fprintf fmt "Parameter %s: %s -> %a -> %s.@\n "
(set_ufield f) rname pp_tau t rname;
Format.pp_print_newline fmt () ;
fprintf fmt "Axiom get_set_same_%s:@\n" fd;
fprintf fmt " forall r v, %s (%s r v) = v.@\n"
(get_ufield f) (set_ufield f)
) l
end