Commit d1a5ec78 authored by Andrei Paskevich's avatar Andrei Paskevich

silence Z warnings and fix a couple of nasty bugs in the meantime

parent 1a166dae
...@@ -59,8 +59,8 @@ OCAMLVERSION = @OCAMLVERSION@ ...@@ -59,8 +59,8 @@ OCAMLVERSION = @OCAMLVERSION@
#PSVIEWER = @PSVIEWER@ #PSVIEWER = @PSVIEWER@
#PDFVIEWER = @PDFVIEWER@ #PDFVIEWER = @PDFVIEWER@
BFLAGS = -w Ae -warn-error Z -dtypes -g -I src $(INCLUDES) BFLAGS = -w Ae -dtypes -g -I src $(INCLUDES)
OFLAGS = -w Ae -warn-error Z -dtypes -I src $(INCLUDES) OFLAGS = -w Ae -dtypes -I src $(INCLUDES)
# external libraries common to all binaries # external libraries common to all binaries
......
...@@ -271,7 +271,7 @@ and tr_global_ts env r = ...@@ -271,7 +271,7 @@ and tr_global_ts env r =
with Not_found -> with Not_found ->
add_global global_ts r None; add_global global_ts r None;
match r with match r with
| VarRef id -> | VarRef _id ->
assert false (*TODO*) assert false (*TODO*)
| ConstructRef _ -> | ConstructRef _ ->
assert false assert false
......
...@@ -58,16 +58,8 @@ let make_ls_defn ls vl = e_apply (make_fs_defn ls vl) (make_ps_defn ls vl) ...@@ -58,16 +58,8 @@ let make_ls_defn ls vl = e_apply (make_fs_defn ls vl) (make_ps_defn ls vl)
let open_ls_defn (_,f) = let open_ls_defn (_,f) =
let vl, ef = f_open_forall f in let vl, ef = f_open_forall f in
match ef.f_node with match ef.f_node with
| Fapp (s, [t1; t2]) when s == ps_equ -> | Fapp (_, [_; t2]) -> vl, Term t2
begin match t1.t_node with | Fbinop (_, _, f2) -> vl, Fmla f2
| Tapp (fs, _) -> vl, Term t2
| _ -> assert false
end
| Fbinop (Fiff, f1, f2) ->
begin match f1.f_node with
| Fapp (ps, _) -> vl, Fmla f2
| _ -> assert false
end
| _ -> assert false | _ -> assert false
let open_fs_defn ld = let vl,e = open_ls_defn ld in let open_fs_defn ld = let vl,e = open_ls_defn ld in
...@@ -137,7 +129,7 @@ module Hsdecl = Hashcons.Make (struct ...@@ -137,7 +129,7 @@ module Hsdecl = Hashcons.Make (struct
| None, None -> true | None, None -> true
| _ -> false | _ -> false
let eq_iax (pr1,fr1) (pr2,fr2) = pr1 == pr1 && fr1 == fr2 let eq_iax (pr1,fr1) (pr2,fr2) = pr1 == pr2 && fr1 == fr2
let eq_ind (ps1,al1) (ps2,al2) = ps1 == ps2 && list_all2 eq_iax al1 al2 let eq_ind (ps1,al1) (ps2,al2) = ps1 == ps2 && list_all2 eq_iax al1 al2
...@@ -507,7 +499,7 @@ let find_prop kn pr = ...@@ -507,7 +499,7 @@ let find_prop kn pr =
| Dind dl -> | Dind dl ->
let test (_,l) = List.mem_assq pr l in let test (_,l) = List.mem_assq pr l in
List.assq pr (snd (List.find test dl)) List.assq pr (snd (List.find test dl))
| Dprop (_,pr,f) -> f | Dprop (_,_,f) -> f
| _ -> assert false | _ -> assert false
exception NonExhaustiveExpr of (pattern list * expr) exception NonExhaustiveExpr of (pattern list * expr)
......
...@@ -294,10 +294,7 @@ module Hsterm = Hashcons.Make (struct ...@@ -294,10 +294,7 @@ module Hsterm = Hashcons.Make (struct
| Tvar v1, Tvar v2 -> v1 == v2 | Tvar v1, Tvar v2 -> v1 == v2
| Tconst c1, Tconst c2 -> c1 = c2 | Tconst c1, Tconst c2 -> c1 = c2
| Tapp (s1, l1), Tapp (s2, l2) -> s1 == s2 && List.for_all2 (==) l1 l2 | Tapp (s1, l1), Tapp (s2, l2) -> s1 == s2 && List.for_all2 (==) l1 l2
(* Claude: en voila un beau bug | Tif (f1, t1, e1), Tif (f2, t2, e2) -> f1 == f2 && t1 == t2 && e1 == e2
j'espere que cela convaincra les developpeurs
de Why3 de compiler avec l'option -w Z !!! *)
| Tif (f1, t1, e1), Tif (f2, t2, e2) -> f1 == f2 && t1 == t2 && e2 == e2
| Tlet (t1, b1), Tlet (t2, b2) -> t1 == t2 && t_eq_bound b1 b2 | Tlet (t1, b1), Tlet (t2, b2) -> t1 == t2 && t_eq_bound b1 b2
| Tcase (tl1, bl1), Tcase (tl2, bl2) -> | Tcase (tl1, bl1), Tcase (tl2, bl2) ->
list_all2 (==) tl1 tl2 && list_all2 t_eq_branch bl1 bl2 list_all2 (==) tl1 tl2 && list_all2 t_eq_branch bl1 bl2
...@@ -536,22 +533,22 @@ let brlvl fn lvl acc (_, nv, t) = fn (lvl + nv) acc t ...@@ -536,22 +533,22 @@ let brlvl fn lvl acc (_, nv, t) = fn (lvl + nv) acc t
let t_fold_unsafe fnT fnF lvl acc t = match t.t_node with let t_fold_unsafe fnT fnF lvl acc t = match t.t_node with
| Tbvar n when n >= lvl -> raise UnboundIndex | Tbvar n when n >= lvl -> raise UnboundIndex
| Tbvar _ | Tvar _ | Tconst _ -> acc | Tbvar _ | Tvar _ | Tconst _ -> acc
| Tapp (f, tl) -> List.fold_left (fnT lvl) acc tl | Tapp (_, tl) -> List.fold_left (fnT lvl) acc tl
| Tif (f, t1, t2) -> fnT lvl (fnT lvl (fnF lvl acc f) t1) t2 | Tif (f, t1, t2) -> fnT lvl (fnT lvl (fnF lvl acc f) t1) t2
| Tlet (t1, (u, t2)) -> fnT (lvl + 1) (fnT lvl acc t1) t2 | Tlet (t1, (_, t2)) -> fnT (lvl + 1) (fnT lvl acc t1) t2
| Tcase (tl, bl) -> | Tcase (tl, bl) ->
List.fold_left (brlvl fnT lvl) (List.fold_left (fnT lvl) acc tl) bl List.fold_left (brlvl fnT lvl) (List.fold_left (fnT lvl) acc tl) bl
| Teps (u, f) -> fnF (lvl + 1) acc f | Teps (_, f) -> fnF (lvl + 1) acc f
let f_fold_unsafe fnT fnF lvl acc f = match f.f_node with let f_fold_unsafe fnT fnF lvl acc f = match f.f_node with
| Fapp (p, tl) -> List.fold_left (fnT lvl) acc tl | Fapp (_, tl) -> List.fold_left (fnT lvl) acc tl
| Fquant (q, (vl, nv, tl, f1)) -> let lvl = lvl + nv in | Fquant (_, (_, nv, tl, f1)) -> let lvl = lvl + nv in
tr_fold (fnT lvl) (fnF lvl) (fnF lvl acc f1) tl tr_fold (fnT lvl) (fnF lvl) (fnF lvl acc f1) tl
| Fbinop (op, f1, f2) -> fnF lvl (fnF lvl acc f1) f2 | Fbinop (_, f1, f2) -> fnF lvl (fnF lvl acc f1) f2
| Fnot f1 -> fnF lvl acc f1 | Fnot f1 -> fnF lvl acc f1
| Ftrue | Ffalse -> acc | Ftrue | Ffalse -> acc
| Fif (f1, f2, f3) -> fnF lvl (fnF lvl (fnF lvl acc f1) f2) f3 | Fif (f1, f2, f3) -> fnF lvl (fnF lvl (fnF lvl acc f1) f2) f3
| Flet (t, (u, f1)) -> fnF (lvl + 1) (fnT lvl acc t) f1 | Flet (t, (_, f1)) -> fnF (lvl + 1) (fnT lvl acc t) f1
| Fcase (tl, bl) -> | Fcase (tl, bl) ->
List.fold_left (brlvl fnF lvl) (List.fold_left (fnT lvl) acc tl) bl List.fold_left (brlvl fnF lvl) (List.fold_left (fnT lvl) acc tl) bl
...@@ -732,10 +729,10 @@ and f_s_fold fnT fnL acc f = ...@@ -732,10 +729,10 @@ and f_s_fold fnT fnL acc f =
let fn_v acc u = ty_s_fold fnT acc u.vs_ty in let fn_v acc u = ty_s_fold fnT acc u.vs_ty in
match f.f_node with match f.f_node with
| Fapp (p, tl) -> List.fold_left fn_t (fnL acc p) tl | Fapp (p, tl) -> List.fold_left fn_t (fnL acc p) tl
| Fquant (q, (vl,_,tl,f1)) -> | Fquant (_, (vl,_,tl,f1)) ->
let acc = List.fold_left fn_v acc vl in let acc = List.fold_left fn_v acc vl in
fn_f (tr_fold fn_t fn_f acc tl) f1 fn_f (tr_fold fn_t fn_f acc tl) f1
| Fbinop (op, f1, f2) -> fn_f (fn_f acc f1) f2 | Fbinop (_, f1, f2) -> fn_f (fn_f acc f1) f2
| Fnot f1 -> fn_f acc f1 | Fnot f1 -> fn_f acc f1
| Ftrue | Ffalse -> acc | Ftrue | Ffalse -> acc
| Fif (f1, f2, f3) -> fn_f (fn_f (fn_f acc f1) f2) f3 | Fif (f1, f2, f3) -> fn_f (fn_f (fn_f acc f1) f2) f3
...@@ -964,7 +961,7 @@ let f_branch fn acc b = let _,f = f_open_branch b in fn acc f ...@@ -964,7 +961,7 @@ let f_branch fn acc b = let _,f = f_open_branch b in fn acc f
let t_fold fnT fnF acc t = match t.t_node with let t_fold fnT fnF acc t = match t.t_node with
| Tbvar _ -> raise UnboundIndex | Tbvar _ -> raise UnboundIndex
| Tvar _ | Tconst _ -> acc | Tvar _ | Tconst _ -> acc
| Tapp (f, tl) -> List.fold_left fnT acc tl | Tapp (_, tl) -> List.fold_left fnT acc tl
| Tif (f, t1, t2) -> fnT (fnT (fnF acc f) t1) t2 | Tif (f, t1, t2) -> fnT (fnT (fnF acc f) t1) t2
| Tlet (t1, b) -> let _,t2 = t_open_bound b in fnT (fnT acc t1) t2 | Tlet (t1, b) -> let _,t2 = t_open_bound b in fnT (fnT acc t1) t2
| Tcase (tl, bl) -> | Tcase (tl, bl) ->
...@@ -972,10 +969,10 @@ let t_fold fnT fnF acc t = match t.t_node with ...@@ -972,10 +969,10 @@ let t_fold fnT fnF acc t = match t.t_node with
| Teps b -> let _,f = f_open_bound b in fnF acc f | Teps b -> let _,f = f_open_bound b in fnF acc f
let f_fold fnT fnF acc f = match f.f_node with let f_fold fnT fnF acc f = match f.f_node with
| Fapp (p, tl) -> List.fold_left fnT acc tl | Fapp (_, tl) -> List.fold_left fnT acc tl
| Fquant (q, b) -> let vl, tl, f1 = f_open_quant b in | Fquant (_, b) -> let _, tl, f1 = f_open_quant b in
tr_fold fnT fnF (fnF acc f1) tl tr_fold fnT fnF (fnF acc f1) tl
| Fbinop (op, f1, f2) -> fnF (fnF acc f1) f2 | Fbinop (_, f1, f2) -> fnF (fnF acc f1) f2
| Fnot f1 -> fnF acc f1 | Fnot f1 -> fnF acc f1
| Ftrue | Ffalse -> acc | Ftrue | Ffalse -> acc
| Fif (f1, f2, f3) -> fnF (fnF (fnF acc f1) f2) f3 | Fif (f1, f2, f3) -> fnF (fnF (fnF acc f1) f2) f3
...@@ -1043,8 +1040,8 @@ let f_subst_single v t1 f = f_v_map (eq_vs v t1) f ...@@ -1043,8 +1040,8 @@ let f_subst_single v t1 f = f_v_map (eq_vs v t1) f
(* set of free variables *) (* set of free variables *)
let t_freevars s t = t_v_fold (fun s u -> Svs.add u s) Svs.empty t let t_freevars s t = t_v_fold (fun s u -> Svs.add u s) s t
let f_freevars s f = f_v_fold (fun s u -> Svs.add u s) Svs.empty f let f_freevars s f = f_v_fold (fun s u -> Svs.add u s) s f
(* equality modulo alpha *) (* equality modulo alpha *)
...@@ -1063,15 +1060,15 @@ let rec t_equal_alpha t1 t2 = ...@@ -1063,15 +1060,15 @@ let rec t_equal_alpha t1 t2 =
| Tif (f1, t1, e1), Tif (f2, t2, e2) -> | Tif (f1, t1, e1), Tif (f2, t2, e2) ->
f_equal_alpha f1 f2 && t_equal_alpha t1 t2 && t_equal_alpha e1 e2 f_equal_alpha f1 f2 && t_equal_alpha t1 t2 && t_equal_alpha e1 e2
| Tlet (t1, tb1), Tlet (t2, tb2) -> | Tlet (t1, tb1), Tlet (t2, tb2) ->
let v1, b1 = tb1 in let _, b1 = tb1 in
let v2, b2 = tb2 in let _, b2 = tb2 in
t_equal_alpha t1 t2 && t_equal_alpha b1 b2 t_equal_alpha t1 t2 && t_equal_alpha b1 b2
| Tcase (tl1, bl1), Tcase (tl2, bl2) -> | Tcase (tl1, bl1), Tcase (tl2, bl2) ->
list_all2 t_equal_alpha tl1 tl2 && list_all2 t_equal_alpha tl1 tl2 &&
list_all2 t_equal_branch_alpha bl1 bl2 list_all2 t_equal_branch_alpha bl1 bl2
| Teps fb1, Teps fb2 -> | Teps fb1, Teps fb2 ->
let v1, f1 = fb1 in let _, f1 = fb1 in
let v2, f2 = fb2 in let _, f2 = fb2 in
f_equal_alpha f1 f2 f_equal_alpha f1 f2
| _ -> false | _ -> false
...@@ -1092,8 +1089,8 @@ and f_equal_alpha f1 f2 = ...@@ -1092,8 +1089,8 @@ and f_equal_alpha f1 f2 =
| Fif (f1, g1, h1), Fif (f2, g2, h2) -> | Fif (f1, g1, h1), Fif (f2, g2, h2) ->
f_equal_alpha f1 f2 && f_equal_alpha g1 g2 && f_equal_alpha h1 h2 f_equal_alpha f1 f2 && f_equal_alpha g1 g2 && f_equal_alpha h1 h2
| Flet (t1, fb1), Flet (t2, fb2) -> | Flet (t1, fb1), Flet (t2, fb2) ->
let v1, f1 = fb1 in let _, f1 = fb1 in
let v2, f2 = fb2 in let _, f2 = fb2 in
t_equal_alpha t1 t2 && f_equal_alpha f1 f2 t_equal_alpha t1 t2 && f_equal_alpha f1 f2
| Fcase (tl1, bl1), Fcase (tl2, bl2) -> | Fcase (tl1, bl1), Fcase (tl2, bl2) ->
list_all2 t_equal_alpha tl1 tl2 && list_all2 t_equal_alpha tl1 tl2 &&
...@@ -1145,16 +1142,16 @@ let rec t_match s t1 t2 = ...@@ -1145,16 +1142,16 @@ let rec t_match s t1 t2 =
| Tif (f1, t1, e1), Tif (f2, t2, e2) -> | Tif (f1, t1, e1), Tif (f2, t2, e2) ->
t_match (t_match (f_match s f1 f2) t1 t2) e1 e2 t_match (t_match (f_match s f1 f2) t1 t2) e1 e2
| Tlet (t1, tb1), Tlet (t2, tb2) -> | Tlet (t1, tb1), Tlet (t2, tb2) ->
let v1, b1 = tb1 in let _, b1 = tb1 in
let v2, b2 = tb2 in let _, b2 = tb2 in
t_match (t_match s t1 t2) b1 b2 t_match (t_match s t1 t2) b1 b2
| Tcase (tl1, bl1), Tcase (tl2, bl2) -> | Tcase (tl1, bl1), Tcase (tl2, bl2) ->
(try List.fold_left2 t_match_branch (try List.fold_left2 t_match_branch
(List.fold_left2 t_match s tl1 tl2) bl1 bl2 (List.fold_left2 t_match s tl1 tl2) bl1 bl2
with Invalid_argument _ -> raise NoMatch) with Invalid_argument _ -> raise NoMatch)
| Teps fb1, Teps fb2 -> | Teps fb1, Teps fb2 ->
let v1, f1 = fb1 in let _, f1 = fb1 in
let v2, f2 = fb2 in let _, f2 = fb2 in
f_match s f1 f2 f_match s f1 f2
| _ -> raise NoMatch | _ -> raise NoMatch
...@@ -1175,8 +1172,8 @@ and f_match s f1 f2 = ...@@ -1175,8 +1172,8 @@ and f_match s f1 f2 =
| Fif (f1, g1, h1), Fif (f2, g2, h2) -> | Fif (f1, g1, h1), Fif (f2, g2, h2) ->
f_match (f_match (f_match s f1 f2) g1 g2) h1 h2 f_match (f_match (f_match s f1 f2) g1 g2) h1 h2
| Flet (t1, fb1), Flet (t2, fb2) -> | Flet (t1, fb1), Flet (t2, fb2) ->
let v1, f1 = fb1 in let _, f1 = fb1 in
let v2, f2 = fb2 in let _, f2 = fb2 in
f_match (t_match s t1 t2) f1 f2 f_match (t_match s t1 t2) f1 f2
| Fcase (tl1, bl1), Fcase (tl2, bl2) -> | Fcase (tl1, bl1), Fcase (tl2, bl2) ->
(try List.fold_left2 f_match_branch (try List.fold_left2 f_match_branch
......
...@@ -171,7 +171,7 @@ let treat_result pr (t,c,outerr) = ...@@ -171,7 +171,7 @@ let treat_result pr (t,c,outerr) =
here or in the use of why_cpulimit *) here or in the use of why_cpulimit *)
Timeout Timeout
| Unix.WSTOPPED _ | Unix.WSIGNALED _ -> HighFailure | Unix.WSTOPPED _ | Unix.WSIGNALED _ -> HighFailure
| Unix.WEXITED c -> | Unix.WEXITED _ ->
let rec greps res = function let rec greps res = function
| [] -> HighFailure | [] -> HighFailure
| (r,pa)::l -> | (r,pa)::l ->
......
...@@ -289,7 +289,7 @@ let load_rules env (premap,tmap) {thr_name = loc,qualid; thr_rules = trl} = ...@@ -289,7 +289,7 @@ let load_rules env (premap,tmap) {thr_name = loc,qualid; thr_rules = trl} =
with Not_found -> errorm ~loc "Unknown proposition %s" with Not_found -> errorm ~loc "Unknown proposition %s"
(string_of_qualid qualid q) (string_of_qualid qualid q)
end end
| Rprelude (loc,s) -> | Rprelude (_loc,s) ->
let l = let l =
try Mid.find th.th_name premap try Mid.find th.th_name premap
with Not_found -> [] with Not_found -> []
...@@ -435,7 +435,7 @@ let file_printer = ...@@ -435,7 +435,7 @@ let file_printer =
[] []
let call_prover_on_file ?debug ?timeout drv filename = let call_prover_on_file ?debug ?timeout drv filename =
Call_provers.on_file drv.drv_prover filename Call_provers.on_file ?debug ?timeout drv.drv_prover filename
let call_prover_on_formatter ?debug ?timeout ?filename drv ib = let call_prover_on_formatter ?debug ?timeout ?filename drv ib =
Call_provers.on_formatter ?debug ?timeout ?filename drv.drv_prover ib Call_provers.on_formatter ?debug ?timeout ?filename drv.drv_prover ib
let call_prover_on_buffer ?debug ?timeout ?filename drv ib = let call_prover_on_buffer ?debug ?timeout ?filename drv ib =
......
...@@ -197,7 +197,7 @@ let print_th_namespace fmt th = ...@@ -197,7 +197,7 @@ let print_th_namespace fmt th =
let fname_printer = ref (Ident.create_ident_printer []) let fname_printer = ref (Ident.create_ident_printer [])
let do_task env drv fname tname (th : Why.Theory.theory) (task : Task.task) = let do_task _env drv fname tname (th : Why.Theory.theory) (task : Task.task) =
if !opt_prove then begin if !opt_prove then begin
let res = Driver.call_prover ~debug:!opt_debug ?timeout drv task in let res = Driver.call_prover ~debug:!opt_debug ?timeout drv task in
printf "%s %s %s : %a@." fname tname printf "%s %s %s : %a@." fname tname
......
...@@ -217,7 +217,7 @@ let find_lsymbol q uc = find_lsymbol_ns q (get_namespace uc) ...@@ -217,7 +217,7 @@ let find_lsymbol q uc = find_lsymbol_ns q (get_namespace uc)
let specialize_lsymbol p uc = let specialize_lsymbol p uc =
let s = find_lsymbol p uc in let s = find_lsymbol p uc in
s, specialize_lsymbol (qloc p) s s, specialize_lsymbol ~loc:(qloc p) s
let specialize_fsymbol p uc = let specialize_fsymbol p uc =
let s, (tl, ty) = specialize_lsymbol p uc in let s, (tl, ty) = specialize_lsymbol p uc in
......
...@@ -171,7 +171,7 @@ let print_type_decl drv fmt = function ...@@ -171,7 +171,7 @@ let print_type_decl drv fmt = function
let ac_th = ["algebra";"AC"] let ac_th = ["algebra";"AC"]
let print_logic_decl drv task fmt (ls,ld) = let print_logic_decl drv _task fmt (ls,ld) =
match drv ls.ls_name with match drv ls.ls_name with
| Driver.Remove | Driver.Syntax _ -> false | Driver.Remove | Driver.Syntax _ -> false
| Driver.Tag s -> | Driver.Tag s ->
......
...@@ -39,7 +39,7 @@ let ident_printer = ...@@ -39,7 +39,7 @@ let ident_printer =
let print_ident fmt id = let print_ident fmt id =
fprintf fmt "%s" (id_unique ident_printer id) fprintf fmt "%s" (id_unique ident_printer id)
let print_tvsymbols fmt id = assert false let print_tvsymbols _fmt _id = assert false
let forget_var v = forget_id ident_printer v.vs_name let forget_var v = forget_id ident_printer v.vs_name
...@@ -117,7 +117,7 @@ let rec print_fmla drv fmt f = match f.f_node with ...@@ -117,7 +117,7 @@ let rec print_fmla drv fmt f = match f.f_node with
end end
| Fquant (q, fq) -> | Fquant (q, fq) ->
let q = match q with Fforall -> "forall" | Fexists -> "exists" in let q = match q with Fforall -> "forall" | Fexists -> "exists" in
let vl, tl, f = f_open_quant fq in let vl, _tl, f = f_open_quant fq in
(* TODO trigger *) (* TODO trigger *)
let rec forall fmt = function let rec forall fmt = function
| [] -> print_fmla drv fmt f | [] -> print_fmla drv fmt f
...@@ -172,10 +172,10 @@ let print_type_decl drv fmt = function ...@@ -172,10 +172,10 @@ let print_type_decl drv fmt = function
| _, Talgebraic _ -> | _, Talgebraic _ ->
assert false assert false
let print_logic_decl drv task fmt (ls,ld) = let print_logic_decl drv _task fmt (ls,ld) =
match drv ls.ls_name with match drv ls.ls_name with
| Driver.Remove | Driver.Syntax _ -> false | Driver.Remove | Driver.Syntax _ -> false
| Driver.Tag s -> | Driver.Tag _s ->
begin match ld with begin match ld with
| None -> | None ->
begin match ls.ls_value with begin match ls.ls_value with
...@@ -189,7 +189,7 @@ let print_logic_decl drv task fmt (ls,ld) = ...@@ -189,7 +189,7 @@ let print_logic_decl drv task fmt (ls,ld) =
(print_list space (print_type drv)) ls.ls_args (print_list space (print_type drv)) ls.ls_args
(print_type drv) value (print_type drv) value
end end
| Some ld -> assert false (* Dealt in Encoding *) | Some _ -> assert false (* Dealt in Encoding *)
end; end;
true true
...@@ -201,7 +201,7 @@ let print_decl drv task fmt d = match d.d_node with ...@@ -201,7 +201,7 @@ let print_decl drv task fmt d = match d.d_node with
| Dind _ -> assert false (* TODO *) | Dind _ -> assert false (* TODO *)
| Dprop (Paxiom, pr, _) when | Dprop (Paxiom, pr, _) when
drv pr.pr_name = Driver.Remove -> false drv pr.pr_name = Driver.Remove -> false
| Dprop (Paxiom, pr, f) -> | Dprop (Paxiom, _pr, f) ->
fprintf fmt "@[<hov 2>:assumption@ %a@]@\n" fprintf fmt "@[<hov 2>:assumption@ %a@]@\n"
(print_fmla drv) f; true (print_fmla drv) f; true
| Dprop (Pgoal, pr, f) -> | Dprop (Pgoal, pr, f) ->
......
...@@ -151,7 +151,7 @@ and expr_desc env loc = function ...@@ -151,7 +151,7 @@ and expr_desc env loc = function
let e2 = dexpr env e2 in let e2 = dexpr env e2 in
expected_type e2 env.ty_bool; expected_type e2 env.ty_bool;
DElazy (op, e1, e2), env.ty_bool DElazy (op, e1, e2), env.ty_bool
| Pgm_ptree.Ematch (el, bl) -> | Pgm_ptree.Ematch (_el, _bl) ->
assert false (*TODO*) assert false (*TODO*)
| Pgm_ptree.Eskip -> | Pgm_ptree.Eskip ->
DEskip, env.ty_unit DEskip, env.ty_unit
...@@ -222,7 +222,7 @@ and expr_desc env denv = function ...@@ -222,7 +222,7 @@ and expr_desc env denv = function
| DElabel (s, e1) -> | DElabel (s, e1) ->
Elabel (s, expr env e1) Elabel (s, expr env e1)
let code uc id e = let code uc _id e =
let env = create_denv uc in let env = create_denv uc in
let e = dexpr env e in let e = dexpr env e in
ignore (expr Mstr.empty e) ignore (expr Mstr.empty e)
......
...@@ -230,7 +230,7 @@ and rewrite_fmla tenv tvar vsvar f = ...@@ -230,7 +230,7 @@ and rewrite_fmla tenv tvar vsvar f =
let p = Hls.find tenv.trans_lsymbol p in let p = Hls.find tenv.trans_lsymbol p in
let tl = List.map2 (conv_arg tenv tvar) tl p.ls_args in let tl = List.map2 (conv_arg tenv tvar) tl p.ls_args in
f_app p tl f_app p tl
| Fquant (q, b) -> let vl, tl, f1 = f_open_quant b in | Fquant (q, b) -> let vl, _tl, f1 = f_open_quant b in
let conv_vs (vsvar,acc) vs = let conv_vs (vsvar,acc) vs =
let tres,vsres = let tres,vsres =
let ty_res = conv_ty_pos tenv vs.vs_ty in let ty_res = conv_ty_pos tenv vs.vs_ty in
...@@ -268,7 +268,7 @@ let decl (tenv:tenv) d = ...@@ -268,7 +268,7 @@ let decl (tenv:tenv) d =
type which are not in recursive bloc") type which are not in recursive bloc")
| Dlogic l -> | Dlogic l ->
let fn = function let fn = function
| ls, Some _ -> assert false (* TODO or not | _ls, Some _ -> assert false (* TODO or not
(remove_logic_definition*) (remove_logic_definition*)
| ls, None -> | ls, None ->
try try
...@@ -279,7 +279,7 @@ let decl (tenv:tenv) d = ...@@ -279,7 +279,7 @@ let decl (tenv:tenv) d =
Hls.add tenv.trans_lsymbol ls ls_conv; Hls.add tenv.trans_lsymbol ls ls_conv;
ls_conv,None in ls_conv,None in
[create_logic_decl (List.map fn l)] [create_logic_decl (List.map fn l)]
| Dind l -> failwith ("Encoding_decorate : I can't work on inductive") | Dind _ -> failwith ("Encoding_decorate : I can't work on inductive")
(* let fn (pr,f) = pr, fnF f in *) (* let fn (pr,f) = pr, fnF f in *)
(* let fn (ps,l) = ps, List.map fn l in *) (* let fn (ps,l) = ps, List.map fn l in *)
(* [create_ind_decl (List.map fn l)] *) (* [create_ind_decl (List.map fn l)] *)
......
...@@ -56,7 +56,7 @@ and replacep env f = ...@@ -56,7 +56,7 @@ and replacep env f =
match f.f_node with match f.f_node with
| Fapp (ps,tl) -> | Fapp (ps,tl) ->
begin try begin try
let (vs,t) = Mls.find ps env.ps in let (vs,f) = Mls.find ps env.ps in
let m = List.fold_left2 (fun acc x y -> Mvs.add x y acc) let m = List.fold_left2 (fun acc x y -> Mvs.add x y acc)
Mvs.empty vs tl in Mvs.empty vs tl in
f_subst m f f_subst m f
...@@ -101,7 +101,7 @@ let fold isnotinlinedt isnotinlinedf d (env, task) = ...@@ -101,7 +101,7 @@ let fold isnotinlinedt isnotinlinedf d (env, task) =
let vs,e = open_ls_defn ld in let vs,e = open_ls_defn ld in
let e = e_map (replacet env) (replacep env) e in let e = e_map (replacet env) (replacep env) e in
make_ls_defn ls vs e) dl)) make_ls_defn ls vs e) dl))
| Dtype dl -> env,add_decl task d | Dtype _ -> env,add_decl task d
| Dprop (k,pr,f) -> | Dprop (k,pr,f) ->
env,add_decl task (create_prop_decl k pr (replacep env f)) env,add_decl task (create_prop_decl k pr (replacep env f))
...@@ -121,14 +121,14 @@ let all = t ~isnotinlinedt:(fun _ -> false) ~isnotinlinedf:(fun _ -> false) ...@@ -121,14 +121,14 @@ let all = t ~isnotinlinedt:(fun _ -> false) ~isnotinlinedf:(fun _ -> false)
let trivial = t let trivial = t
~isnotinlinedt:(fun m -> match m.t_node with ~isnotinlinedt:(fun m -> match m.t_node with
| Tconst _ | Tvar _ -> false | Tconst _ | Tvar _ -> false
| Tapp (ls,tl) when List.for_all | Tapp (_,tl) when List.for_all
(fun m -> match m.t_node with (fun m -> match m.t_node with
| Tvar _ -> true | Tvar _ -> true
| _ -> false) tl -> false | _ -> false) tl -> false
| _ -> true ) | _ -> true )
~isnotinlinedf:(fun m -> match m.f_node with ~isnotinlinedf:(fun m -> match m.f_node with
| Ftrue | Ffalse -> false | Ftrue | Ffalse -> false
| Fapp (ls,tl) when List.for_all | Fapp (_,tl) when List.for_all
(fun m -> match m.t_node with (fun m -> match m.t_node with
| Tvar _ -> true | Tvar _ -> true
| _ -> false) tl -> false | _ -> false) tl -> false
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment