Commit a0be4ad0 authored by Andrei Paskevich's avatar Andrei Paskevich
Browse files

separate inductive predicate declarations

parent d94c3aac
...@@ -41,7 +41,6 @@ type ps_defn = lsymbol * vsymbol list * fmla * fmla ...@@ -41,7 +41,6 @@ type ps_defn = lsymbol * vsymbol list * fmla * fmla
type logic_decl = type logic_decl =
| Lfunction of lsymbol * fs_defn option | Lfunction of lsymbol * fs_defn option
| Lpredicate of lsymbol * ps_defn option | Lpredicate of lsymbol * ps_defn option
| Linductive of lsymbol * (ident * fmla) list
exception UnboundVars of Svs.t exception UnboundVars of Svs.t
...@@ -88,6 +87,10 @@ let open_ps_defn (ps,vl,f,_) = (ps,vl,f) ...@@ -88,6 +87,10 @@ let open_ps_defn (ps,vl,f,_) = (ps,vl,f)
let fs_defn_axiom (_,_,_,fd) = fd let fs_defn_axiom (_,_,_,fd) = fd
let ps_defn_axiom (_,_,_,pd) = pd let ps_defn_axiom (_,_,_,pd) = pd
(* inductive predicate declaration *)
type ind_decl = lsymbol * (ident * fmla) list
(* proposition declaration *) (* proposition declaration *)
type prop_kind = type prop_kind =
...@@ -128,12 +131,12 @@ and decl = { ...@@ -128,12 +131,12 @@ and decl = {
} }
and decl_node = and decl_node =
| Dtype of ty_decl list | Dtype of ty_decl list (* mutually recursive types *)
| Dlogic of logic_decl list | Dlogic of logic_decl list (* mutually recursive functions/predicates *)
| Dprop of prop_decl | Dind of ind_decl (* inductive predicate *)
| Duse of theory | Dprop of prop_decl (* axiom / lemma / goal *)
| Dclone of (ident * ident) list | Duse of theory (* depend on a theory *)
| Dclone of (ident * ident) list (* replicate a theory *)
(** Declarations *) (** Declarations *)
...@@ -157,13 +160,15 @@ module Decl = struct ...@@ -157,13 +160,15 @@ module Decl = struct
let eq_ld ld1 ld2 = match ld1,ld2 with let eq_ld ld1 ld2 = match ld1,ld2 with
| Lfunction (fs1,fd1), Lfunction (fs2,fd2) -> eq_fd fs1 fd1 fs2 fd2 | Lfunction (fs1,fd1), Lfunction (fs2,fd2) -> eq_fd fs1 fd1 fs2 fd2
| Lpredicate (ps1,pd1), Lpredicate (ps2,pd2) -> eq_fd ps1 pd1 ps2 pd2 | Lpredicate (ps1,pd1), Lpredicate (ps2,pd2) -> eq_fd ps1 pd1 ps2 pd2
| Linductive (ps1,al1), Linductive (ps2,al2) -> ps1 == ps2 &&
for_all2 (fun (i1,f1) (i2,f2) -> i1 == i2 && f1 == f2) al1 al2
| _ -> false | _ -> false
let eq_ind ps1 al1 ps2 al2 = ps1 == ps2 &&
for_all2 (fun (i1,f1) (i2,f2) -> i1 == i2 && f1 == f2) al1 al2
let equal d1 d2 = match d1.d_node, d2.d_node with let equal d1 d2 = match d1.d_node, d2.d_node with
| Dtype l1, Dtype l2 -> for_all2 eq_td l1 l2 | Dtype l1, Dtype l2 -> for_all2 eq_td l1 l2
| Dlogic l1, Dlogic l2 -> for_all2 eq_ld l1 l2 | Dlogic l1, Dlogic l2 -> for_all2 eq_ld l1 l2
| Dind (ps1,al1), Dind (ps2,al2) -> eq_ind ps1 al1 ps2 al2
| Dprop (k1,i1,f1), Dprop (k2,i2,f2) -> k1 == k2 && i1 == i2 && f1 == f2 | Dprop (k1,i1,f1), Dprop (k2,i2,f2) -> k1 == k2 && i1 == i2 && f1 == f2
| Duse th1, Duse th2 -> th1.th_name == th2.th_name | Duse th1, Duse th2 -> th1.th_name == th2.th_name
| _ -> false | _ -> false
...@@ -179,13 +184,15 @@ module Decl = struct ...@@ -179,13 +184,15 @@ module Decl = struct
let hs_ld ld = match ld with let hs_ld ld = match ld with
| Lfunction (fs,fd) -> Hashcons.combine fs.ls_name.id_tag (hs_fd fd) | Lfunction (fs,fd) -> Hashcons.combine fs.ls_name.id_tag (hs_fd fd)
| Lpredicate (ps,pd) -> Hashcons.combine ps.ls_name.id_tag (hs_fd pd) | Lpredicate (ps,pd) -> Hashcons.combine ps.ls_name.id_tag (hs_fd pd)
| Linductive (ps,l) ->
let hs_pair (i,f) = Hashcons.combine i.id_tag f.f_tag in let hs_ind ps al =
Hashcons.combine_list hs_pair ps.ls_name.id_tag l let hs_pair (i,f) = Hashcons.combine i.id_tag f.f_tag in
Hashcons.combine_list hs_pair ps.ls_name.id_tag al
let hash d = match d.d_node with let hash d = match d.d_node with
| Dtype l -> Hashcons.combine_list hs_td 0 l | Dtype l -> Hashcons.combine_list hs_td 0 l
| Dlogic l -> Hashcons.combine_list hs_ld 3 l | Dlogic l -> Hashcons.combine_list hs_ld 3 l
| Dind (ps,al) -> Hashcons.combine 5 (hs_ind ps al)
| Dprop (Paxiom,i,f) -> Hashcons.combine2 7 i.id_tag f.f_tag | Dprop (Paxiom,i,f) -> Hashcons.combine2 7 i.id_tag f.f_tag
| Dprop (Plemma,i,f) -> Hashcons.combine2 11 i.id_tag f.f_tag | Dprop (Plemma,i,f) -> Hashcons.combine2 11 i.id_tag f.f_tag
| Dprop (Pgoal, i,f) -> Hashcons.combine2 13 i.id_tag f.f_tag | Dprop (Pgoal, i,f) -> Hashcons.combine2 13 i.id_tag f.f_tag
...@@ -209,7 +216,8 @@ let mk_decl n = { d_node = n; d_tag = -1 } ...@@ -209,7 +216,8 @@ let mk_decl n = { d_node = n; d_tag = -1 }
let create_type tdl = Hdecl.hashcons (mk_decl (Dtype tdl)) let create_type tdl = Hdecl.hashcons (mk_decl (Dtype tdl))
let create_logic ldl = Hdecl.hashcons (mk_decl (Dlogic ldl)) let create_logic ldl = Hdecl.hashcons (mk_decl (Dlogic ldl))
let create_prop k i f = Hdecl.hashcons (mk_decl (Dprop (k, id_register i, f))) let create_ind ps la = Hdecl.hashcons (mk_decl (Dind (ps, la)))
let create_prop k i f = Hdecl.hashcons (mk_decl (Dprop (k, i, f)))
let create_use th = Hdecl.hashcons (mk_decl (Duse th)) let create_use th = Hdecl.hashcons (mk_decl (Duse th))
let create_clone sl = Hdecl.hashcons (mk_decl (Dclone sl)) let create_clone sl = Hdecl.hashcons (mk_decl (Dclone sl))
...@@ -251,20 +259,22 @@ let create_logic ldl = ...@@ -251,20 +259,22 @@ let create_logic ldl =
raise (BadDecl fs.ls_name) raise (BadDecl fs.ls_name)
| Lpredicate (ps, Some (s,_,_,_)) when s != ps -> | Lpredicate (ps, Some (s,_,_,_)) when s != ps ->
raise (BadDecl ps.ls_name) raise (BadDecl ps.ls_name)
| Linductive (ps,la) ->
let check_ax (_,f) =
ignore (check_fvs f);
in
List.iter check_ax la
| _ -> () | _ -> ()
in in
List.iter check_decl ldl; List.iter check_decl ldl;
create_logic ldl create_logic ldl
let create_ind ps la =
let make_ax (i,f) =
ignore (check_fvs f);
id_register i, f
in
create_ind ps (List.map make_ax la)
let create_prop k i f = let create_prop k i f =
let fvs = f_freevars Svs.empty f in let fvs = f_freevars Svs.empty f in
if not (Svs.is_empty fvs) then raise (UnboundVars fvs); if not (Svs.is_empty fvs) then raise (UnboundVars fvs);
create_prop k i f create_prop k (id_register i) f
(** Built-in symbols *) (** Built-in symbols *)
...@@ -371,10 +381,6 @@ module Context = struct ...@@ -371,10 +381,6 @@ module Context = struct
let add_logic d kn = function let add_logic d kn = function
| Lfunction (fs, df) -> add_known fs.ls_name d kn | Lfunction (fs, df) -> add_known fs.ls_name d kn
| Lpredicate (ps, dp) -> add_known ps.ls_name d kn | Lpredicate (ps, dp) -> add_known ps.ls_name d kn
| Linductive (ps, la) ->
let kn = add_known ps.ls_name d kn in
let add kn (id,f) = add_known id d kn in
List.fold_left add kn la
let check_logic kn d = let check_logic kn d =
let check chk (_,_,e,_) = chk e in let check chk (_,_,e,_) = chk e in
...@@ -386,10 +392,16 @@ module Context = struct ...@@ -386,10 +392,16 @@ module Context = struct
| Lpredicate (ps, dp) -> | Lpredicate (ps, dp) ->
List.iter (known_ty kn) ps.ls_args; List.iter (known_ty kn) ps.ls_args;
option_iter (check (known_fmla kn)) dp option_iter (check (known_fmla kn)) dp
| Linductive (ps, la) ->
List.iter (known_ty kn) ps.ls_args; let add_ind d kn ps la =
let check (_,f) = known_fmla kn f in let kn = add_known ps.ls_name d kn in
List.iter check la let add kn (id,f) = add_known id d kn in
List.fold_left add kn la
let check_ind kn ps la =
List.iter (known_ty kn) ps.ls_args;
let check (_,f) = known_fmla kn f in
List.iter check la
let add_decl ctxt d = let add_decl ctxt d =
try try
...@@ -397,14 +409,16 @@ module Context = struct ...@@ -397,14 +409,16 @@ module Context = struct
let kn = match d.d_node with let kn = match d.d_node with
| Dtype dl -> List.fold_left (add_type d) kn dl | Dtype dl -> List.fold_left (add_type d) kn dl
| Dlogic dl -> List.fold_left (add_logic d) kn dl | Dlogic dl -> List.fold_left (add_logic d) kn dl
| Dprop (k, id, _) -> add_known id d kn; | Dind (ps,la) -> add_ind d kn ps la
| Duse th -> add_known th.th_name d kn; | Dprop (k,id, _) -> add_known id d kn
| Duse th -> add_known th.th_name d kn
| Dclone _ -> kn | Dclone _ -> kn
in in
let () = match d.d_node with let () = match d.d_node with
| Dtype dl -> List.iter (check_type kn) dl | Dtype dl -> List.iter (check_type kn) dl
| Dlogic dl -> List.iter (check_logic kn) dl; | Dlogic dl -> List.iter (check_logic kn) dl
| Dprop (_, _, f) -> known_fmla kn f | Dind (ps,la) -> check_ind kn ps la
| Dprop (_,_,f) -> known_fmla kn f
| Duse _ | Dclone _ -> () | Duse _ | Dclone _ -> ()
in in
push_decl ctxt kn d push_decl ctxt kn d
...@@ -467,6 +481,10 @@ module Context = struct ...@@ -467,6 +481,10 @@ module Context = struct
Hls.add ls_table ls ls'; Hls.add ls_table ls ls';
Hid.add id_table ls.ls_name ls'.ls_name Hid.add id_table ls.ls_name ls'.ls_name
in in
let add_pr id f id' f' =
Hashtbl.add pr_table f.f_tag f';
Hid.add id_table id id'
in
Mts.iter add_ts inst.inst_ts; Mts.iter add_ts inst.inst_ts;
Mls.iter add_ls inst.inst_ls; Mls.iter add_ls inst.inst_ls;
...@@ -507,7 +525,7 @@ module Context = struct ...@@ -507,7 +525,7 @@ module Context = struct
(ts', def') :: acc (ts', def') :: acc
in in
let add_logic acc = function let add_logic acc = function
| Lfunction (ls, Some _) | Lpredicate (ls, Some _) | Linductive (ls, _) | Lfunction (ls, Some _) | Lpredicate (ls, Some _)
when Mls.mem ls inst.inst_ls -> when Mls.mem ls inst.inst_ls ->
raise (CannotInstantiate ls.ls_name) raise (CannotInstantiate ls.ls_name)
| Lfunction (ls, Some (_,_,_,f)) -> | Lfunction (ls, Some (_,_,_,f)) ->
...@@ -525,24 +543,24 @@ module Context = struct ...@@ -525,24 +543,24 @@ module Context = struct
Lfunction (find_ls ls, None) :: acc Lfunction (find_ls ls, None) :: acc
| Lpredicate (ls, None) -> | Lpredicate (ls, None) ->
Lpredicate (find_ls ls, None) :: acc Lpredicate (find_ls ls, None) :: acc
| Linductive (ls, fl) -> in
let trans (id, f) = (id, trans_fmla f) in let add_ind acc ps la =
Linductive (find_ls ls, List.map trans fl) :: acc if Mls.mem ps inst.inst_ls then raise (CannotInstantiate ps.ls_name);
let trans (id,f) = (id_dup id, trans_fmla f) in
let add_ax (id,f) (id',f') = add_pr id f id' f' in
let d' = create_ind (find_ls ps) (List.map trans la) in
match d'.d_node with
| Dind (_,la') -> List.iter2 add_ax la la'; d' :: acc
| _ -> assert false
in in
let add_prop acc k id f = match k with let add_prop acc k id f = match k with
| Pgoal -> | Pgoal ->
acc acc
| Paxiom | Plemma -> | Paxiom | Plemma ->
let id' = id_dup id in let d' = create_prop Paxiom (id_dup id) (trans_fmla f) in
let f' = trans_fmla f in match d'.d_node with
let d' = create_prop Paxiom id' f' in | Dprop (_,id',f') -> add_pr id f id' f'; d' :: acc
let id' = match d'.d_node with
| Dprop (_, id', _) -> id'
| _ -> assert false | _ -> assert false
in
Hashtbl.add pr_table f.f_tag f';
Hid.add id_table id id';
d' :: acc
in in
let add_decl acc d = match d.d_node with let add_decl acc d = match d.d_node with
| Dtype tyl -> | Dtype tyl ->
...@@ -551,6 +569,8 @@ module Context = struct ...@@ -551,6 +569,8 @@ module Context = struct
| Dlogic ll -> | Dlogic ll ->
let l = List.fold_left add_logic [] ll in let l = List.fold_left add_logic [] ll in
if l = [] then acc else create_logic l :: acc if l = [] then acc else create_logic l :: acc
| Dind (ps, la) ->
add_ind acc ps la
| Dprop (k, id, f) -> | Dprop (k, id, f) ->
add_prop acc k id f add_prop acc k id f
| Duse _ | Dclone _ -> | Duse _ | Dclone _ ->
...@@ -729,15 +749,17 @@ module Theory = struct ...@@ -729,15 +749,17 @@ module Theory = struct
let add_logic uc = function let add_logic uc = function
| Lfunction (fs,_) -> add_symbol add_ls fs.ls_name fs uc | Lfunction (fs,_) -> add_symbol add_ls fs.ls_name fs uc
| Lpredicate (ps,_) -> add_symbol add_ls ps.ls_name ps uc | Lpredicate (ps,_) -> add_symbol add_ls ps.ls_name ps uc
| Linductive (ps, la) ->
let uc = add_symbol add_ls ps.ls_name ps uc in let add_ind uc ps la =
let add uc (id,f) = add_symbol add_pr id f uc in let uc = add_symbol add_ls ps.ls_name ps uc in
List.fold_left add uc la let add uc (id,f) = add_symbol add_pr id f uc in
List.fold_left add uc la
let add_decl uc d = let add_decl uc d =
let uc = match d.d_node with let uc = match d.d_node with
| Dtype dl -> List.fold_left add_type uc dl | Dtype dl -> List.fold_left add_type uc dl
| Dlogic dl -> List.fold_left add_logic uc dl | Dlogic dl -> List.fold_left add_logic uc dl
| Dind (ps, la) -> add_ind uc ps la
| Dprop (_, id, f) -> add_symbol add_pr id f uc | Dprop (_, id, f) -> add_symbol add_pr id f uc
| Dclone _ | Duse _ -> uc | Dclone _ | Duse _ -> uc
in in
......
...@@ -39,7 +39,6 @@ type ps_defn ...@@ -39,7 +39,6 @@ type ps_defn
type logic_decl = type logic_decl =
| Lfunction of lsymbol * fs_defn option | Lfunction of lsymbol * fs_defn option
| Lpredicate of lsymbol * ps_defn option | Lpredicate of lsymbol * ps_defn option
| Linductive of lsymbol * (ident * fmla) list
val make_fs_defn : lsymbol -> vsymbol list -> term -> fs_defn val make_fs_defn : lsymbol -> vsymbol list -> term -> fs_defn
val make_ps_defn : lsymbol -> vsymbol list -> fmla -> ps_defn val make_ps_defn : lsymbol -> vsymbol list -> fmla -> ps_defn
...@@ -50,6 +49,10 @@ val open_ps_defn : ps_defn -> lsymbol * vsymbol list * fmla ...@@ -50,6 +49,10 @@ val open_ps_defn : ps_defn -> lsymbol * vsymbol list * fmla
val fs_defn_axiom : fs_defn -> fmla val fs_defn_axiom : fs_defn -> fmla
val ps_defn_axiom : ps_defn -> fmla val ps_defn_axiom : ps_defn -> fmla
(* inductive predicate declaration *)
type ind_decl = lsymbol * (ident * fmla) list
(* proposition declaration *) (* proposition declaration *)
type prop_kind = type prop_kind =
...@@ -90,17 +93,19 @@ and decl = private { ...@@ -90,17 +93,19 @@ and decl = private {
} }
and decl_node = and decl_node =
| Dtype of ty_decl list | Dtype of ty_decl list (* mutually recursive types *)
| Dlogic of logic_decl list | Dlogic of logic_decl list (* mutually recursive functions/predicates *)
| Dprop of prop_decl | Dind of ind_decl (* inductive predicate *)
| Duse of theory | Dprop of prop_decl (* axiom / lemma / goal *)
| Dclone of (ident * ident) list | Duse of theory (* depend on a theory *)
| Dclone of (ident * ident) list (* replicate a theory *)
(** Declaration constructors *) (** Declaration constructors *)
val create_type : ty_decl list -> decl val create_type : ty_decl list -> decl
val create_logic : logic_decl list -> decl val create_logic : logic_decl list -> decl
val create_prop : prop_kind -> preid -> fmla -> decl val create_prop : prop_kind -> preid -> fmla -> decl
val create_ind : lsymbol -> (preid * fmla) list -> decl
(* exceptions *) (* exceptions *)
...@@ -128,12 +133,12 @@ module Context : sig ...@@ -128,12 +133,12 @@ module Context : sig
val use_export : context -> theory -> context val use_export : context -> theory -> context
val clone_export : context -> theory -> th_inst -> context val clone_export : context -> theory -> th_inst -> context
val ctxt_fold : ('a -> decl -> 'a) -> 'a -> context -> 'a (* bottom-up, tail-recursive traversal functions *)
(** bottom-up, tail-rec *) val ctxt_fold : ('a -> decl -> 'a) -> 'a -> context -> 'a
val ctxt_iter : (decl -> unit) -> context -> unit val ctxt_iter : (decl -> unit) -> context -> unit
(** bottom-up, tail-rec *)
val get_decls : context -> decl list (* top-down list of decls *) (* top-down list of declarations *)
val get_decls : context -> decl list
exception UnknownIdent of ident exception UnknownIdent of ident
exception RedeclaredIdent of ident exception RedeclaredIdent of ident
......
...@@ -120,14 +120,14 @@ let print_logic_decl fmt = function ...@@ -120,14 +120,14 @@ let print_logic_decl fmt = function
List.iter forget_var vl List.iter forget_var vl
| Lpredicate _ -> | Lpredicate _ ->
assert false (*TODO*) assert false (*TODO*)
| Linductive _ ->
assert false
let print_decl fmt d = match d.d_node with let print_decl fmt d = match d.d_node with
| Dtype dl -> | Dtype dl ->
print_list newline print_type_decl fmt dl print_list newline print_type_decl fmt dl
| Dlogic dl -> | Dlogic dl ->
print_list newline print_logic_decl fmt dl print_list newline print_logic_decl fmt dl
| Dind _ ->
assert false
| Dprop (Paxiom, id, f) -> | Dprop (Paxiom, id, f) ->
fprintf fmt "@[<hov 2>axiom %a :@ %a@]@\n" print_ident id print_fmla f fprintf fmt "@[<hov 2>axiom %a :@ %a@]@\n" print_ident id print_fmla f
| Dprop (Pgoal, id, f) -> | Dprop (Pgoal, id, f) ->
......
...@@ -254,9 +254,6 @@ let print_type_decl fmt (ts,def) = match def with ...@@ -254,9 +254,6 @@ let print_type_decl fmt (ts,def) = match def with
let print_type_decl fmt d = print_type_decl fmt d; forget_tvs () let print_type_decl fmt d = print_type_decl fmt d; forget_tvs ()
let print_indbr fmt (id,f) =
fprintf fmt "@[<hov 4>| %a : %a@]" print_uc id print_fmla f
let print_logic_decl fmt = function let print_logic_decl fmt = function
| Lfunction (fs,None) -> | Lfunction (fs,None) ->
fprintf fmt "@[<hov 2>logic %a%a :@ %a@]" fprintf fmt "@[<hov 2>logic %a%a :@ %a@]"
...@@ -276,13 +273,12 @@ let print_logic_decl fmt = function ...@@ -276,13 +273,12 @@ let print_logic_decl fmt = function
fprintf fmt "@[<hov 2>logic %a%a =@ %a@]" fprintf fmt "@[<hov 2>logic %a%a =@ %a@]"
print_ls ps (print_paren_l print_vsty) vl print_fmla f; print_ls ps (print_paren_l print_vsty) vl print_fmla f;
List.iter forget_var vl List.iter forget_var vl
| Linductive (ps, bl) ->
fprintf fmt "@[<hov 2>inductive %a%a =@ @[<hov>%a@]@]"
print_ls ps (print_paren_l print_ty) ps.ls_args
(print_list newline print_indbr) bl
let print_logic_decl fmt d = print_logic_decl fmt d; forget_tvs () let print_logic_decl fmt d = print_logic_decl fmt d; forget_tvs ()
let print_indbr fmt (id,f) =
fprintf fmt "@[<hov 4>| %a : %a@]" print_uc id print_fmla f
let print_pkind fmt = function let print_pkind fmt = function
| Paxiom -> fprintf fmt "axiom" | Paxiom -> fprintf fmt "axiom"
| Plemma -> fprintf fmt "lemma" | Plemma -> fprintf fmt "lemma"
...@@ -294,6 +290,11 @@ let print_inst fmt (id1,id2) = ...@@ -294,6 +290,11 @@ let print_inst fmt (id1,id2) =
let print_decl fmt d = match d.d_node with let print_decl fmt d = match d.d_node with
| Dtype tl -> print_list newline2 print_type_decl fmt tl | Dtype tl -> print_list newline2 print_type_decl fmt tl
| Dlogic ll -> print_list newline2 print_logic_decl fmt ll | Dlogic ll -> print_list newline2 print_logic_decl fmt ll
| Dind (ps,bl) ->
fprintf fmt "@[<hov 2>inductive %a%a =@ @[<hov>%a@]@]"
print_ls ps (print_paren_l print_ty) ps.ls_args
(print_list newline print_indbr) bl;
forget_tvs ()
| Dprop (k,id,fmla) -> | Dprop (k,id,fmla) ->
fprintf fmt "@[<hov 2>%a %a :@ %a@]" fprintf fmt "@[<hov 2>%a %a :@ %a@]"
print_pkind k print_uc id print_fmla fmla; print_pkind k print_uc id print_fmla fmla;
......
...@@ -72,6 +72,7 @@ and pp_desc = ...@@ -72,6 +72,7 @@ and pp_desc =
| PPquant of pp_quant * uquant list * lexpr list list * lexpr | PPquant of pp_quant * uquant list * lexpr list list * lexpr
| PPnamed of string * lexpr | PPnamed of string * lexpr
| PPlet of ident * lexpr * lexpr | PPlet of ident * lexpr * lexpr
(* | PPeps of ident * lexpr *)
| PPmatch of lexpr * (pattern * lexpr) list | PPmatch of lexpr * (pattern * lexpr) list
| PPcast of lexpr * pty | PPcast of lexpr * pty
......
...@@ -996,10 +996,10 @@ let add_inductive loc id tyl cl th = ...@@ -996,10 +996,10 @@ let add_inductive loc id tyl cl th =
let loc = f.pp_loc in let loc = f.pp_loc in
let f' = fmla th' f in let f' = fmla th' f in
check_clausal_form loc ps f'; check_clausal_form loc ps f';
id_register (id_user id.id id.id_loc), f' id_user id.id id.id_loc, f'
in in
let cl = List.map clause cl in let cl = List.map clause cl in
add_decl th (create_logic [Linductive (ps, cl)]) add_decl th (create_ind ps cl)
let find_in_loadpath env f = let find_in_loadpath env f =
let rec find c lp = match lp, c with let rec find c lp = match lp, c with
......
...@@ -155,9 +155,6 @@ let print_logic_decl fmt = function ...@@ -155,9 +155,6 @@ let print_logic_decl fmt = function
| Lpredicate (ps,Some fd) -> | Lpredicate (ps,Some fd) ->
fprintf fmt "@[<hov 2>logic %a :@ %a@]" print_ident ps.ls_name fprintf fmt "@[<hov 2>logic %a :@ %a@]" print_ident ps.ls_name
print_fmla (ps_defn_axiom fd) print_fmla (ps_defn_axiom fd)
| Linductive (ps, fl) ->
fprintf fmt "@[<hov 2>inductive %a ...@]" print_ident ps.ls_name
let print_decl fmt d = match d.d_node with let print_decl fmt d = match d.d_node with
| Dtype tl -> | Dtype tl ->
...@@ -170,6 +167,8 @@ let print_decl fmt d = match d.d_node with ...@@ -170,6 +167,8 @@ let print_decl fmt d = match d.d_node with
(match k with Paxiom -> "axiom" | Pgoal -> "goal" | Plemma -> "lemma") (match k with Paxiom -> "axiom" | Pgoal -> "goal" | Plemma -> "lemma")
print_ident id print_ident id
print_fmla fmla print_fmla fmla
| Dind (ps, fl) ->
fprintf fmt "@[<hov 2>inductive %a ...@]" print_ident ps.ls_name
| Duse u -> fprintf fmt "use export %a@\n" print_ident u.th_name | Duse u -> fprintf fmt "use export %a@\n" print_ident u.th_name
| Dclone il -> fprintf fmt "(*@[<hov 2>clone export _ with %a@]@\n" | Dclone il -> fprintf fmt "(*@[<hov 2>clone export _ with %a@]@\n"
(print_list comma (print_pair_delim nothing nothing equal print_ident print_ident)) il (print_list comma (print_pair_delim nothing nothing equal print_ident print_ident)) il
......
...@@ -71,11 +71,11 @@ let fold isnotinlinedt isnotinlinedf _ env ctxt d = ...@@ -71,11 +71,11 @@ let fold isnotinlinedt isnotinlinedf _ env ctxt d =
add_decl ctxt add_decl ctxt
(create_logic [Lpredicate(ps,Some (make_ps_defn ps vs f))]) (create_logic [Lpredicate(ps,Some (make_ps_defn ps vs f))])
else {env with ps = Mls.add ps (vs,f) env.ps},ctxt else {env with ps = Mls.add ps (vs,f) env.ps},ctxt
| Linductive (ps,fmlal) ->
let fmlal = List.map
(fun (id,fmla) -> id,replacep env fmla) fmlal in
env,add_decl ctxt (create_logic [Linductive (ps,fmlal)])
end end
| Dind (ps,fmlal) ->
let fmlal = List.map
(fun (id,fmla) -> id_dup id,replacep env fmla) fmlal in
env,add_decl ctxt (create_ind ps fmlal)
| Dlogic dl -> env, | Dlogic dl -> env,
add_decl ctxt (create_logic add_decl ctxt