Skip to content

GitLab

Attention une mise à jour du serveur va être effectuée le lundi 17 mai entre 13h et 13h30. Cette mise à jour va générer une interruption du service de quelques minutes.

Commit 903df0ef authored by Andrei Paskevich's avatar Andrei Paskevich
Browse files
Options

remove duplicate functions from Term (f_map => t_map, etc)

parent 8a0f0ab5
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 303 additions and 541 deletions
src/coq-plugin/whytac.ml
View file @ 903df0ef
......@@ -821,9 +821,9 @@ and tr_formula dep tvm bv env f =
let ls = tr_global_ls dep env (ConstructRef cj) in
if List.length vars <> List.length ls.ls_args then raise NotFO;
let pat = pat_app ls (List.map pat_var vars) ty in
f_close_branch pat (tr_formula dep tvm bv env bj)
t_close_branch pat (tr_formula dep tvm bv env bj)
in
f_case t (Array.to_list (Array.mapi branch br))
t_case t (Array.to_list (Array.mapi branch br))
| Case _, _ :: _ ->
raise NotFO (* TODO: we could possibly swap case and application *)
| _ ->
......@@ -874,7 +874,7 @@ let tr_goal gl =
let ty = tr_type dep tvm env ty in
let vs = Term.create_vsymbol (preid_of_id id) ty in
let bv = Idmap.add id vs bv in
Term.f_let_close vs d (tr_ctxt tvm bv ctxt)
Term.t_let_close vs d (tr_ctxt tvm bv ctxt)
with NotFO ->
tr_ctxt tvm bv ctxt
end
......
src/core/decl.ml
View file @ 903df0ef
......@@ -40,7 +40,7 @@ type logic_decl = lsymbol * ls_defn option
exception UnboundVar of vsymbol
let check_fvs f =
let fvs = f_freevars Svs.empty (t_prop f) in
let fvs = t_freevars Svs.empty (t_prop f) in
Svs.iter (fun vs -> raise (UnboundVar vs)) fvs;
f
......@@ -62,7 +62,7 @@ let make_ps_defn ps vl f =
List.iter2 check_vl ps.ls_args vl;
ps, Some (ps, check_fvs pd)
let make_ls_defn ls vl = e_apply (make_fs_defn ls vl) (make_ps_defn ls vl)
let make_ls_defn ls vl = e_map (make_fs_defn ls vl) (make_ps_defn ls vl)
let open_ls_defn (_,f) =
let vl, ef = f_open_forall f in
......@@ -140,24 +140,24 @@ let build_call_graph cgr syms ls =
| _ -> t_fold (term vm) (fmla vm) () t
and fmla vm () f = match f.t_node with
| Tapp (s,tl) when Mls.mem s syms ->
f_fold (term vm) (fmla vm) () f; call vm s tl
t_fold (term vm) (fmla vm) () f; call vm s tl
| Tlet ({t_node = Tvar v}, b) when Mvs.mem v vm ->
let u,e = f_open_bound b in
let u,e = t_open_bound b in
fmla (Mvs.add u (Mvs.find v vm) vm) () e
| Tcase (e,bl) ->
term vm () e; List.iter (fun b ->
let p,f = f_open_branch b in
let p,f = t_open_branch b in
let vml = match_term vm e [vm] p in
List.iter (fun vm -> fmla vm () f) vml) bl
| Fquant (_,b) ->
let _,_,f = f_open_quant b in fmla vm () f
| _ -> f_fold (term vm) (fmla vm) () f
| _ -> t_fold (term vm) (fmla vm) () f
in
fun (vl,e) ->
let i = ref (-1) in
let add vm v = incr i; Mvs.add v (Equal !i) vm in
let vm = List.fold_left add Mvs.empty vl in
e_apply (term vm ()) (fmla vm ()) e
e_map (term vm ()) (fmla vm ()) e
let build_call_list cgr ls =
let htb = Hls.create 5 in
......@@ -309,12 +309,12 @@ module Hsdecl = Hashcons.Make (struct
| _ -> false
let eq_ld (ls1,ld1) (ls2,ld2) = ls_equal ls1 ls2 && match ld1,ld2 with
| Some (_,f1), Some (_,f2) -> f_equal f1 f2
| Some (_,f1), Some (_,f2) -> t_equal f1 f2
| None, None -> true
| _ -> false
let eq_iax (pr1,fr1) (pr2,fr2) =
pr_equal pr1 pr2 && f_equal fr1 fr2
pr_equal pr1 pr2 && t_equal fr1 fr2
let eq_ind (ps1,al1) (ps2,al2) =
ls_equal ps1 ps2 && list_all2 eq_iax al1 al2
......@@ -324,7 +324,7 @@ module Hsdecl = Hashcons.Make (struct
| 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) ->
k1 = k2 && pr_equal pr1 pr2 && f_equal f1 f2
k1 = k2 && pr_equal pr1 pr2 && t_equal f1 f2
| _,_ -> false
let hs_td (ts,td) = match td with
......@@ -332,9 +332,9 @@ module Hsdecl = Hashcons.Make (struct
| Talgebraic l -> 1 + Hashcons.combine_list ls_hash (ts_hash ts) l
let hs_ld (ls,ld) = Hashcons.combine (ls_hash ls)
(Hashcons.combine_option (fun (_,f) -> f_hash f) ld)
(Hashcons.combine_option (fun (_,f) -> t_hash f) ld)
let hs_prop (pr,f) = Hashcons.combine (pr_hash pr) (f_hash f)
let hs_prop (pr,f) = Hashcons.combine (pr_hash pr) (t_hash f)
let hs_ind (ps,al) = Hashcons.combine_list hs_prop (ls_hash ps) al
......@@ -390,7 +390,7 @@ 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_ts syms_ls s t
let syms_fmla s f = f_s_fold syms_ts syms_ls s f
let syms_fmla s f = t_s_fold syms_ts syms_ls s f
let create_ty_decl tdl =
if tdl = [] then raise EmptyDecl;
......@@ -465,7 +465,7 @@ let rec f_pos_ps sps pol f = match f.t_node, pol with
f_pos_ps sps (option_map not pol) f
| Tif (f,g,h), _ ->
f_pos_ps sps None f && f_pos_ps sps pol g && f_pos_ps sps pol h
| _ -> f_all (t_pos_ps sps) (f_pos_ps sps pol) f
| _ -> t_all (t_pos_ps sps) (f_pos_ps sps pol) f
let create_ind_decl idl =
if idl = [] then raise EmptyDecl;
......@@ -548,16 +548,16 @@ let decl_map_fold fnT fnF acc d =
match d.d_node with
| Dtype _ -> acc, d
| Dprop (k,pr,f) ->
let acc, f = f_map_fold fnT fnF acc f in
let acc, f = t_map_fold fnT fnF acc f in
acc, create_prop_decl k pr f
| Dind l ->
let acc, l =
list_rpair_map_fold (list_rpair_map_fold (f_map_fold fnT fnF)) acc l in
list_rpair_map_fold (list_rpair_map_fold (t_map_fold fnT fnF)) acc l in
acc, create_ind_decl l
| Dlogic l ->
let acc, l =
list_rpair_map_fold (option_map_fold
(rpair_map_fold (f_map_fold fnT fnF))) acc l in
(rpair_map_fold (t_map_fold fnT fnF))) acc l in
acc, create_logic_decl l
......@@ -642,11 +642,11 @@ let rec check_matchT kn () t = match t.t_node with
and check_matchF kn () f = match f.t_node with
| Tcase (t1,bl) ->
let bl = List.map (fun b -> let p,f = f_open_branch b in [p],f) bl in
ignore (try Pattern.CompileFmla.compile (find_constructors kn) [t1] bl
let bl = List.map (fun b -> let p,f = t_open_branch b in [p],f) bl in
ignore (try Pattern.CompileTerm.compile (find_constructors kn) [t1] bl
with Pattern.NonExhaustive p -> raise (NonExhaustiveExpr (p,f)));
f_fold (check_matchT kn) (check_matchF kn) () f
| _ -> f_fold (check_matchT kn) (check_matchF kn) () f
t_fold (check_matchT kn) (check_matchF kn) () f
| _ -> t_fold (check_matchT kn) (check_matchF kn) () f
let check_match kn d = decl_fold (check_matchT kn) (check_matchF kn) () d
......
src/core/pattern.ml
View file @ 903df0ef
......@@ -150,11 +150,3 @@ module CompileTerm = Compile (struct
let mk_case t bl = t_case t bl
end)
module CompileFmla = Compile (struct
type action = fmla
type branch = fmla_branch
let mk_let v t f = f_let_close_simp v t f
let mk_branch p f = f_close_branch p f
let mk_case t bl = f_case t bl
end)
src/core/pattern.mli
View file @ 903df0ef
......@@ -42,9 +42,3 @@ module CompileTerm : sig
val compile : (tysymbol -> lsymbol list) ->
term list -> (pattern list * term) list -> term
end
module CompileFmla : sig
val compile : (tysymbol -> lsymbol list) ->
term list -> (pattern list * fmla) list -> fmla
end
src/core/pretty.ml
View file @ 903df0ef
......@@ -246,7 +246,7 @@ and print_tnode pri fmt t = match t.t_node with
fprintf fmt "match @[%a@] with@\n@[<hov>%a@]@\nend"
print_term t1 (print_list newline print_tbranch) bl
| Teps fb ->
let v,f = f_open_bound fb in
let v,f = t_open_bound fb in
fprintf fmt (protect_on (pri > 0) "epsilon %a.@ %a")
print_vsty v print_fmla f;
forget_var v
......@@ -274,7 +274,7 @@ and print_fnode pri fmt f = match f.t_node with
fprintf fmt (protect_on (pri > 0) "if @[%a@] then %a@ else %a")
print_fmla f1 print_fmla f2 print_fmla f3
| Tlet (t,f) ->
let v,f = f_open_bound f in
let v,f = t_open_bound f in
fprintf fmt (protect_on (pri > 0) "let %a = @[%a@] in@ %a")
print_vs v (print_lterm 4) t print_fmla f;
forget_var v
......@@ -289,7 +289,7 @@ and print_tbranch fmt br =
Svs.iter forget_var p.pat_vars
and print_fbranch fmt br =
let p,f = f_open_branch br in
let p,f = t_open_branch br in
fprintf fmt "@[<hov 4>| %a ->@ %a@]" print_pat p print_fmla f;
Svs.iter forget_var p.pat_vars
......@@ -297,7 +297,7 @@ and print_tl fmt tl =
if tl = [] then () else fprintf fmt "@ [%a]"
(print_list alt (print_list comma print_expr)) tl
and print_expr fmt = e_apply (print_term fmt) (print_fmla fmt)
and print_expr fmt = e_map (print_term fmt) (print_fmla fmt)
(** Declarations *)
......
src/core/term.ml
View file @ 903df0ef
This diff is collapsed.
src/core/term.mli
View file @ 903df0ef
......@@ -158,8 +158,7 @@ and fmla_bound = term_bound
and term_branch
and fmla_branch = term_branch
and term_quant
and fmla_quant = term_quant
and fmla_quant
and trigger = expr list
......@@ -167,38 +166,21 @@ module Mterm : Map.S with type key = term
module Sterm : Mterm.Set
module Hterm : Hashtbl.S with type key = term
module Mfmla : Map.S with type key = fmla
module Sfmla : Mfmla.Set
module Hfmla : Hashtbl.S with type key = fmla
val t_equal : term -> term -> bool
val f_equal : fmla -> fmla -> bool
val e_equal : expr -> expr -> bool
val t_hash : term -> int
val tr_equal : trigger list -> trigger list -> bool
val t_hash : term -> int
val f_hash : fmla -> int
val e_hash : expr -> int
(** close bindings *)
val t_close_bound : vsymbol -> term -> term_bound
val f_close_bound : vsymbol -> fmla -> fmla_bound
val t_close_branch : pattern -> term -> term_branch
val f_close_branch : pattern -> fmla -> fmla_branch
val f_close_quant : vsymbol list -> trigger list -> fmla -> fmla_quant
(** open bindings *)
val t_open_bound : term_bound -> vsymbol * term
val f_open_bound : fmla_bound -> vsymbol * fmla
val t_open_branch : term_branch -> pattern * term
val f_open_branch : fmla_branch -> pattern * fmla
val f_open_quant : fmla_quant -> vsymbol list * trigger list * fmla
val f_open_forall : fmla -> vsymbol list * fmla
......@@ -209,15 +191,9 @@ val f_open_exists : fmla -> vsymbol list * fmla
val t_open_bound_cb :
term_bound -> vsymbol * term * (vsymbol -> term -> term_bound)
val f_open_bound_cb :
fmla_bound -> vsymbol * fmla * (vsymbol -> fmla -> fmla_bound)
val t_open_branch_cb :
term_branch -> pattern * term * (pattern -> term -> term_branch)
val f_open_branch_cb :
fmla_branch -> pattern * fmla * (pattern -> fmla -> fmla_branch)
val f_open_quant_cb :
fmla_quant -> vsymbol list * trigger list * fmla *
(vsymbol list -> trigger list -> fmla -> fmla_quant)
......@@ -234,35 +210,27 @@ val ps_app_inst : lsymbol -> term list -> ty Mtv.t
exception TermExpected of term
exception FmlaExpected of term
val e_app : lsymbol -> term list -> oty -> term
val t_type : term -> ty
val t_prop : term -> term
val check_t_ty : oty -> term -> unit
(** Smart constructors for term *)
(** Smart constructors for terms and formulas *)
val e_app : lsymbol -> term list -> oty -> term
val t_app : lsymbol -> term list -> ty -> term
val f_app : lsymbol -> term list -> fmla
val t_app_infer : lsymbol -> term list -> term
val t_var : vsymbol -> term
val t_const : constant -> term
val t_int_const : string -> term
val t_real_const : real_constant -> term
val t_app : lsymbol -> term list -> ty -> term
val t_if : fmla -> term -> term -> term
val t_let : term -> term_bound -> term
val t_case : term -> term_branch list -> term
val t_eps : fmla_bound -> term
val t_let_close : vsymbol -> term -> term -> term
val t_eps_close : vsymbol -> fmla -> term
val t_app_infer : lsymbol -> term list -> term
val t_label : ?loc:Loc.position -> label list -> term -> term
val t_label_add : label -> term -> term
val t_label_copy : term -> term -> term
(** Smart constructors for fmla *)
val f_app : lsymbol -> term list -> fmla
val f_quant : quant -> fmla_quant -> fmla
val f_forall : fmla_quant -> fmla
val f_exists : fmla_quant -> fmla
......@@ -274,18 +242,17 @@ val f_iff : fmla -> fmla -> fmla
val f_not : fmla -> fmla
val f_true : fmla
val f_false : fmla
val f_if : fmla -> fmla -> fmla -> fmla
val f_let : term -> fmla_bound -> fmla
val f_case : term -> fmla_branch list -> fmla
val f_let_close : vsymbol -> term -> fmla -> fmla
val t_let_close : vsymbol -> term -> term -> term
val t_eps_close : vsymbol -> fmla -> term
val f_quant_close : quant -> vsymbol list -> trigger list -> fmla -> fmla
val f_forall_close : vsymbol list -> trigger list -> fmla -> fmla
val f_exists_close : vsymbol list -> trigger list -> fmla -> fmla
val f_label : ?loc:Loc.position -> label list -> fmla -> fmla
val f_label_add : label -> fmla -> fmla
val f_label_copy : fmla -> fmla -> fmla
val t_label : ?loc:Loc.position -> label list -> term -> term
val t_label_add : label -> term -> term
val t_label_copy : term -> term -> term
(** Constructors with propositional simplification *)
......@@ -301,12 +268,9 @@ val f_implies_simp : fmla -> fmla -> fmla
val f_iff_simp : fmla -> fmla -> fmla
val f_not_simp : fmla -> fmla
val t_if_simp : fmla -> term -> term -> term
val f_if_simp : fmla -> fmla -> fmla -> fmla
val t_let_simp : term -> term_bound -> term
val f_let_simp : term -> fmla_bound -> fmla
val t_let_close_simp : vsymbol -> term -> term -> term
val f_let_close_simp : vsymbol -> term -> fmla -> fmla
val f_quant_close_simp : quant -> vsymbol list -> trigger list -> fmla -> fmla
val f_forall_close_simp : vsymbol list -> trigger list -> fmla -> fmla
val f_exists_close_simp : vsymbol list -> trigger list -> fmla -> fmla
......@@ -316,14 +280,12 @@ val f_forall_close_merge : vsymbol list -> fmla -> fmla
merges variable lists if [f] is already universally quantified;
reuses triggers of [f], if any, otherwise puts no triggers. *)
(** Expr and trigger traversal *)
(** Term/formula dispatch *)
val e_map : (term -> term) -> (fmla -> fmla) -> expr -> expr
val e_map : (term -> 'a) -> (fmla -> 'a) -> expr -> 'a
val e_fold : ('a -> term -> 'b) -> ('a -> fmla -> 'b) -> 'a -> expr -> 'b
val e_apply : (term -> 'a) -> (fmla -> 'a) -> expr -> 'a
val e_map_fold : ('a -> term -> 'a * term) ->
('a -> fmla -> 'a * fmla) -> 'a -> expr -> 'a * expr
(** Trigger traversal *)
val tr_map : (term -> term) ->
(fmla -> fmla) -> trigger list -> trigger list
......@@ -337,28 +299,20 @@ val tr_map_fold : ('a -> term -> 'a * term) -> ('a -> fmla -> 'a * fmla) ->
(** map/fold over symbols *)
val t_s_map : (tysymbol -> tysymbol) -> (lsymbol -> lsymbol) -> term -> term
val f_s_map : (tysymbol -> tysymbol) -> (lsymbol -> lsymbol) -> fmla -> fmla
val t_s_fold :
('a -> tysymbol -> 'a) -> ('a -> lsymbol -> 'a) -> 'a -> term -> 'a
val f_s_fold :
('a -> tysymbol -> 'a) -> ('a -> lsymbol -> 'a) -> 'a -> fmla -> 'a
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
(** fold over types in terms and formulas *)
val t_ty_fold : ('a -> ty -> 'a) -> 'a -> term -> 'a
val f_ty_fold : ('a -> ty -> 'a) -> 'a -> fmla -> 'a
(* fold over applications in terms and formulas (but not in patterns!) *)
val t_app_fold : ('a -> lsymbol -> ty list -> oty -> 'a) -> 'a -> term -> 'a
val f_app_fold : ('a -> lsymbol -> ty list -> oty -> 'a) -> 'a -> fmla -> 'a
(** built-in symbols *)
......@@ -392,9 +346,6 @@ val is_fs_tuple : lsymbol -> bool
val t_map : (term -> term) -> (fmla -> fmla) -> term -> term
(** [t_map fnT fnF t] applies function fnT, resp. fnF, to
each immediate subterms, resp. sub-formula, of [t] *)
val f_map : (term -> term) -> (fmla -> fmla) -> fmla -> fmla
(** [f_map fnT fnF f] applies function fnT, resp. fnF, to
each immediate subterms, resp. sub-formula, of [t] *)
val f_map_sign : (term -> term) -> (bool -> fmla -> fmla) ->
bool -> fmla -> fmla
......@@ -405,30 +356,18 @@ val f_map_sign : (term -> term) -> (bool -> fmla -> fmla) ->
nb: if-then-else and iff are translated if needed *)
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 t_all : (term -> bool) -> (fmla -> bool) -> term -> bool
val f_all : (term -> bool) -> (fmla -> bool) -> fmla -> bool
val t_any : (term -> bool) -> (fmla -> bool) -> term -> bool
val f_any : (term -> bool) -> (fmla -> bool) -> fmla -> bool
val t_map_fold : ('a -> term -> 'a * term) ->
('a -> fmla -> 'a * fmla) -> 'a -> term -> 'a * term
val f_map_fold : ('a -> term -> 'a * term) ->
('a -> fmla -> 'a * fmla) -> 'a -> fmla -> 'a * fmla
(** continuation-passing map *)
val t_map_cont : ((term -> 'a) -> term -> 'a) ->
((fmla -> 'a) -> fmla -> 'a) -> (term -> 'a) -> term -> 'a
val f_map_cont : ((term -> 'a) -> term -> 'a) ->
((fmla -> 'a) -> fmla -> 'a) -> (fmla -> 'a) -> fmla -> 'a
val e_map_cont : ((term -> 'a) -> term -> 'b) ->
((fmla -> 'a) -> fmla -> 'b) -> (expr -> 'a) -> expr -> 'b
val list_map_cont : (('a -> 'b) -> 'c -> 'b) ->
('a list -> 'b) -> 'c list -> 'b
......@@ -439,81 +378,49 @@ val f_map_simp : (term -> term) -> (fmla -> fmla) -> fmla -> fmla
(** map/fold over free variables *)
val t_v_map : (vsymbol -> term) -> term -> term
val f_v_map : (vsymbol -> term) -> fmla -> fmla
val t_v_fold : ('a -> vsymbol -> 'a) -> 'a -> term -> 'a
val f_v_fold : ('a -> vsymbol -> 'a) -> 'a -> fmla -> 'a
val t_v_all : (vsymbol -> bool) -> term -> bool
val f_v_all : (vsymbol -> bool) -> fmla -> bool
val t_v_any : (vsymbol -> bool) -> term -> bool
val f_v_any : (vsymbol -> bool) -> fmla -> bool
(** variable occurrence check *)
val t_occurs : Svs.t -> term -> bool
val f_occurs : Svs.t -> fmla -> bool
val t_occurs_single : vsymbol -> term -> bool
val f_occurs_single : vsymbol -> fmla -> bool
(** substitution for variables *)
val t_subst : term Mvs.t -> term -> term
val f_subst : term Mvs.t -> fmla -> fmla
val t_subst_single : vsymbol -> term -> term -> term
val f_subst_single : vsymbol -> term -> fmla -> fmla
val t_ty_subst : ty Mtv.t -> term Mvs.t -> term -> term
val f_ty_subst : ty Mtv.t -> term Mvs.t -> fmla -> fmla
(** set of free variables *)
val t_freevars : Svs.t -> term -> Svs.t
val f_freevars : Svs.t -> fmla -> Svs.t
(** set of free type variables *)
val t_ty_freevars : Stv.t -> term -> Stv.t
val f_ty_freevars : Stv.t -> fmla -> Stv.t
(** equality modulo alpha *)
val t_equal_alpha : term -> term -> bool
val f_equal_alpha : fmla -> fmla -> bool
module Hterm_alpha : Hashtbl.S with type key = term
module Hfmla_alpha : Hashtbl.S with type key = fmla
(** occurrence check *)
val t_occurs_term : term -> term -> bool
val f_occurs_term : term -> fmla -> bool
val t_occurs_fmla : fmla -> term -> bool
val f_occurs_fmla : fmla -> fmla -> bool
val t_occurs_term_alpha : term -> term -> bool
val f_occurs_term_alpha : term -> fmla -> bool
val t_occurs_fmla_alpha : fmla -> term -> bool
val f_occurs_fmla_alpha : fmla -> fmla -> bool
(** term/fmla replacement *)
val t_subst_term : term -> term -> term -> term
val f_subst_term : term -> term -> fmla -> fmla
val t_subst_fmla : fmla -> fmla -> term -> term
val f_subst_fmla : fmla -> fmla -> fmla -> fmla
val t_subst_term_alpha : term -> term -> term -> term
val f_subst_term_alpha : term -> term -> fmla -> fmla
val t_subst_fmla_alpha : fmla -> fmla -> term -> term
val f_subst_fmla_alpha : fmla -> fmla -> fmla -> fmla
(** binder-free term/fmla matching *)
exception NoMatch
val t_match : term Mvs.t -> term -> term -> term Mvs.t
val f_match : term Mvs.t -> fmla -> fmla -> term Mvs.t
src/core/theory.ml
View file @ 903df0ef
......@@ -459,7 +459,7 @@ let cl_find_ls cl ls =
cl.ls_table <- Mls.add ls ls' cl.ls_table;
ls'
let cl_trans_fmla cl f = f_s_map (cl_find_ts cl) (cl_find_ls cl) f
let cl_trans_fmla cl f = t_s_map (cl_find_ts cl) (cl_find_ls cl) f
let cl_find_pr cl pr =
if not (Sid.mem pr.pr_name cl.cl_local) then pr
......
src/parser/denv.ml
View file @ 903df0ef
......@@ -236,7 +236,7 @@ and fmla env = function
| Fbinop (op, f1, f2) ->
f_binary op (fmla env f1) (fmla env f2)
| Fif (f1, f2, f3) ->
f_if (fmla env f1) (fmla env f2) (fmla env f3)
t_if (fmla env f1) (fmla env f2) (fmla env f3)
| Fquant (q, uqu, trl, f1) ->
let uquant env (id,ty) =
let v = create_user_vs id (ty_of_dty ty) in
......@@ -256,17 +256,17 @@ and fmla env = function
let v = create_user_vs id (t_type e1) in
let env = Mstr.add id.id v env in
let f2 = fmla env f2 in
f_let_close v e1 f2
t_let_close v e1 f2
| Fmatch (t, bl) ->
let branch (p,e) =
let env, p = pattern env p in f_close_branch p (fmla env e)
let env, p = pattern env p in t_close_branch p (fmla env e)
in
f_case (term env t) (List.map branch bl)
t_case (term env t) (List.map branch bl)
| (Fnamed _) as f ->
let rec collect p ll = function
| Fnamed (Lstr l, e) -> collect p (l::ll) e
| Fnamed (Lpos p, e) -> collect (Some p) ll e
| e -> f_label ?loc:p ll (fmla env e)
| e -> t_label ?loc:p ll (fmla env e)
in
collect None [] f
| Fvar f ->
......@@ -345,7 +345,7 @@ and specialize_term_node ~loc htv = function
in
Tmatch (specialize_term ~loc htv t1, List.map branch bl)
| Term.Teps fb ->
let v, f = f_open_bound fb in
let v, f = t_open_bound fb in
Teps (ident_of_vs ~loc v, specialize_ty ~loc htv v.vs_ty,
specialize_fmla ~loc htv f)
| Term.Fquant _ | Term.Fbinop _ | Term.Fnot _
......@@ -376,11 +376,11 @@ and specialize_fmla_node ~loc htv = function
Fif (specialize_fmla ~loc htv f1,
specialize_fmla ~loc htv f2, specialize_fmla ~loc htv f3)
| Term.Tlet (t1, f2b) ->
let v, f2 = f_open_bound f2b in
let v, f2 = t_open_bound f2b in