Commit 58fbf6cb authored by Andrei Paskevich's avatar Andrei Paskevich

move option utilities from Util to Opt

+ rename Debug.Opt to Debug.Args to avoid conflicts
parent 4468018f
...@@ -108,7 +108,7 @@ LIBGENERATED = src/util/config.ml src/util/rc.ml src/parser/lexer.ml \ ...@@ -108,7 +108,7 @@ LIBGENERATED = src/util/config.ml src/util/rc.ml src/parser/lexer.ml \
src/driver/driver_parser.mli src/driver/driver_parser.ml \ src/driver/driver_parser.mli src/driver/driver_parser.ml \
src/driver/driver_lexer.ml src/session/xml.ml src/driver/driver_lexer.ml src/session/xml.ml
LIB_UTIL = config stdlib exn_printer pp debug loc print_tree \ LIB_UTIL = config opt stdlib exn_printer pp debug loc print_tree \
cmdline hashweak hashcons util warning sysutil rc plugin cmdline hashweak hashcons util warning sysutil rc plugin
LIB_CORE = ident ty term pattern decl theory task pretty env trans printer LIB_CORE = ident ty term pattern decl theory task pretty env trans printer
......
...@@ -90,9 +90,9 @@ let option_list = Arg.align [ ...@@ -90,9 +90,9 @@ let option_list = Arg.align [
" same as -m"; " same as -m";
"-j", Arg.Int (fun i -> opt_j := Some i), "-j", Arg.Int (fun i -> opt_j := Some i),
"<int> Set the number of worker to use (default:1)"; "<int> Set the number of worker to use (default:1)";
Debug.Opt.desc_debug_list; Debug.Args.desc_debug_list;
Debug.Opt.desc_debug_all; Debug.Args.desc_debug_all;
Debug.Opt.desc_debug; Debug.Args.desc_debug;
] ]
type runnable_prover = type runnable_prover =
...@@ -109,12 +109,12 @@ let env,provers = try ...@@ -109,12 +109,12 @@ let env,provers = try
let main = get_main config in let main = get_main config in
Whyconf.load_plugins main; Whyconf.load_plugins main;
Debug.Opt.set_flags_selected (); Debug.Args.set_flags_selected ();
(** listings*) (** listings*)
let opt_list = ref false in let opt_list = ref false in
opt_list := Debug.Opt.option_list () || !opt_list; opt_list := Debug.Args.option_list () || !opt_list;
if !opt_list then exit 0; if !opt_list then exit 0;
if Queue.is_empty opt_queue then begin if Queue.is_empty opt_queue then begin
......
...@@ -270,7 +270,7 @@ let find_dobj ~loc denv env impl s = ...@@ -270,7 +270,7 @@ let find_dobj ~loc denv env impl s =
| _ -> assert false (* impossible *) | _ -> assert false (* impossible *)
let ty_check loc s ty1 t = let ty_check loc s ty1 t =
Loc.try3 loc ty_match s ty1 (of_option t.t_ty) Loc.try3 loc ty_match s ty1 (Opt.get t.t_ty)
let rec ty denv env impl { e_loc = loc; e_node = n } = match n with let rec ty denv env impl { e_loc = loc; e_node = n } = match n with
| Eapp (aw,al) -> | Eapp (aw,al) ->
...@@ -303,7 +303,7 @@ let rec term denv env impl { e_loc = loc; e_node = n } = match n with ...@@ -303,7 +303,7 @@ let rec term denv env impl { e_loc = loc; e_node = n } = match n with
| Enum (Nint s) -> | Enum (Nint s) ->
t_int_const s t_int_const s
| Enum (Nreal (i,f,e)) -> | Enum (Nreal (i,f,e)) ->
t_real_const (RConstDecimal (i,Util.def_option "0" f,e)) t_real_const (RConstDecimal (i,Opt.get_def "0" f,e))
| Enum (Nrat (n,d)) -> | Enum (Nrat (n,d)) ->
let n = t_int_const n and d = t_int_const d in let n = t_int_const n and d = t_int_const d in
let frac = ns_find_ls denv.th_rat.th_export ["frac"] in let frac = ns_find_ls denv.th_rat.th_export ["frac"] in
...@@ -314,7 +314,7 @@ let rec term denv env impl { e_loc = loc; e_node = n } = match n with ...@@ -314,7 +314,7 @@ let rec term denv env impl { e_loc = loc; e_node = n } = match n with
begin match Mstr.find s env with begin match Mstr.find s env with
| SletF ([],_,[],t) -> | SletF ([],_,[],t) ->
let id = id_user s def.e_loc in let id = id_user s def.e_loc in
let vs = create_vsymbol id (of_option t.t_ty) in let vs = create_vsymbol id (Opt.get t.t_ty) in
let env = Mstr.add s (SVar vs) env in let env = Mstr.add s (SVar vs) env in
let t1 = term denv env impl e in let t1 = term denv env impl e in
t_let_close vs t t1 t_let_close vs t t1
...@@ -345,7 +345,7 @@ and fmla denv env impl pol tvl { e_loc = loc; e_node = n } = match n with ...@@ -345,7 +345,7 @@ and fmla denv env impl pol tvl { e_loc = loc; e_node = n } = match n with
begin match Mstr.find s env with begin match Mstr.find s env with
| SletF ([],_,[],t) -> | SletF ([],_,[],t) ->
let id = id_user s def.e_loc in let id = id_user s def.e_loc in
let vs = create_vsymbol id (of_option t.t_ty) in let vs = create_vsymbol id (Opt.get t.t_ty) in
let env = Mstr.add s (SVar vs) env in let env = Mstr.add s (SVar vs) env in
let f,b = fmla denv env impl pol tvl e in let f,b = fmla denv env impl pol tvl e in
t_let_close vs t f, b t_let_close vs t f, b
...@@ -394,8 +394,8 @@ and fmla denv env impl pol tvl { e_loc = loc; e_node = n } = match n with ...@@ -394,8 +394,8 @@ and fmla denv env impl pol tvl { e_loc = loc; e_node = n } = match n with
let f1,b1 = fmla denv env impl pol tvl e1 in let f1,b1 = fmla denv env impl pol tvl e1 in
let f2,b2 = fmla denv env impl pol tvl e2 in let f2,b2 = fmla denv env impl pol tvl e2 in
if b1 || b2 then if b1 || b2 then
let g1,_ = fmla denv env impl (option_map not pol) tvl e1 in let g1,_ = fmla denv env impl (Opt.map not pol) tvl e1 in
let g2,_ = fmla denv env impl (option_map not pol) tvl e2 in let g2,_ = fmla denv env impl (Opt.map not pol) tvl e2 in
t_and (t_implies g1 f2) (t_implies g2 f1), true t_and (t_implies g1 f2) (t_implies g2 f1), true
else else
t_iff f1 f2, false t_iff f1 f2, false
...@@ -403,18 +403,18 @@ and fmla denv env impl pol tvl { e_loc = loc; e_node = n } = match n with ...@@ -403,18 +403,18 @@ and fmla denv env impl pol tvl { e_loc = loc; e_node = n } = match n with
let f1,b1 = fmla denv env impl pol tvl e1 in let f1,b1 = fmla denv env impl pol tvl e1 in
let f2,b2 = fmla denv env impl pol tvl e2 in let f2,b2 = fmla denv env impl pol tvl e2 in
if b1 || b2 then if b1 || b2 then
let g1,_ = fmla denv env impl (option_map not pol) tvl e1 in let g1,_ = fmla denv env impl (Opt.map not pol) tvl e1 in
let g2,_ = fmla denv env impl (option_map not pol) tvl e2 in let g2,_ = fmla denv env impl (Opt.map not pol) tvl e2 in
t_not (t_and (t_implies f1 g2) (t_implies f2 g1)), true t_not (t_and (t_implies f1 g2) (t_implies f2 g1)), true
else else
t_not (t_iff f1 f2), false t_not (t_iff f1 f2), false
| Ebin (BOimp,e1,e2) -> | Ebin (BOimp,e1,e2) ->
let f1,b1 = fmla denv env impl (option_map not pol) tvl e1 in let f1,b1 = fmla denv env impl (Opt.map not pol) tvl e1 in
let f2,b2 = fmla denv env impl pol tvl e2 in let f2,b2 = fmla denv env impl pol tvl e2 in
t_implies f1 f2, b1 || b2 t_implies f1 f2, b1 || b2
| Ebin (BOpmi,e1,e2) -> | Ebin (BOpmi,e1,e2) ->
let f1,b1 = fmla denv env impl pol tvl e1 in let f1,b1 = fmla denv env impl pol tvl e1 in
let f2,b2 = fmla denv env impl (option_map not pol) tvl e2 in let f2,b2 = fmla denv env impl (Opt.map not pol) tvl e2 in
t_implies f2 f1, b1 || b2 t_implies f2 f1, b1 || b2
| Ebin (BOand,e1,e2) -> | Ebin (BOand,e1,e2) ->
let f1,b1 = fmla denv env impl pol tvl e1 in let f1,b1 = fmla denv env impl pol tvl e1 in
...@@ -425,15 +425,15 @@ and fmla denv env impl pol tvl { e_loc = loc; e_node = n } = match n with ...@@ -425,15 +425,15 @@ and fmla denv env impl pol tvl { e_loc = loc; e_node = n } = match n with
let f2,b2 = fmla denv env impl pol tvl e2 in let f2,b2 = fmla denv env impl pol tvl e2 in
t_or f1 f2, b1 || b2 t_or f1 f2, b1 || b2
| Ebin (BOnand,e1,e2) -> | Ebin (BOnand,e1,e2) ->
let f1,b1 = fmla denv env impl (option_map not pol) tvl e1 in let f1,b1 = fmla denv env impl (Opt.map not pol) tvl e1 in
let f2,b2 = fmla denv env impl (option_map not pol) tvl e2 in let f2,b2 = fmla denv env impl (Opt.map not pol) tvl e2 in
t_not (t_and f1 f2), b1 || b2 t_not (t_and f1 f2), b1 || b2
| Ebin (BOnor,e1,e2) -> | Ebin (BOnor,e1,e2) ->
let f1,b1 = fmla denv env impl (option_map not pol) tvl e1 in let f1,b1 = fmla denv env impl (Opt.map not pol) tvl e1 in
let f2,b2 = fmla denv env impl (option_map not pol) tvl e2 in let f2,b2 = fmla denv env impl (Opt.map not pol) tvl e2 in
t_not (t_or f1 f2), b1 || b2 t_not (t_or f1 f2), b1 || b2
| Enot e1 -> | Enot e1 ->
let f1,b1 = fmla denv env impl (option_map not pol) tvl e1 in let f1,b1 = fmla denv env impl (Opt.map not pol) tvl e1 in
t_not f1, b1 t_not f1, b1
| Eequ (e1,e2) -> | Eequ (e1,e2) ->
let t1 = term denv env impl e1 in let t1 = term denv env impl e1 in
...@@ -499,7 +499,7 @@ and ls_args denv env impl loc fs tvl gl mvs al = ...@@ -499,7 +499,7 @@ and ls_args denv env impl loc fs tvl gl mvs al =
fs_app denv.fs_ghost [] (ty_app denv.ts_ghost [Mtv.find v tvm]) in fs_app denv.fs_ghost [] (ty_app denv.ts_ghost [Mtv.find v tvm]) in
let tl = List.map ghost gl @ List.map (term denv env impl) al in let tl = List.map ghost gl @ List.map (term denv env impl) al in
let tvm = List.fold_left2 (ty_check loc) tvm fs.ls_args tl in let tvm = List.fold_left2 (ty_check loc) tvm fs.ls_args tl in
let ty = option_map (ty_inst tvm) fs.ls_value in let ty = Opt.map (ty_inst tvm) fs.ls_value in
t_app fs tl ty t_app fs tl ty
| _ -> error ~loc BadArity | _ -> error ~loc BadArity
in in
......
...@@ -560,7 +560,7 @@ and tr_global_ts dep env r = ...@@ -560,7 +560,7 @@ and tr_global_ts dep env r =
(* Format.printf "decl = %a@." Pretty.print_decl decl; *) (* Format.printf "decl = %a@." Pretty.print_decl decl; *)
List.iter (add_new_decl dep !dep') tl; List.iter (add_new_decl dep !dep') tl;
List.iter (add_dep dep') tl; List.iter (add_dep dep') tl;
Util.option_iter (add_new_decl dep !dep') decl; Opt.iter (add_new_decl dep !dep') decl;
lookup_table global_ts r lookup_table global_ts r
(* the function/predicate symbol for r *) (* the function/predicate symbol for r *)
...@@ -599,14 +599,14 @@ and tr_global_ls dep env r = ...@@ -599,14 +599,14 @@ and tr_global_ls dep env r =
let pl, d = decompose_definition dep' env c in let pl, d = decompose_definition dep' env c in
List.iter (add_new_decl dep !dep') pl; List.iter (add_new_decl dep !dep') pl;
List.iter (add_dep dep') pl; List.iter (add_dep dep') pl;
Util.option_iter (add_new_decl dep !dep') d; Opt.iter (add_new_decl dep !dep') d;
lookup_table global_ls r lookup_table global_ls r
| IndRef i -> | IndRef i ->
assert (is_Prop t); assert (is_Prop t);
let pl, d = decompose_inductive dep' env i in let pl, d = decompose_inductive dep' env i in
List.iter (add_new_decl dep !dep') pl; List.iter (add_new_decl dep !dep') pl;
List.iter (add_dep dep') pl; List.iter (add_dep dep') pl;
Util.option_iter (add_new_decl dep !dep') d; Opt.iter (add_new_decl dep !dep') d;
lookup_table global_ls r lookup_table global_ls r
| VarRef _ -> | VarRef _ ->
make_one_ls dep' env r; make_one_ls dep' env r;
......
...@@ -316,7 +316,7 @@ module Hsdecl = Hashcons.Make (struct ...@@ -316,7 +316,7 @@ module Hsdecl = Hashcons.Make (struct
type t = decl type t = decl
let cs_equal (cs1,pl1) (cs2,pl2) = let cs_equal (cs1,pl1) (cs2,pl2) =
ls_equal cs1 cs2 && list_all2 (option_eq ls_equal) pl1 pl2 ls_equal cs1 cs2 && list_all2 (Opt.equal ls_equal) pl1 pl2
let eq_td (ts1,td1) (ts2,td2) = let eq_td (ts1,td1) (ts2,td2) =
ts_equal ts1 ts2 && list_all2 cs_equal td1 td2 ts_equal ts1 ts2 && list_all2 cs_equal td1 td2
...@@ -413,7 +413,7 @@ let syms_ty s ty = ty_s_fold syms_ts s ty ...@@ -413,7 +413,7 @@ let syms_ty s ty = ty_s_fold syms_ts s ty
let syms_term s t = t_s_fold syms_ty syms_ls s t let syms_term s t = t_s_fold syms_ty syms_ls s t
let create_ty_decl ts = let create_ty_decl ts =
let syms = Util.option_fold syms_ty Sid.empty ts.ts_def in let syms = Opt.fold syms_ty Sid.empty ts.ts_def in
let news = Sid.singleton ts.ts_name in let news = Sid.singleton ts.ts_name in
mk_decl (Dtype ts) syms news mk_decl (Dtype ts) syms news
...@@ -430,7 +430,7 @@ let create_data_decl tdl = ...@@ -430,7 +430,7 @@ let create_data_decl tdl =
| Some ls -> raise (BadRecordField ls) | Some ls -> raise (BadRecordField ls)
in in
let check_constr tys ty pjs (syms,news) (fs,pl) = let check_constr tys ty pjs (syms,news) (fs,pl) =
ty_equal_check ty (exn_option (BadConstructor fs) fs.ls_value); ty_equal_check ty (Opt.get_exn (BadConstructor fs) fs.ls_value);
let fs_pjs = let fs_pjs =
try List.fold_left2 (check_proj fs ty) Sls.empty fs.ls_args pl try List.fold_left2 (check_proj fs ty) Sls.empty fs.ls_args pl
with Invalid_argument _ -> raise (BadConstructor fs) in with Invalid_argument _ -> raise (BadConstructor fs) in
...@@ -455,7 +455,7 @@ let create_data_decl tdl = ...@@ -455,7 +455,7 @@ let create_data_decl tdl =
if ts.ts_def <> None then raise (IllegalTypeAlias ts); if ts.ts_def <> None then raise (IllegalTypeAlias ts);
let news = news_id news ts.ts_name in let news = news_id news ts.ts_name in
let pjs = List.fold_left (fun s (_,pl) -> List.fold_left let pjs = List.fold_left (fun s (_,pl) -> List.fold_left
(option_fold (fun s ls -> Sls.add ls s)) s pl) Sls.empty cl in (Opt.fold (fun s ls -> Sls.add ls s)) s pl) Sls.empty cl in
let news = Sls.fold (fun pj s -> news_id s pj.ls_name) pjs news in let news = Sls.fold (fun pj s -> news_id s pj.ls_name) pjs news in
let ty = ty_app ts (List.map ty_var ts.ts_args) in let ty = ty_app ts (List.map ty_var ts.ts_args) in
List.fold_left (check_constr ts ty pjs) (syms,news) cl List.fold_left (check_constr ts ty pjs) (syms,news) cl
...@@ -464,7 +464,7 @@ let create_data_decl tdl = ...@@ -464,7 +464,7 @@ let create_data_decl tdl =
mk_decl (Ddata tdl) syms news mk_decl (Ddata tdl) syms news
let create_param_decl ls = let create_param_decl ls =
let syms = Util.option_fold syms_ty Sid.empty ls.ls_value in let syms = Opt.fold syms_ty Sid.empty ls.ls_value in
let syms = List.fold_left syms_ty syms ls.ls_args in let syms = List.fold_left syms_ty syms ls.ls_args in
let news = Sid.singleton ls.ls_name in let news = Sid.singleton ls.ls_name in
mk_decl (Dparam ls) syms news mk_decl (Dparam ls) syms news
...@@ -494,9 +494,9 @@ let rec f_pos_ps sps pol f = match f.t_node, pol with ...@@ -494,9 +494,9 @@ let rec f_pos_ps sps pol f = match f.t_node, pol with
| Tbinop (Tiff, f, g), _ -> | Tbinop (Tiff, f, g), _ ->
f_pos_ps sps None f && f_pos_ps sps None g f_pos_ps sps None f && f_pos_ps sps None g
| Tbinop (Timplies, f, g), _ -> | Tbinop (Timplies, f, g), _ ->
f_pos_ps sps (option_map not pol) f && f_pos_ps sps pol g f_pos_ps sps (Opt.map not pol) f && f_pos_ps sps pol g
| Tnot f, _ -> | Tnot f, _ ->
f_pos_ps sps (option_map not pol) f f_pos_ps sps (Opt.map not pol) f
| Tif (f,g,h), _ -> | Tif (f,g,h), _ ->
f_pos_ps sps None f && f_pos_ps sps pol g && f_pos_ps sps pol h f_pos_ps sps None f && f_pos_ps sps pol g && f_pos_ps sps pol h
| _ -> TermTF.t_all (t_pos_ps sps) (f_pos_ps sps pol) f | _ -> TermTF.t_all (t_pos_ps sps) (f_pos_ps sps pol) f
...@@ -775,7 +775,7 @@ let parse_record kn fll = ...@@ -775,7 +775,7 @@ let parse_record kn fll =
| [{ ty_node = Tyapp (ts,_) }] -> ts | [{ ty_node = Tyapp (ts,_) }] -> ts
| _ -> raise (BadRecordField fs) in | _ -> raise (BadRecordField fs) in
let cs, pjl = match find_constructors kn ts with let cs, pjl = match find_constructors kn ts with
| [cs,pjl] -> cs, List.map (exn_option (BadRecordField fs)) pjl | [cs,pjl] -> cs, List.map (Opt.get_exn (BadRecordField fs)) pjl
| _ -> raise (BadRecordField fs) in | _ -> raise (BadRecordField fs) in
let pjs = List.fold_left (fun s pj -> Sls.add pj s) Sls.empty pjl in let pjs = List.fold_left (fun s pj -> Sls.add pj s) Sls.empty pjl in
let flm = List.fold_left (fun m (pj,v) -> let flm = List.fold_left (fun m (pj,v) ->
...@@ -797,10 +797,10 @@ let make_record_update kn t fll ty = ...@@ -797,10 +797,10 @@ let make_record_update kn t fll ty =
let make_record_pattern kn fll ty = let make_record_pattern kn fll ty =
let cs,pjl,flm = parse_record kn fll in let cs,pjl,flm = parse_record kn fll in
let s = ty_match Mtv.empty (of_option cs.ls_value) ty in let s = ty_match Mtv.empty (Opt.get cs.ls_value) ty in
let get_arg pj = match Mls.find_opt pj flm with let get_arg pj = match Mls.find_opt pj flm with
| Some v -> v | Some v -> v
| None -> pat_wild (ty_inst s (of_option pj.ls_value)) | None -> pat_wild (ty_inst s (Opt.get pj.ls_value))
in in
pat_app cs (List.map get_arg pjl) ty pat_app cs (List.map get_arg pjl) ty
...@@ -104,7 +104,7 @@ module Compile (X : Action) = struct ...@@ -104,7 +104,7 @@ module Compile (X : Action) = struct
with NonExhaustive pl -> with NonExhaustive pl ->
let find_cs cs = let find_cs cs =
if Mls.mem cs types then () else if Mls.mem cs types then () else
let tm = ty_match Mtv.empty (of_option cs.ls_value) ty in let tm = ty_match Mtv.empty (Opt.get cs.ls_value) ty in
let wild ty = pat_wild (ty_inst tm ty) in let wild ty = pat_wild (ty_inst tm ty) in
let pw = pat_app cs (List.map wild cs.ls_args) ty in let pw = pat_app cs (List.map wild cs.ls_args) ty in
raise (NonExhaustive (pw :: pl)) raise (NonExhaustive (pw :: pl))
......
...@@ -58,7 +58,7 @@ let print_ident_labels fmt id = ...@@ -58,7 +58,7 @@ let print_ident_labels fmt id =
not (Slab.is_empty id.id_label) then not (Slab.is_empty id.id_label) then
fprintf fmt "@ %a" print_labels id.id_label; fprintf fmt "@ %a" print_labels id.id_label;
if Debug.test_flag debug_print_locs then if Debug.test_flag debug_print_locs then
Util.option_iter (fprintf fmt "@ %a" print_loc) id.id_loc Opt.iter (fprintf fmt "@ %a" print_loc) id.id_loc
(* type variables always start with a quote *) (* type variables always start with a quote *)
let print_tv fmt tv = let print_tv fmt tv =
...@@ -148,7 +148,7 @@ let unambig_fs fs = ...@@ -148,7 +148,7 @@ let unambig_fs fs =
| Tyvar u when not (lookup u) -> false | Tyvar u when not (lookup u) -> false
| _ -> ty_all inspect ty | _ -> ty_all inspect ty
in in
option_apply true inspect fs.ls_value Opt.fold (fun _ -> inspect) true fs.ls_value
(** Patterns, terms, and formulas *) (** Patterns, terms, and formulas *)
......
...@@ -85,7 +85,7 @@ let task_equal t1 t2 = match t1, t2 with ...@@ -85,7 +85,7 @@ let task_equal t1 t2 = match t1, t2 with
| None, None -> true | None, None -> true
| _ -> false | _ -> false
let task_hash t = option_apply 0 (fun t -> task_hd_hash t + 1) t let task_hash t = Opt.fold (fun _ t -> task_hd_hash t + 1) 0 t
module Hstask = Hashcons.Make (struct module Hstask = Hashcons.Make (struct
type t = task_hd type t = task_hd
...@@ -107,9 +107,9 @@ let mk_task decl prev known clone meta = Some (Hstask.hashcons { ...@@ -107,9 +107,9 @@ let mk_task decl prev known clone meta = Some (Hstask.hashcons {
task_tag = Hashweak.dummy_tag; task_tag = Hashweak.dummy_tag;
}) })
let task_known = option_apply Mid.empty (fun t -> t.task_known) let task_known = Opt.fold (fun _ t -> t.task_known) Mid.empty
let task_clone = option_apply Mid.empty (fun t -> t.task_clone) let task_clone = Opt.fold (fun _ t -> t.task_clone) Mid.empty
let task_meta = option_apply Mmeta.empty (fun t -> t.task_meta) let task_meta = Opt.fold (fun _ t -> t.task_meta) Mmeta.empty
let find_clone_tds task (th : theory) = cm_find (task_clone task) th let find_clone_tds task (th : theory) = cm_find (task_clone task) th
let find_meta_tds task (t : meta) = mm_find (task_meta task) t let find_meta_tds task (t : meta) = mm_find (task_meta task) t
...@@ -202,7 +202,7 @@ let add_meta task t al = new_meta task t (create_meta t al) ...@@ -202,7 +202,7 @@ let add_meta task t al = new_meta task t (create_meta t al)
let split_tdecl names (res,task) td = match td.td_node with let split_tdecl names (res,task) td = match td.td_node with
| Decl { d_node = Dprop ((Pgoal|Plemma),pr,f) } | Decl { d_node = Dprop ((Pgoal|Plemma),pr,f) }
when option_apply true (Spr.mem pr) names -> when Opt.fold (fun _ -> Spr.mem pr) true names ->
let res = add_prop_decl task Pgoal pr f :: res in let res = add_prop_decl task Pgoal pr f :: res in
res, flat_tdecl task td res, flat_tdecl task td
| _ -> | _ ->
......
...@@ -392,7 +392,7 @@ module Hsterm = Hashcons.Make (struct ...@@ -392,7 +392,7 @@ module Hsterm = Hashcons.Make (struct
oty_equal t1.t_ty t2.t_ty && oty_equal t1.t_ty t2.t_ty &&
t_equal_node t1.t_node t2.t_node && t_equal_node t1.t_node t2.t_node &&
Slab.equal t1.t_label t2.t_label && Slab.equal t1.t_label t2.t_label &&
option_eq Loc.equal t1.t_loc t2.t_loc Opt.equal Loc.equal t1.t_loc t2.t_loc
let t_hash_bound (v,b,t) = let t_hash_bound (v,b,t) =
Hashcons.combine (vs_hash v) (bnd_hash b (t_hash t)) Hashcons.combine (vs_hash v) (bnd_hash b (t_hash t))
...@@ -881,7 +881,7 @@ let rec t_gen_map fnT fnL m t = ...@@ -881,7 +881,7 @@ let rec t_gen_map fnT fnL m t =
| Tconst _ -> | Tconst _ ->
t t
| Tapp (fs, tl) -> | Tapp (fs, tl) ->
t_app (fnL fs) (List.map fn tl) (option_map fnT t.t_ty) t_app (fnL fs) (List.map fn tl) (Opt.map fnT t.t_ty)
| Tif (f, t1, t2) -> | Tif (f, t1, t2) ->
t_if (fn f) (fn t1) (fn t2) t_if (fn f) (fn t1) (fn t2)
| Tlet (t1, (u,b,t2)) -> | Tlet (t1, (u,b,t2)) ->
...@@ -933,7 +933,7 @@ let t_ty_subst mapT mapV t = ...@@ -933,7 +933,7 @@ let t_ty_subst mapT mapV t =
let rec t_gen_fold fnT fnL acc t = let rec t_gen_fold fnT fnL acc t =
let fn = t_gen_fold fnT fnL in let fn = t_gen_fold fnT fnL in
let acc = option_fold fnT acc t.t_ty in let acc = Opt.fold fnT acc t.t_ty in
match t.t_node with match t.t_node with
| Tconst _ | Tvar _ -> acc | Tconst _ | Tvar _ -> acc
| Tapp (f, tl) -> List.fold_left fn (fnL acc f) tl | Tapp (f, tl) -> List.fold_left fn (fnL acc f) tl
......
...@@ -460,7 +460,7 @@ let rec cl_find_ts cl ts = ...@@ -460,7 +460,7 @@ let rec cl_find_ts cl ts =
if not (Sid.mem ts.ts_name cl.cl_local) then ts if not (Sid.mem ts.ts_name cl.cl_local) then ts
else try Mts.find ts cl.ts_table else try Mts.find ts cl.ts_table
with Not_found -> with Not_found ->
let td' = option_map (cl_trans_ty cl) ts.ts_def in let td' = Opt.map (cl_trans_ty cl) ts.ts_def in
let ts' = create_tysymbol (id_clone ts.ts_name) ts.ts_args td' in let ts' = create_tysymbol (id_clone ts.ts_name) ts.ts_args td' in
cl.ts_table <- Mts.add ts ts' cl.ts_table; cl.ts_table <- Mts.add ts ts' cl.ts_table;
ts' ts'
...@@ -472,7 +472,7 @@ let cl_find_ls cl ls = ...@@ -472,7 +472,7 @@ let cl_find_ls cl ls =
else try Mls.find ls cl.ls_table else try Mls.find ls cl.ls_table
with Not_found -> with Not_found ->
let ta' = List.map (cl_trans_ty cl) ls.ls_args in let ta' = List.map (cl_trans_ty cl) ls.ls_args in
let vt' = option_map (cl_trans_ty cl) ls.ls_value in let vt' = Opt.map (cl_trans_ty cl) ls.ls_value in
let ls' = create_lsymbol (id_clone ls.ls_name) ta' vt' in let ls' = create_lsymbol (id_clone ls.ls_name) ta' vt' in
cl.ls_table <- Mls.add ls ls' cl.ls_table; cl.ls_table <- Mls.add ls ls' cl.ls_table;
ls' ls'
...@@ -542,7 +542,7 @@ let cl_data cl inst tdl = ...@@ -542,7 +542,7 @@ let cl_data cl inst tdl =
cl_find_ls cl ls cl_find_ls cl ls
in in
let add_constr (ls,pl) = let add_constr (ls,pl) =
add_ls ls, List.map (option_map add_ls) pl add_ls ls, List.map (Opt.map add_ls) pl
in in
let add_type (ts,csl) = let add_type (ts,csl) =
if Mts.mem ts inst.inst_ts then if Mts.mem ts inst.inst_ts then
...@@ -632,7 +632,7 @@ let clone_theory cl add_td acc th inst = ...@@ -632,7 +632,7 @@ let clone_theory cl add_td acc th inst =
try Some (mk_tdecl (cl_tdecl cl inst td)) try Some (mk_tdecl (cl_tdecl cl inst td))
with EmptyDecl -> None with EmptyDecl -> None
in in
option_apply acc (add_td acc) td Opt.fold add_td acc td
in in
let acc = List.fold_left add acc th.th_decls in let acc = List.fold_left add acc th.th_decls in
let sm = { let sm = {
...@@ -738,7 +738,7 @@ let clone_meta tdt sm = match tdt.td_node with ...@@ -738,7 +738,7 @@ let clone_meta tdt sm = match tdt.td_node with
(** access to meta *) (** access to meta *)
(* (*
let theory_meta = option_apply Mmeta.empty (fun t -> t.task_meta) let theory_meta = Opt.fold (fun _ t -> t.task_meta) Mmeta.empty
let find_meta_tds th (t : meta) = mm_find (theory_meta th) t let find_meta_tds th (t : meta) = mm_find (theory_meta th) t
......
...@@ -152,7 +152,7 @@ let create_tysymbol name args def = ...@@ -152,7 +152,7 @@ let create_tysymbol name args def =
let add s v = Stv.add_new (DuplicateTypeVar v) v s in let add s v = Stv.add_new (DuplicateTypeVar v) v s in
let s = List.fold_left add Stv.empty args in let s = List.fold_left add Stv.empty args in
let check v = Stv.mem v s || raise (UnboundTypeVar v) in let check v = Stv.mem v s || raise (UnboundTypeVar v) in
ignore (option_map (ty_v_all check) def); ignore (Opt.map (ty_v_all check) def);
mk_ts name args def mk_ts name args def
let ty_app s tl = let ty_app s tl =
...@@ -251,17 +251,17 @@ exception UnexpectedProp ...@@ -251,17 +251,17 @@ exception UnexpectedProp
let oty_type = function Some ty -> ty | None -> raise UnexpectedProp let oty_type = function Some ty -> ty | None -> raise UnexpectedProp
let oty_equal = Util.option_eq ty_equal let oty_equal = Opt.equal ty_equal
let oty_hash = Util.option_apply 1 ty_hash let oty_hash = Opt.fold (fun _ -> ty_hash) 1
let oty_match m o1 o2 = match o1,o2 with let oty_match m o1 o2 = match o1,o2 with
| Some ty1, Some ty2 -> ty_match m ty1 ty2 | Some ty1, Some ty2 -> ty_match m ty1 ty2
| None, None -> m | None, None -> m
| _ -> raise UnexpectedProp | _ -> raise UnexpectedProp