Commit 1b769a78 authored by Andrei Paskevich's avatar Andrei Paskevich

separate abstract types and logic symbols

- put abstract types and aliases in Dtype of tysymbol
- put (recursive) algebraic types in Ddata of (ts,constr list) list
- put abstract function/predicate symbols in Dparam of lsymbol
- put defined logic symbols in Dlogic of (ls,ls_definition) list
parent cd2443ec
......@@ -9,7 +9,7 @@ transformation "eliminate_builtin"
(* PVS does not support mutual recursion *)
transformation "eliminate_mutual_recursion"
transformation "simplify_recursive_definition"
(*transformation "simplify_recursive_definition"*)
(* though we could do better, we only use recursion on one argument *)
transformation "eliminate_non_struct_recursion"
......
......@@ -57,8 +57,8 @@ let () = printf "@[task 1 is:@\n%a@]@." Pretty.print_task task1
(* task for formula 2 *)
let task2 = None
let task2 = Task.add_logic_decl task2 [prop_var_A, None]
let task2 = Task.add_logic_decl task2 [prop_var_B, None]
let task2 = Task.add_param_decl task2 prop_var_A
let task2 = Task.add_param_decl task2 prop_var_B
let goal_id2 = Decl.create_prsymbol (Ident.id_fresh "goal2")
let task2 = Task.add_prop_decl task2 Decl.Pgoal goal_id2 fmla2
......
......@@ -110,19 +110,13 @@ and print_fmla info fmt f = match f.t_node with
"tptp : you must eliminate match"
| Tvar _ | Tconst _ | Teps _ -> raise (FmlaExpected f)
let print_logic_decl _ _ (_,ld) = match ld with
| None -> ()
| Some _ -> unsupported "Predicate and function definition aren't supported"
let print_logic_decl info fmt d =
if Mid.mem (fst d).ls_name info.info_syn then
false else (print_logic_decl info fmt d; true)
let print_decl info fmt d = match d.d_node with
| Dtype _ -> false
| Dtype _ | Dparam _ -> false
(* print_list_opt newline (print_type_decl info) fmt dl *)
| Dlogic dl ->
print_list_opt newline (print_logic_decl info) fmt dl
| Ddata _ -> unsupportedDecl d
"Algebraic datatypes are not supported"
| Dlogic _ -> unsupportedDecl d
"Predicate and function definition aren't supported"
| Dind _ -> unsupportedDecl d
"tptp : inductive definition are not supported"
| Dprop (Paxiom, pr, _) when Mid.mem pr.pr_name info.info_syn -> false
......
......@@ -584,16 +584,16 @@ let flush_impl ~strict env uc impl =
in
let update s e (env,uc) = match e with
| SType ts ->
Mstr.add s e env, add_ty_decl uc [ts,Tabstract]
Mstr.add s e env, add_ty_decl uc ts
| SFunc (_,_,_,ls) | SPred (_,_,_,ls) ->
Mstr.add s e env, add_logic_decl uc [ls,None]
Mstr.add s e env, add_param_decl uc ls
| STVar tv when strict ->
errorm ?loc:tv.tv_name.id_loc "Unbound type variable %s" s
| SVar vs when strict ->
errorm ?loc:vs.vs_name.id_loc "Unbound variable %s" s
| STVar _ | SVar _ -> env,uc
| Sdobj ls ->
let uc = add_logic_decl uc [ls,None] in
let uc = add_param_decl uc ls in
let t = t_app ls [] ls.ls_value in
let add _ s f = match s with
| Sdobj fs -> t_and_simp f (t_neq (t_app fs [] fs.ls_value) t)
......
......@@ -549,7 +549,7 @@ module Select = struct
This is the function directly used to filter axioms. *)
let filter fTbl tTbl symTbl goal_clauses (gc,gp) decl =
match decl.d_node with
| Dtype _ | Dlogic _ | Dind _ -> [decl]
| Dtype _ | Ddata _ | Dparam _ | Dlogic _ | Dind _ -> [decl]
| Dprop (Paxiom,_,fmla) -> (* filter only axioms *)
Format.eprintf "filter : @[%a@]@." Pretty.print_term fmla;
let goal_exprs = goal_clauses in
......
......@@ -419,7 +419,7 @@ and tr_global_ts dep env r =
| None ->
Ty.create_tysymbol id vars None
in
let decl = Decl.create_ty_decl [ts, Decl.Tabstract] in
let decl = Decl.create_ty_decl ts in
add_dep dep decl;
add_table global_ts r (Some ts);
global_decl := Ident.Mid.add ts.ts_name decl !global_decl;
......@@ -466,11 +466,11 @@ and tr_global_ts dep env r =
ls, List.map (fun _ -> None) ls.ls_args
in
let ls = Array.to_list (Array.mapi mk_constructor oib.mind_nf_lc) in
ts, Decl.Talgebraic ls
ts, ls
in
let decl = Array.mapi make_one mib.mind_packets in
let decl = Array.to_list decl in
let decl = Decl.create_ty_decl decl in
let decl = Decl.create_data_decl decl in
(* Format.printf "decl = %a@." Pretty.print_decl decl; *)
add_dep dep decl;
List.iter
......@@ -512,19 +512,18 @@ and tr_global_ls dep env r =
ignore (tr_type dep' tvm env t);
lookup_table global_ls r
| ConstRef c ->
let ld = decompose_definition dep' env c in
let decl = decompose_definition dep' env c in
(* let ld = match defl with *)
(* | [] -> *)
(* [make_def_decl dep env r None] *)
(* | _ -> *)
(* List.map (fun (r, t) -> make_def_decl dep env r (Some t)) defl *)
(* in *)
let decl = Decl.create_logic_decl ld in
add_dep dep decl;
List.iter
(fun (ls, _) ->
global_decl := Ident.Mid.add ls.ls_name decl !global_decl)
ld;
Ident.Sid.iter
(fun id ->
global_decl := Ident.Mid.add id decl !global_decl)
decl.Decl.d_news;
global_dep := Decl.Mdecl.add decl !dep' !global_dep;
lookup_table global_ls r
| VarRef _ | IndRef _ ->
......@@ -586,7 +585,7 @@ and decompose_definition dep env c =
let ls = lookup_table global_ls r in
match b with
| None ->
ls, None
assert false
| Some b ->
let tvs = List.fold_left Ty.ty_freevars Stv.empty
(Ty.oty_cons ls.ls_args ls.ls_value) in
......@@ -609,7 +608,11 @@ and decompose_definition dep env c =
Decl.make_ls_defn ls vsl b
end
in
List.map make_one_decl dl
match dl with
| [r,None] ->
Decl.create_param_decl (lookup_table global_ls r)
| _ ->
Decl.create_logic_decl (List.map make_one_decl dl)
(***
(* is it defined? *)
......
......@@ -28,17 +28,13 @@ open Term
type constructor = lsymbol * lsymbol option list
(** constructor symbol with the list of projections *)
type ty_defn =
| Tabstract
| Talgebraic of constructor list
type ty_decl = tysymbol * ty_defn
type data_decl = tysymbol * constructor list
(** Logic declaration *)
type ls_defn = lsymbol * term
type logic_decl = lsymbol * ls_defn option
type logic_decl = lsymbol * ls_defn
exception UnboundVar of vsymbol
......@@ -66,7 +62,7 @@ let make_ls_defn ls vl t =
List.iter2 check_vl ls.ls_args vl;
t_ty_check t ls.ls_value;
(* return the definition *)
ls, Some (ls, fd)
ls, (ls, fd)
let open_ls_defn (_,f) =
let vl,_,f = match f.t_node with
......@@ -82,7 +78,7 @@ let open_ls_defn_cb ld =
let vl,t = open_ls_defn ld in
let close ls' vl' t' =
if t_equal t t' && list_all2 vs_equal vl vl' && ls_equal ls ls'
then ls, Some ld else make_ls_defn ls' vl' t'
then ls,ld else make_ls_defn ls' vl' t'
in
vl,t,close
......@@ -255,10 +251,7 @@ let check_call_list ls cl =
let check_termination ldl =
let cgr = Hls.create 5 in
let add acc (ls,ld) = match ld with
| Some ld -> Mls.add ls (open_ls_defn ld) acc
| None -> acc
in
let add acc (ls,ld) = Mls.add ls (open_ls_defn ld) acc in
let syms = List.fold_left add Mls.empty ldl in
Mls.iter (build_call_graph cgr syms) syms;
let check ls _ =
......@@ -311,8 +304,10 @@ type decl = {
}
and decl_node =
| Dtype of ty_decl list (* recursive types *)
| Dlogic of logic_decl list (* recursive functions/predicates *)
| Dtype of tysymbol (* abstract types and aliases *)
| Ddata of data_decl list (* recursive algebraic types *)
| Dparam of lsymbol (* abstract functions and predicates *)
| Dlogic of logic_decl list (* recursive functions and predicates *)
| Dind of ind_decl list (* inductive predicates *)
| Dprop of prop_decl (* axiom / lemma / goal *)
......@@ -325,15 +320,11 @@ module Hsdecl = Hashcons.Make (struct
let cs_equal (cs1,pl1) (cs2,pl2) =
ls_equal cs1 cs2 && list_all2 (option_eq ls_equal) pl1 pl2
let eq_td (ts1,td1) (ts2,td2) = ts_equal ts1 ts2 && match td1,td2 with
| Tabstract, Tabstract -> true
| Talgebraic l1, Talgebraic l2 -> list_all2 cs_equal l1 l2
| _ -> false
let eq_td (ts1,td1) (ts2,td2) =
ts_equal ts1 ts2 && list_all2 cs_equal td1 td2
let eq_ld (ls1,ld1) (ls2,ld2) = ls_equal ls1 ls2 && match ld1,ld2 with
| Some (_,f1), Some (_,f2) -> t_equal f1 f2
| None, None -> true
| _ -> false
let eq_ld (ls1,(_,f1)) (ls2,(_,f2)) =
ls_equal ls1 ls2 && t_equal f1 f2
let eq_iax (pr1,fr1) (pr2,fr2) =
pr_equal pr1 pr2 && t_equal fr1 fr2
......@@ -342,7 +333,9 @@ module Hsdecl = Hashcons.Make (struct
ls_equal ps1 ps2 && list_all2 eq_iax al1 al2
let equal d1 d2 = match d1.d_node, d2.d_node with
| Dtype l1, Dtype l2 -> list_all2 eq_td l1 l2
| Dtype s1, Dtype s2 -> ts_equal s1 s2
| Ddata l1, Ddata l2 -> list_all2 eq_td l1 l2
| Dparam s1, Dparam s2 -> ls_equal s1 s2
| Dlogic l1, Dlogic l2 -> list_all2 eq_ld l1 l2
| Dind l1, Dind l2 -> list_all2 eq_ind l1 l2
| Dprop (k1,pr1,f1), Dprop (k2,pr2,f2) ->
......@@ -352,12 +345,9 @@ module Hsdecl = Hashcons.Make (struct
let cs_hash (cs,pl) =
Hashcons.combine_list (Hashcons.combine_option ls_hash) (ls_hash cs) pl
let hs_td (ts,td) = match td with
| Tabstract -> ts_hash ts
| Talgebraic l -> 1 + Hashcons.combine_list cs_hash (ts_hash ts) l
let hs_td (ts,td) = Hashcons.combine_list cs_hash (ts_hash ts) td
let hs_ld (ls,ld) = Hashcons.combine (ls_hash ls)
(Hashcons.combine_option (fun (_,f) -> t_hash f) ld)
let hs_ld (ls,(_,f)) = Hashcons.combine (ls_hash ls) (t_hash f)
let hs_prop (pr,f) = Hashcons.combine (pr_hash pr) (t_hash f)
......@@ -367,7 +357,9 @@ module Hsdecl = Hashcons.Make (struct
| Plemma -> 11 | Paxiom -> 13 | Pgoal -> 17 | Pskip -> 19
let hash d = match d.d_node with
| Dtype l -> Hashcons.combine_list hs_td 3 l
| Dtype s -> ts_hash s
| Ddata l -> Hashcons.combine_list hs_td 3 l
| Dparam s -> ls_hash s
| Dlogic l -> Hashcons.combine_list hs_ld 5 l
| Dind l -> Hashcons.combine_list hs_ind 7 l
| Dprop (k,pr,f) -> Hashcons.combine (hs_kind k) (hs_prop (pr,f))
......@@ -421,7 +413,12 @@ let syms_ls s ls = Sid.add ls.ls_name s
let syms_ty s ty = ty_s_fold syms_ts s ty
let syms_term s t = t_s_fold syms_ty syms_ls s t
let create_ty_decl tdl =
let create_ty_decl ts =
let syms = Util.option_fold syms_ty Sid.empty ts.ts_def in
let news = Sid.singleton ts.ts_name in
mk_decl (Dtype ts) syms news
let create_data_decl tdl =
if tdl = [] then raise EmptyDecl;
let add s (ts,_) = Sts.add ts s in
let tss = List.fold_left add Sts.empty tdl in
......@@ -454,36 +451,32 @@ let create_ty_decl tdl =
let syms = List.fold_left syms_ty syms fs.ls_args in
syms, news_id news fs.ls_name
in
let check_decl (syms,news) (ts,td) = match td with
| Tabstract ->
let syms = option_apply syms (syms_ty syms) ts.ts_def in
syms, news_id news ts.ts_name
| Talgebraic cl ->
if cl = [] then raise (EmptyAlgDecl ts);
if ts.ts_def <> None then raise (IllegalTypeAlias ts);
let news = news_id news ts.ts_name in
let pjs = List.fold_left (fun s (_,pl) -> List.fold_left
(option_fold (fun s ls -> Sls.add ls s)) s pl) Sls.empty cl in
let news = Sls.fold (fun pj s -> news_id s pj.ls_name) pjs news in
let ty = ty_app ts (List.map ty_var ts.ts_args) in
List.fold_left (check_constr ts ty pjs) (syms,news) cl
let check_decl (syms,news) (ts,cl) =
if cl = [] then raise (EmptyAlgDecl ts);
if ts.ts_def <> None then raise (IllegalTypeAlias ts);
let news = news_id news ts.ts_name in
let pjs = List.fold_left (fun s (_,pl) -> List.fold_left
(option_fold (fun s ls -> Sls.add ls s)) s pl) Sls.empty cl in
let news = Sls.fold (fun pj s -> news_id s pj.ls_name) pjs news in
let ty = ty_app ts (List.map ty_var ts.ts_args) in
List.fold_left (check_constr ts ty pjs) (syms,news) cl
in
let (syms,news) = List.fold_left check_decl (Sid.empty,Sid.empty) tdl in
mk_decl (Dtype tdl) syms news
mk_decl (Ddata tdl) syms news
let create_param_decl ls =
let syms = Util.option_fold syms_ty Sid.empty ls.ls_value in
let syms = List.fold_left syms_ty syms ls.ls_args in
let news = Sid.singleton ls.ls_name in
mk_decl (Dparam ls) syms news
let create_logic_decl ldl =
if ldl = [] then raise EmptyDecl;
let check_decl (syms,news) (ls,ld) = match ld with
| Some (s,_) when not (ls_equal s ls) ->
raise (BadLogicDecl (ls, s))
| Some ld ->
let _, e = open_ls_defn ld in
let syms = List.fold_left syms_ty syms ls.ls_args in
syms_term syms e, news_id news ls.ls_name
| None ->
let syms = option_apply syms (syms_ty syms) ls.ls_value in
let syms = List.fold_left syms_ty syms ls.ls_args in
syms, news_id news ls.ls_name
let check_decl (syms,news) (ls,((s,_) as ld)) =
if not (ls_equal s ls) then raise (BadLogicDecl (ls, s));
let _, e = open_ls_defn ld in
let syms = List.fold_left syms_ty syms ls.ls_args in
syms_term syms e, news_id news ls.ls_name
in
let (syms,news) = List.fold_left check_decl (Sid.empty,Sid.empty) ldl in
ignore (check_termination ldl);
......@@ -550,13 +543,11 @@ let create_prop_decl k p f =
(** Utilities *)
let decl_map fn d = match d.d_node with
| Dtype _ -> d
| Dtype _ | Ddata _ | Dparam _ -> d
| Dlogic l ->
let fn = function
| ls, Some ld ->
let vl,e,close = open_ls_defn_cb ld in
close ls vl (fn e)
| ld -> ld
let fn (ls,ld) =
let vl,e,close = open_ls_defn_cb ld in
close ls vl (fn e)
in
create_logic_decl (List.map fn l)
| Dind l ->
......@@ -567,13 +558,11 @@ let decl_map fn d = match d.d_node with
create_prop_decl k pr (fn f)
let decl_fold fn acc d = match d.d_node with
| Dtype _ -> acc
| Dtype _ | Ddata _ | Dparam _ -> acc
| Dlogic l ->
let fn acc = function
| _, Some ld ->
let _,e = open_ls_defn ld in
fn acc e
| _ -> acc
let fn acc (_,ld) =
let _,e = open_ls_defn ld in
fn acc e
in
List.fold_left fn acc l
| Dind l ->
......@@ -589,14 +578,12 @@ let list_rpair_map_fold fn =
Util.map_fold_left fn
let decl_map_fold fn acc d = match d.d_node with
| Dtype _ -> acc, d
| Dtype _ | Ddata _ | Dparam _ -> acc, d
| Dlogic l ->
let fn acc = function
| ls, Some ld ->
let vl,e,close = open_ls_defn_cb ld in
let acc,e = fn acc e in
acc, close ls vl e
| ld -> acc, ld
let fn acc (ls,ld) =
let vl,e,close = open_ls_defn_cb ld in
let acc,e = fn acc e in
acc, close ls vl e
in
let acc,l = Util.map_fold_left fn acc l in
acc, create_logic_decl l
......@@ -643,16 +630,12 @@ let known_add_decl kn0 decl =
if Sid.is_empty unk then kn
else raise (UnknownIdent (Sid.choose unk))
let find_type_definition kn ts =
let find_constructors kn ts =
match (Mid.find ts.ts_name kn).d_node with
| Dtype dl -> List.assq ts dl
| Dtype _ -> []
| Ddata dl -> List.assq ts dl
| _ -> assert false
let find_constructors kn ts =
match find_type_definition kn ts with
| Talgebraic cl -> cl
| Tabstract -> []
let find_inductive_cases kn ps =
match (Mid.find ps.ls_name kn).d_node with
| Dind dl -> List.assq ps dl
......@@ -662,9 +645,8 @@ let find_inductive_cases kn ps =
let find_logic_definition kn ls =
match (Mid.find ls.ls_name kn).d_node with
| Dlogic dl -> List.assq ls dl
| Dind _ -> None
| Dtype _ -> None
| Dlogic dl -> Some (List.assq ls dl)
| Dparam _ | Dind _ | Dtype _ -> None
| _ -> assert false
let find_prop kn pr =
......@@ -698,7 +680,7 @@ let check_match kn d = decl_fold (check_matchT kn) () d
exception NonFoundedTypeDecl of tysymbol
let rec check_foundness kn d =
let check_foundness kn d =
let rec check_ts tss tvs ts =
(* recursive data type, abandon *)
if Sts.mem ts tss then false else
......@@ -724,7 +706,7 @@ let rec check_foundness kn d =
check_ts tss tvs ts
in
match d.d_node with
| Dtype tdl ->
| Ddata tdl ->
let check () (ts,_) =
if check_ts Sts.empty Stv.empty ts
then () else raise (NonFoundedTypeDecl ts)
......@@ -737,10 +719,10 @@ let rec ts_extract_pos kn sts ts =
if ts_equal ts ts_func then [false;true] else
if ts_equal ts ts_pred then [false] else
if Sts.mem ts sts then List.map Util.ttrue ts.ts_args else
match find_type_definition kn ts with
| Tabstract ->
match find_constructors kn ts with
| [] ->
List.map Util.ffalse ts.ts_args
| Talgebraic csl ->
| csl ->
let sts = Sts.add ts sts in
let rec get_ty stv ty = match ty.ty_node with
| Tyvar _ -> stv
......@@ -754,7 +736,7 @@ let rec ts_extract_pos kn sts ts =
List.map (fun v -> not (Stv.mem v negs)) ts.ts_args
let check_positivity kn d = match d.d_node with
| Dtype tdl ->
| Ddata tdl ->
let add s (ts,_) = Sts.add ts s in
let tss = List.fold_left add Sts.empty tdl in
let check_constr tys (cs,_) =
......@@ -770,10 +752,7 @@ let check_positivity kn d = match d.d_node with
in
List.iter check_ty cs.ls_args
in
let check_decl (ts,td) = match td with
| Tabstract -> ()
| Talgebraic cl -> List.iter (check_constr ts) cl
in
let check_decl (ts,cl) = List.iter (check_constr ts) cl in
List.iter check_decl tdl
| _ -> ()
......
......@@ -30,17 +30,13 @@ open Term
type constructor = lsymbol * lsymbol option list
(** constructor symbol with the list of projections *)
type ty_defn =
| Tabstract
| Talgebraic of constructor list
type ty_decl = tysymbol * ty_defn
type data_decl = tysymbol * constructor list
(** {2 Logic symbols declaration} *)
type ls_defn
type logic_decl = lsymbol * ls_defn option
type logic_decl = lsymbol * ls_defn
val make_ls_defn : lsymbol -> vsymbol list -> term -> logic_decl
......@@ -102,8 +98,10 @@ type decl = private {
}
and decl_node =
| Dtype of ty_decl list (* recursive types *)
| Dlogic of logic_decl list (* recursive functions/predicates *)
| Dtype of tysymbol (* abstract types and aliases *)
| Ddata of data_decl list (* recursive algebraic types *)
| Dparam of lsymbol (* abstract functions and predicates *)
| Dlogic of logic_decl list (* recursive functions and predicates *)
| Dind of ind_decl list (* inductive predicates *)
| Dprop of prop_decl (* axiom / lemma / goal *)
......@@ -116,7 +114,9 @@ val d_hash : decl -> int
(** {2 Declaration constructors} *)
val create_ty_decl : ty_decl list -> decl
val create_ty_decl : tysymbol -> decl
val create_data_decl : data_decl list -> decl
val create_param_decl : lsymbol -> decl
val create_logic_decl : logic_decl list -> decl
val create_ind_decl : ind_decl list -> decl
val create_prop_decl : prop_kind -> prsymbol -> term -> decl
......@@ -175,7 +175,6 @@ exception RedeclaredIdent of ident
exception NonExhaustiveCase of pattern list * term
exception NonFoundedTypeDecl of tysymbol
val find_type_definition : known_map -> tysymbol -> ty_defn
val find_constructors : known_map -> tysymbol -> constructor list
val find_inductive_cases : known_map -> lsymbol -> (prsymbol * term) list
val find_logic_definition : known_map -> lsymbol -> ls_defn option
......
......@@ -307,28 +307,24 @@ let print_constr fmt (cs,pjl) =
(print_list nothing print_pj)
(List.fold_right2 add_pj pjl cs.ls_args [])
let print_type_decl fst fmt (ts,def) = match def with
| Tabstract -> begin match ts.ts_def with
| None ->
fprintf fmt "@[<hov 2>%s %a%a%a@]"
(if fst then "type" else "with") print_ts ts
print_ident_labels ts.ts_name
(print_list nothing print_tv_arg) ts.ts_args
| Some ty ->
fprintf fmt "@[<hov 2>%s %a%a%a =@ %a@]"
(if fst then "type" else "with") print_ts ts
print_ident_labels ts.ts_name
(print_list nothing print_tv_arg) ts.ts_args print_ty ty
end
| Talgebraic csl ->
fprintf fmt "@[<hov 2>%s %a%a%a =@\n@[<hov>%a@]@]"
(if fst then "type" else "with") print_ts ts
print_ident_labels ts.ts_name
(print_list nothing print_tv_arg) ts.ts_args
(print_list newline print_constr) csl
let print_type_decl first fmt d =
print_type_decl first fmt d; forget_tvs ()
let print_ty_decl fmt ts =
let print_def fmt = function
| None -> ()
| Some ty -> fprintf fmt " =@ %a" print_ty ty
in
fprintf fmt "@[<hov 2>type %a%a%a%a@]"
print_ts ts print_ident_labels ts.ts_name
(print_list nothing print_tv_arg) ts.ts_args
print_def ts.ts_def;
forget_tvs ()
let print_data_decl fst fmt (ts,csl) =
fprintf fmt "@[<hov 2>%s %a%a%a =@\n@[<hov>%a@]@]"
(if fst then "type" else "with") print_ts ts
print_ident_labels ts.ts_name
(print_list nothing print_tv_arg) ts.ts_args
(print_list newline print_constr) csl;
forget_tvs ()
let print_ls_type fmt = fprintf fmt " :@ %a" print_ty
......@@ -336,24 +332,23 @@ let ls_kind ls =
if ls.ls_value = None then "predicate"
else if ls.ls_args = [] then "constant" else "function"
let print_logic_decl fst fmt (ls,ld) = match ld with
| Some ld ->
let vl,e = open_ls_defn ld in
fprintf fmt "@[<hov 2>%s %a%a%a%a =@ %a@]"
(if fst then ls_kind ls else "with") print_ls ls
print_ident_labels ls.ls_name
(print_list nothing print_vs_arg) vl
(print_option print_ls_type) ls.ls_value print_term e;
List.iter forget_var vl
| None ->
fprintf fmt "@[<hov 2>%s %a%a%a%a@]"
(if fst then ls_kind ls else "with") print_ls ls
print_ident_labels ls.ls_name
(print_list nothing print_ty_arg) ls.ls_args
(print_option print_ls_type) ls.ls_value
let print_param_decl fmt ls =
fprintf fmt "@[<hov 2>%s %a%a%a%a@]"
(ls_kind ls) print_ls ls
print_ident_labels ls.ls_name
(print_list nothing print_ty_arg) ls.ls_args
(print_option print_ls_type) ls.ls_value;
forget_tvs ()
let print_logic_decl first fmt d =
print_logic_decl first fmt d; forget_tvs ()
let print_logic_decl fst fmt (ls,ld) =
let vl,e = open_ls_defn ld in
fprintf fmt "@[<hov 2>%s %a%a%a%a =@ %a@]"
(if fst then ls_kind ls else "with") print_ls ls
print_ident_labels ls.ls_name
(print_list nothing print_vs_arg) vl
(print_option print_ls_type) ls.ls_value print_term e;
List.iter forget_var vl;
forget_tvs ()