Skip to content

GitLab

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

join fsymbol and psymbol into the common lsymbol type

parent e68cdad5
Hide whitespace changes
Inline Side-by-side
Showing with 300 additions and 344 deletions
src/core/term.ml
View file @ 4cd5a72c
......@@ -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 *)
......
src/core/term.mli
View file @ 4cd5a72c
......@@ -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
......
src/core/theory.ml
View file @ 4cd5a72c
......@@ -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