diff options
Diffstat (limited to 'plugins/cc/ccalgo.ml')
| -rw-r--r-- | plugins/cc/ccalgo.ml | 39 |
1 files changed, 17 insertions, 22 deletions
diff --git a/plugins/cc/ccalgo.ml b/plugins/cc/ccalgo.ml index bc3d9ed5..bc53b113 100644 --- a/plugins/cc/ccalgo.ml +++ b/plugins/cc/ccalgo.ml @@ -10,7 +10,7 @@ (* Downey,Sethi and Tarjan. *) (* Plus some e-matching and constructor handling by P. Corbineau *) -open Errors +open CErrors open Util open Pp open Goptions @@ -25,7 +25,7 @@ let init_size=5 let cc_verbose=ref false let debug x = - if !cc_verbose then msg_debug x + if !cc_verbose then Feedback.msg_debug (x ()) let _= let gdopt= @@ -154,11 +154,6 @@ let rec term_equal t1 t2 = open Hashset.Combine -let hash_sorts_family = function -| InProp -> 0 -| InSet -> 1 -| InType -> 2 - let rec hash_term = function | Symb c -> combine 1 (hash_constr c) | Product (s1, s2) -> combine3 2 (Sorts.hash s1) (Sorts.hash s2) @@ -489,7 +484,7 @@ let build_subst uf subst = Array.map (fun i -> try term uf i - with e when Errors.noncritical e -> + with e when CErrors.noncritical e -> anomaly (Pp.str "incomplete matching")) subst @@ -603,7 +598,7 @@ let add_inst state (inst,int_subst) = Control.check_for_interrupt (); if state.rew_depth > 0 then if is_redundant state inst.qe_hyp_id int_subst then - debug (str "discarding redundant (dis)equality") + debug (fun () -> str "discarding redundant (dis)equality") else begin Identhash.add state.q_history inst.qe_hyp_id int_subst; @@ -618,7 +613,7 @@ let add_inst state (inst,int_subst) = state.rew_depth<-pred state.rew_depth; if inst.qe_pol then begin - debug ( + debug (fun () -> (str "Adding new equality, depth="++ int state.rew_depth) ++ fnl () ++ (str " [" ++ Termops.print_constr prf ++ str " : " ++ pr_term s ++ str " == " ++ pr_term t ++ str "]")); @@ -626,7 +621,7 @@ let add_inst state (inst,int_subst) = end else begin - debug ( + debug (fun () -> (str "Adding new disequality, depth="++ int state.rew_depth) ++ fnl () ++ (str " [" ++ Termops.print_constr prf ++ str " : " ++ pr_term s ++ str " <> " ++ pr_term t ++ str "]")); @@ -657,7 +652,7 @@ let join_path uf i j= min_path (down_path uf i [],down_path uf j []) let union state i1 i2 eq= - debug (str "Linking " ++ pr_idx_term state.uf i1 ++ + debug (fun () -> str "Linking " ++ pr_idx_term state.uf i1 ++ str " and " ++ pr_idx_term state.uf i2 ++ str "."); let r1= get_representative state.uf i1 and r2= get_representative state.uf i2 in @@ -698,7 +693,7 @@ let union state i1 i2 eq= let merge eq state = (* merge and no-merge *) debug - (str "Merging " ++ pr_idx_term state.uf eq.lhs ++ + (fun () -> str "Merging " ++ pr_idx_term state.uf eq.lhs ++ str " and " ++ pr_idx_term state.uf eq.rhs ++ str "."); let uf=state.uf in let i=find uf eq.lhs @@ -711,7 +706,7 @@ let merge eq state = (* merge and no-merge *) let update t state = (* update 1 and 2 *) debug - (str "Updating term " ++ pr_idx_term state.uf t ++ str "."); + (fun () -> str "Updating term " ++ pr_idx_term state.uf t ++ str "."); let (i,j) as sign = signature state.uf t in let (u,v) = subterms state.uf t in let rep = get_representative state.uf i in @@ -773,7 +768,7 @@ let process_constructor_mark t i rep pac state = let process_mark t m state = debug - (str "Processing mark for term " ++ pr_idx_term state.uf t ++ str "."); + (fun () -> str "Processing mark for term " ++ pr_idx_term state.uf t ++ str "."); let i=find state.uf t in let rep=get_representative state.uf i in match m with @@ -794,7 +789,7 @@ let check_disequalities state = else (str "No", check_aux q) in let _ = debug - (str "Checking if " ++ pr_idx_term state.uf dis.lhs ++ str " = " ++ + (fun () -> str "Checking if " ++ pr_idx_term state.uf dis.lhs ++ str " = " ++ pr_idx_term state.uf dis.rhs ++ str " ... " ++ info) in ans | [] -> None @@ -824,7 +819,7 @@ let __eps__ = Id.of_string "_eps_" let new_state_var typ state = let id = pf_get_new_id __eps__ state.gls in let {it=gl ; sigma=sigma} = state.gls in - let gls = Goal.V82.new_goal_with sigma gl [id,None,typ] in + let gls = Goal.V82.new_goal_with sigma gl [Context.Named.Declaration.LocalAssum (id,typ)] in state.gls<- gls; id @@ -979,7 +974,7 @@ let find_instances state = let pb_stack= init_pb_stack state in let res =ref [] in let _ = - debug (str "Running E-matching algorithm ... "); + debug (fun () -> str "Running E-matching algorithm ... "); try while true do Control.check_for_interrupt (); @@ -990,7 +985,7 @@ let find_instances state = !res let rec execute first_run state = - debug (str "Executing ... "); + debug (fun () -> str "Executing ... "); try while Control.check_for_interrupt (); @@ -1000,7 +995,7 @@ let rec execute first_run state = None -> if not(Int.Set.is_empty state.pa_classes) then begin - debug (str "First run was incomplete, completing ... "); + debug (fun () -> str "First run was incomplete, completing ... "); complete state; execute false state end @@ -1015,12 +1010,12 @@ let rec execute first_run state = end else begin - debug (str "Out of instances ... "); + debug (fun () -> str "Out of instances ... "); None end else begin - debug (str "Out of depth ... "); + debug (fun () -> str "Out of depth ... "); None end | Some dis -> Some |