Commit 4cd5a72c authored by Andrei Paskevich's avatar Andrei Paskevich
Browse files

join fsymbol and psymbol into the common lsymbol type

parent e68cdad5
......@@ -47,53 +47,36 @@ let create_vsymbol name ty = {
let fresh_vsymbol v = create_vsymbol (id_dup v.vs_name) v.vs_ty
(** Function symbols *)
(** Function and predicate symbols *)
type fsymbol = {
fs_name : ident;
fs_scheme : ty list * ty;
fs_constr : bool;
type lsymbol = {
ls_name : ident;
ls_args : ty list;
ls_value : ty option;
ls_constr : bool;
}
module Fsym = struct
type t = fsymbol
module Lsym = struct
type t = lsymbol
let equal = (==)
let hash fs = fs.fs_name.id_tag
let hash fs = fs.ls_name.id_tag
let compare fs1 fs2 =
Pervasives.compare fs1.fs_name.id_tag fs2.fs_name.id_tag
Pervasives.compare fs1.ls_name.id_tag fs2.ls_name.id_tag
end
module Sfs = Set.Make(Fsym)
module Mfs = Map.Make(Fsym)
module Hfs = Hashtbl.Make(Fsym)
let create_fsymbol name scheme constr = {
fs_name = id_register name;
fs_scheme = scheme;
fs_constr = constr;
module Sls = Set.Make(Lsym)
module Mls = Map.Make(Lsym)
module Hls = Hashtbl.Make(Lsym)
let mk_lsymbol name args value constr = {
ls_name = id_register name;
ls_args = args;
ls_value = value;
ls_constr = constr;
}
(** Predicate symbols *)
type psymbol = {
ps_name : ident;
ps_scheme : ty list;
}
module Psym = struct
type t = psymbol
let equal = (==)
let hash ps = ps.ps_name.id_tag
let compare ps1 ps2 =
Pervasives.compare ps1.ps_name.id_tag ps2.ps_name.id_tag
end
module Sps = Set.Make(Psym)
module Mps = Map.Make(Psym)
module Hps = Hashtbl.Make(Psym)
let create_psymbol name scheme = {
ps_name = id_register name;
ps_scheme = scheme;
}
let create_fsymbol nm al vl = mk_lsymbol nm al (Some vl) false
let create_fconstr nm al vl = mk_lsymbol nm al (Some vl) true
let create_psymbol nm al = mk_lsymbol nm al None false
(** Patterns *)
......@@ -106,7 +89,7 @@ type pattern = {
and pattern_node =
| Pwild
| Pvar of vsymbol
| Papp of fsymbol * pattern list
| Papp of lsymbol * pattern list
| Pas of pattern * vsymbol
module Hpat = struct
......@@ -128,7 +111,7 @@ module Hpat = struct
let hash_node = function
| Pwild -> 0
| Pvar v -> v.vs_name.id_tag
| Papp (s, pl) -> Hashcons.combine_list hash_pattern s.fs_name.id_tag pl
| Papp (s, pl) -> Hashcons.combine_list hash_pattern s.ls_name.id_tag pl
| Pas (p, v) -> Hashcons.combine (hash_pattern p) v.vs_name.id_tag
let hash p = Hashcons.combine (hash_node p.pat_node) p.pat_ty.ty_tag
......@@ -167,17 +150,19 @@ let pat_any pr pat =
(* smart constructors for patterns *)
exception BadArity
exception ConstructorExpected of fsymbol
exception ConstructorExpected of lsymbol
exception FunctionSymbolExpected of lsymbol
exception PredicateSymbolExpected of lsymbol
let pat_app fs pl ty =
if not fs.fs_constr then raise (ConstructorExpected fs);
let args, res = fs.fs_scheme in
ignore (try
List.fold_left2 Ty.matching
(Ty.matching Mid.empty res ty)
args (List.map (fun p -> p.pat_ty) pl)
with Invalid_argument _ -> raise BadArity);
if not fs.ls_constr then raise (ConstructorExpected fs);
let s = match fs.ls_value with
| Some vty -> Ty.matching Mid.empty vty ty
| None -> raise (FunctionSymbolExpected fs)
in
let mtch s ty p = Ty.matching s ty p.pat_ty in
ignore (try List.fold_left2 mtch s fs.ls_args pl
with Invalid_argument _ -> raise BadArity);
pat_app fs pl ty
let pat_as p v =
......@@ -192,21 +177,21 @@ let pat_map fn pat = match pat.pat_node with
(* symbol-wise map/fold *)
let rec pat_s_map fnT fnV fnF pat =
let fn p = pat_s_map fnT fnV fnF p in
let rec pat_s_map fnT fnV fnL pat =
let fn p = pat_s_map fnT fnV fnL p in
let ty = fnT pat.pat_ty in
match pat.pat_node with
| Pwild -> pat_wild ty
| Pvar v -> pat_var (fnV v ty)
| Papp (s, pl) -> pat_app (fnF s) (List.map fn pl) ty
| Papp (s, pl) -> pat_app (fnL s) (List.map fn pl) ty
| Pas (p, v) -> pat_as (fn p) (fnV v ty)
let rec pat_s_fold fnT fnF acc pat =
let fn acc p = pat_s_fold fnT fnF acc p in
let rec pat_s_fold fnT fnL acc pat =
let fn acc p = pat_s_fold fnT fnL acc p in
let acc = ty_s_fold fnT acc pat.pat_ty in
match pat.pat_node with
| Pwild | Pvar _ -> acc
| Papp (s, pl) -> List.fold_left fn (fnF acc s) pl
| Papp (s, pl) -> List.fold_left fn (fnL acc s) pl
| Pas (p, _) -> fn acc p
(* alpha-equality on patterns *)
......@@ -260,13 +245,13 @@ and term_node =
| Tbvar of int
| Tvar of vsymbol
| Tconst of constant
| Tapp of fsymbol * term list
| Tapp of lsymbol * term list
| Tlet of term * term_bound
| Tcase of term * term_branch list
| Teps of fmla_bound
and fmla_node =
| Fapp of psymbol * term list
| Fapp of lsymbol * term list
| Fquant of quant * fmla_quant
| Fbinop of binop * fmla * fmla
| Fnot of fmla
......@@ -343,7 +328,7 @@ module T = struct
| Tbvar n -> n
| Tvar v -> v.vs_name.id_tag
| Tconst c -> Hashtbl.hash c
| Tapp (f, tl) -> Hashcons.combine_list t_hash (f.fs_name.id_tag) tl
| Tapp (f, tl) -> Hashcons.combine_list t_hash (f.ls_name.id_tag) tl
| Tlet (t, bt) -> Hashcons.combine t.t_tag (t_hash_bound bt)
| Tcase (t, bl) -> Hashcons.combine_list t_hash_branch t.t_tag bl
| Teps f -> f_hash_bound f
......@@ -424,7 +409,7 @@ module F = struct
List.fold_left (Hashcons.combine_list tr_hash) h tl
let f_hash_node = function
| Fapp (p, tl) -> Hashcons.combine_list t_hash p.ps_name.id_tag tl
| Fapp (p, tl) -> Hashcons.combine_list t_hash p.ls_name.id_tag tl
| Fquant (q, bf) -> Hashcons.combine (Hashtbl.hash q) (f_hash_quant bf)
| Fbinop (op, f1, f2) ->
Hashcons.combine2 (Hashtbl.hash op) f1.f_tag f2.f_tag
......@@ -873,23 +858,25 @@ let t_let v t1 t2 =
let f_let v t1 f2 =
if v.vs_ty == t1.t_ty then f_let v t1 f2 else raise TypeMismatch
let t_app f tl ty =
let args, res = f.fs_scheme in
let _ =
try List.fold_left2 Ty.matching
(Ty.matching Mid.empty res ty)
args (List.map (fun t -> t.t_ty) tl)
with Invalid_argument _ -> raise BadArity
let t_app fs tl ty =
let s = match fs.ls_value with
| Some vty -> Ty.matching Mid.empty vty ty
| _ -> raise (FunctionSymbolExpected fs)
in
t_app f tl ty
let f_app p tl =
let _ =
try List.fold_left2 Ty.matching Mid.empty
p.ps_scheme (List.map (fun t -> t.t_ty) tl)
with Invalid_argument _ -> raise BadArity
let mtch s ty t = Ty.matching s ty t.t_ty in
ignore (try List.fold_left2 mtch s fs.ls_args tl
with Invalid_argument _ -> raise BadArity);
t_app fs tl ty
let f_app ps tl =
let s = match ps.ls_value with
| None -> Mid.empty
| _ -> raise (PredicateSymbolExpected ps)
in
f_app p tl
let mtch s ty t = Ty.matching s ty t.t_ty in
ignore (try List.fold_left2 mtch s ps.ls_args tl
with Invalid_argument _ -> raise BadArity);
f_app ps tl
let t_case t bl ty =
let t_check_branch (p, _, tbr) =
......@@ -908,30 +895,30 @@ let f_case t bl =
(* symbol-wise map *)
let rec t_s_map fnT fnV fnF fnP t =
let fn_t = t_s_map fnT fnV fnF fnP in
let fn_f = f_s_map fnT fnV fnF fnP in
let rec t_s_map fnT fnV fnL t =
let fn_t = t_s_map fnT fnV fnL in
let fn_f = f_s_map fnT fnV fnL in
let ty = fnT t.t_ty in
t_label_try t.t_label (match t.t_node with
| Tbvar n -> t_bvar n ty
| Tvar v -> t_var (fnV v ty)
| Tconst _ -> t
| Tapp (f, tl) -> t_app (fnF f) (List.map fn_t tl) ty
| Tapp (f, tl) -> t_app (fnL f) (List.map fn_t tl) ty
| Tlet (t1, (u, t2)) ->
let t1 = fn_t t1 in t_let (fnV u t1.t_ty) t1 (fn_t t2)
| Tcase (t1, bl) ->
let fn_b = t_branch fnT fnV fnF fnP in
let fn_b = t_branch fnT fnV fnL in
t_case (fn_t t1) (List.map fn_b bl) ty
| Teps (u, f) -> t_eps (fnV u ty) (fn_f f))
and t_branch fnT fnV fnF fnP (pat, nv, t) =
(pat_s_map fnT fnV fnF pat, nv, t_s_map fnT fnV fnF fnP t)
and t_branch fnT fnV fnL (pat, nv, t) =
(pat_s_map fnT fnV fnL pat, nv, t_s_map fnT fnV fnL t)
and f_s_map fnT fnV fnF fnP f =
let fn_t = t_s_map fnT fnV fnF fnP in
let fn_f = f_s_map fnT fnV fnF fnP in
and f_s_map fnT fnV fnL f =
let fn_t = t_s_map fnT fnV fnL in
let fn_f = f_s_map fnT fnV fnL in
f_label_try f.f_label (match f.f_node with
| Fapp (p, tl) -> f_app (fnP p) (List.map fn_t tl)
| Fapp (p, tl) -> f_app (fnL p) (List.map fn_t tl)
| Fquant (q, (vl, nv, tl, f1)) ->
let tl = tr_map fn_t fn_f tl in
let fn_v u = fnV u (fnT u.vs_ty) in
......@@ -943,11 +930,11 @@ and f_s_map fnT fnV fnF fnP f =
| Flet (t, (u, f1)) ->
let t1 = fn_t t in f_let (fnV u t1.t_ty) t1 (fn_f f1)
| Fcase (t, bl) ->
let fn_b = f_branch fnT fnV fnF fnP in
let fn_b = f_branch fnT fnV fnL in
f_case (fn_t t) (List.map fn_b bl))
and f_branch fnT fnV fnF fnP (pat, nv, f) =
(pat_s_map fnT fnV fnF pat, nv, f_s_map fnT fnV fnF fnP f)
and f_branch fnT fnV fnL (pat, nv, f) =
(pat_s_map fnT fnV fnL pat, nv, f_s_map fnT fnV fnL f)
let get_fnV () =
let ht = Hid.create 17 in
......@@ -970,33 +957,33 @@ let get_fnT fn =
in
fnT
let t_s_map fnT fnF fnP t = t_s_map (get_fnT fnT) (get_fnV ()) fnF fnP t
let f_s_map fnT fnF fnP f = f_s_map (get_fnT fnT) (get_fnV ()) fnF fnP f
let t_s_map fnT fnL t = t_s_map (get_fnT fnT) (get_fnV ()) fnL t
let f_s_map fnT fnL f = f_s_map (get_fnT fnT) (get_fnV ()) fnL f
(* symbol-wise fold *)
let rec t_s_fold fnT fnF fnP acc t =
let fn_t = t_s_fold fnT fnF fnP in
let fn_f = f_s_fold fnT fnF fnP in
let rec t_s_fold fnT fnL acc t =
let fn_t = t_s_fold fnT fnL in
let fn_f = f_s_fold fnT fnL in
let acc = ty_s_fold fnT acc t.t_ty in
match t.t_node with
| Tbvar _ | Tvar _ | Tconst _ -> acc
| Tapp (f, tl) -> List.fold_left fn_t (fnF acc f) tl
| Tapp (f, tl) -> List.fold_left fn_t (fnL acc f) tl
| Tlet (t1, (_,t2)) -> fn_t (fn_t acc t1) t2
| Tcase (t1, bl) ->
let fn_b = t_branch fnT fnF fnP in
let fn_b = t_branch fnT fnL in
List.fold_left fn_b (fn_t acc t1) bl
| Teps (_,f) -> fn_f acc f
and t_branch fnT fnF fnP acc (pat,_,t) =
t_s_fold fnT fnF fnP (pat_s_fold fnT fnF acc pat) t
and t_branch fnT fnL acc (pat,_,t) =
t_s_fold fnT fnL (pat_s_fold fnT fnL acc pat) t
and f_s_fold fnT fnF fnP acc f =
let fn_t = t_s_fold fnT fnF fnP in
let fn_f = f_s_fold fnT fnF fnP in
and f_s_fold fnT fnL acc f =
let fn_t = t_s_fold fnT fnL in
let fn_f = f_s_fold fnT fnL in
let fn_v acc u = ty_s_fold fnT acc u.vs_ty in
match f.f_node with
| Fapp (p, tl) -> List.fold_left fn_t (fnP acc p) tl
| Fapp (p, tl) -> List.fold_left fn_t (fnL acc p) tl
| Fquant (q, (vl,_,tl,f1)) ->
let acc = List.fold_left fn_v acc vl in
fn_f (tr_fold fn_t fn_f acc tl) f1
......@@ -1006,27 +993,23 @@ and f_s_fold fnT fnF fnP acc f =
| Fif (f1, f2, f3) -> fn_f (fn_f (fn_f acc f1) f2) f3
| Flet (t, (_,f1)) -> fn_f (fn_t acc t) f1
| Fcase (t, bl) ->
let fn_b = f_branch fnT fnF fnP in
let fn_b = f_branch fnT fnL in
List.fold_left fn_b (fn_t acc t) bl
and f_branch fnT fnF fnP acc (pat,_,f) =
f_s_fold fnT fnF fnP (pat_s_fold fnT fnF acc pat) f
and f_branch fnT fnL acc (pat,_,f) =
f_s_fold fnT fnL (pat_s_fold fnT fnL acc pat) f
let t_s_all prT prF prP t =
try t_s_fold (all_fn prT) (all_fn prF) (all_fn prP) true t
with FoldSkip -> false
let t_s_all prT prL t =
try t_s_fold (all_fn prT) (all_fn prL) true t with FoldSkip -> false
let f_s_all prT prF prP f =
try f_s_fold (all_fn prT) (all_fn prF) (all_fn prP) true f
with FoldSkip -> false
let f_s_all prT prL f =
try f_s_fold (all_fn prT) (all_fn prL) true f with FoldSkip -> false
let t_s_any prT prF prP t =
try t_s_fold (any_fn prT) (any_fn prF) (any_fn prP) false t
with FoldSkip -> true
let t_s_any prT prL t =
try t_s_fold (any_fn prT) (any_fn prL) false t with FoldSkip -> true
let f_s_any prT prF prP f =
try f_s_fold (any_fn prT) (any_fn prF) (any_fn prP) false f
with FoldSkip -> true
let f_s_any prT prL f =
try f_s_fold (any_fn prT) (any_fn prL) false f with FoldSkip -> true
(* safe smart constructors *)
......
......@@ -33,38 +33,30 @@ module Hvs : Hashtbl.S with type key = vsymbol
val create_vsymbol : preid -> ty -> vsymbol
(** Function symbols *)
(** Function and predicate symbols *)
type fsymbol = private {
fs_name : ident;
fs_scheme : ty list * ty;
fs_constr : bool;
type lsymbol = private {
ls_name : ident;
ls_args : ty list;
ls_value : ty option;
ls_constr : bool;
}
val create_fsymbol : preid -> ty list * ty -> bool -> fsymbol
val create_fsymbol : preid -> ty list -> ty -> lsymbol
val create_fconstr : preid -> ty list -> ty -> lsymbol
val create_psymbol : preid -> ty list -> lsymbol
module Sfs : Set.S with type elt = fsymbol
module Mfs : Map.S with type key = fsymbol
module Hfs : Hashtbl.S with type key = fsymbol
(** Predicate symbols *)
type psymbol = private {
ps_name : ident;
ps_scheme : ty list;
}
val create_psymbol : preid -> ty list -> psymbol
module Sps : Set.S with type elt = psymbol
module Mps : Map.S with type key = psymbol
module Hps : Hashtbl.S with type key = psymbol
module Sls : Set.S with type elt = lsymbol
module Mls : Map.S with type key = lsymbol
module Hls : Hashtbl.S with type key = lsymbol
(** Exceptions *)
exception BadArity
exception NonLinear of vsymbol
exception ConstructorExpected of fsymbol
exception ConstructorExpected of lsymbol
exception FunctionSymbolExpected of lsymbol
exception PredicateSymbolExpected of lsymbol
(** Patterns *)
......@@ -77,14 +69,14 @@ type pattern = private {
and pattern_node = private
| Pwild
| Pvar of vsymbol
| Papp of fsymbol * pattern list
| Papp of lsymbol * pattern list
| Pas of pattern * vsymbol
(* smart constructors for patterns *)
val pat_wild : ty -> pattern
val pat_var : vsymbol -> pattern
val pat_app : fsymbol -> pattern list -> ty -> pattern
val pat_app : lsymbol -> pattern list -> ty -> pattern
val pat_as : pattern -> vsymbol -> pattern
(* generic traversal functions *)
......@@ -137,13 +129,13 @@ and term_node = private
| Tbvar of int
| Tvar of vsymbol
| Tconst of constant
| Tapp of fsymbol * term list
| Tapp of lsymbol * term list
| Tlet of term * term_bound
| Tcase of term * term_branch list
| Teps of fmla_bound
and fmla_node = private
| Fapp of psymbol * term list
| Fapp of lsymbol * term list
| Fquant of quant * fmla_quant
| Fbinop of binop * fmla * fmla
| Fnot of fmla
......@@ -178,7 +170,7 @@ module Sfmla : Set.S with type elt = fmla
val t_var : vsymbol -> term
val t_const : constant -> ty -> term
val t_app : fsymbol -> term list -> ty -> term
val t_app : lsymbol -> term list -> ty -> term
val t_let : vsymbol -> term -> term -> term
val t_case : term -> (pattern * term) list -> ty -> term
val t_eps : vsymbol -> fmla -> term
......@@ -188,7 +180,7 @@ val t_label_add : label -> term -> term
(* smart constructors for fmla *)
val f_app : psymbol -> term list -> fmla
val f_app : lsymbol -> term list -> fmla
val f_forall : vsymbol list -> trigger list -> fmla -> fmla
val f_exists : vsymbol list -> trigger list -> fmla -> fmla
val f_quant : quant -> vsymbol list -> trigger list -> fmla -> fmla
......@@ -222,11 +214,11 @@ val f_open_quant : fmla_quant -> vsymbol list * trigger list * fmla
val t_map : (term -> term) -> (fmla -> fmla) -> term -> term
val f_map : (term -> term) -> (fmla -> fmla) -> fmla -> fmla
val t_fold : ('a -> term -> 'a) -> ('a -> fmla -> 'a)
-> 'a -> term -> 'a
val t_fold :
('a -> term -> 'a) -> ('a -> fmla -> 'a) -> 'a -> term -> 'a
val f_fold : ('a -> term -> 'a) -> ('a -> fmla -> 'a)
-> 'a -> fmla -> 'a
val f_fold :
('a -> term -> 'a) -> ('a -> fmla -> 'a) -> 'a -> fmla -> 'a
val t_all : (term -> bool) -> (fmla -> bool) -> term -> bool
val f_all : (term -> bool) -> (fmla -> bool) -> fmla -> bool
......@@ -235,29 +227,19 @@ val f_any : (term -> bool) -> (fmla -> bool) -> fmla -> bool
(* symbol-wise map/fold *)
val t_s_map : (tysymbol -> tysymbol) -> (fsymbol -> fsymbol)
-> (psymbol -> psymbol) -> term -> term
val f_s_map : (tysymbol -> tysymbol) -> (fsymbol -> fsymbol)
-> (psymbol -> psymbol) -> fmla -> fmla
val t_s_fold : ('a -> tysymbol -> 'a) -> ('a -> fsymbol -> 'a)
-> ('a -> psymbol -> 'a) -> 'a -> term -> 'a
val f_s_fold : ('a -> tysymbol -> 'a) -> ('a -> fsymbol -> 'a)
-> ('a -> psymbol -> 'a) -> 'a -> fmla -> 'a
val t_s_all : (tysymbol -> bool) -> (fsymbol -> bool)
-> (psymbol -> bool) -> term -> bool
val t_s_map : (tysymbol -> tysymbol) -> (lsymbol -> lsymbol) -> term -> term
val f_s_map : (tysymbol -> tysymbol) -> (lsymbol -> lsymbol) -> fmla -> fmla
val f_s_all : (tysymbol -> bool) -> (fsymbol -> bool)
-> (psymbol -> bool) -> fmla -> bool
val t_s_fold :
('a -> tysymbol -> 'a) -> ('a -> lsymbol -> 'a) -> 'a -> term -> 'a
val t_s_any : (tysymbol -> bool) -> (fsymbol -> bool)
-> (psymbol -> bool) -> term -> bool
val f_s_fold :
('a -> tysymbol -> 'a) -> ('a -> lsymbol -> 'a) -> 'a -> fmla -> 'a
val f_s_any : (tysymbol -> bool) -> (fsymbol -> bool)
-> (psymbol -> bool) -> fmla -> bool
val t_s_all : (tysymbol -> bool) -> (lsymbol -> bool) -> term -> bool
val f_s_all : (tysymbol -> bool) -> (lsymbol -> bool) -> fmla -> bool
val t_s_any : (tysymbol -> bool) -> (lsymbol -> bool) -> term -> bool
val f_s_any : (tysymbol -> bool) -> (lsymbol -> bool) -> fmla -> bool
(* map/fold over free variables *)
......@@ -329,8 +311,8 @@ val f_match : fmla -> fmla -> term Mvs.t -> term Mvs.t option
(* built-in symbols *)
val ps_equ : psymbol
val ps_neq : psymbol
val ps_equ : lsymbol
val ps_neq : lsymbol
val f_equ : term -> term -> fmla
val f_neq : term -> term -> fmla
......
......@@ -19,6 +19,7 @@
open Format
open Pp
open Util
open Ident
open Ty
open Term
......@@ -29,19 +30,19 @@ open Term
type ty_def =
| Tabstract
| Talgebraic of fsymbol list
| Talgebraic of lsymbol list
type ty_decl = tysymbol * ty_def
(* logic declaration *)
type fs_defn = fsymbol * vsymbol list * term * fmla
type ps_defn = psymbol * vsymbol list * fmla * fmla
type fs_defn = lsymbol * vsymbol list * term * fmla
type ps_defn = lsymbol * vsymbol list * fmla * fmla
type logic_decl =
| Lfunction of fsymbol * fs_defn option
| Lpredicate of psymbol * ps_defn option
| Linductive of psymbol * (ident * fmla) list
| Lfunction of lsymbol * fs_defn option
| Lpredicate of lsymbol * ps_defn option
| Linductive of lsymbol * (ident * fmla) list
(* proposition declaration *)
......@@ -97,17 +98,17 @@ module D = struct
let hs_td (ts,td) = match td with
| Tabstract -> ts.ts_name.id_tag
| Talgebraic l ->
let tag fs = fs.fs_name.id_tag in
let tag fs = fs.ls_name.id_tag in
1 + Hashcons.combine_list tag ts.ts_name.id_tag l
let hs_fd fd = Hashcons.combine_option (fun (_,_,_,f) -> f.f_tag) fd
let hs_ld ld = match ld with
| Lfunction (fs,fd) -> Hashcons.combine fs.fs_name.id_tag (hs_fd fd)
| Lpredicate (ps,pd) -> Hashcons.combine ps.ps_name.id_tag (hs_fd pd)
| 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)
| Linductive (ps,l) ->
let hs_pair (i,f) = Hashcons.combine i.id_tag f.f_tag in
Hashcons.combine_list hs_pair ps.ps_name.id_tag l
Hashcons.combine_list hs_pair ps.ls_name.id_tag l
let hash d = match d.d_node with
| Dtype l -> Hashcons.combine_list hs_td 0 l
......@@ -135,11 +136,11 @@ let create_prop k i f = Hdecl.hashcons (mk_decl (Dprop (k, id_register i, f)))
(* error reporting *)
exception NotAConstructor of fsymbol
exception ConstructorExpected of lsymbol
exception IllegalTypeAlias of tysymbol