diff options
Diffstat (limited to 'engine')
| -rw-r--r-- | engine/evarutil.ml | 17 | ||||
| -rw-r--r-- | engine/logic_monad.ml | 8 | ||||
| -rw-r--r-- | engine/proofview.ml | 4 |
3 files changed, 17 insertions, 12 deletions
diff --git a/engine/evarutil.ml b/engine/evarutil.ml index 911b189deb..ea71be8e43 100644 --- a/engine/evarutil.ml +++ b/engine/evarutil.ml @@ -331,11 +331,16 @@ let push_rel_decl_to_named_context let map_decl f d = NamedDecl.map_constr f d in - let replace_var_named_declaration id0 id decl = - let id' = NamedDecl.get_id decl in - let id' = if Id.equal id0 id' then id else id' in - let vsubst = [id0 , mkVar id] in - decl |> NamedDecl.set_id id' |> map_decl (replace_vars vsubst) + let rec replace_var_named_declaration id0 id = function + | [] -> [] + | decl :: nc -> + if Id.equal id0 (NamedDecl.get_id decl) then + (* Stop here, the variable cannot occur before its definition *) + (NamedDecl.set_id id decl) :: nc + else + let nc = replace_var_named_declaration id0 id nc in + let vsubst = [id0 , mkVar id] in + map_decl (fun c -> replace_vars vsubst c) decl :: nc in let extract_if_neq id = function | Anonymous -> None @@ -366,7 +371,7 @@ let push_rel_decl_to_named_context context. Unless [id] is a section variable. *) let subst = update_var id0 id subst in let d = decl |> NamedDecl.of_rel_decl (fun _ -> id0) |> map_decl (csubst_subst subst) in - let nc = List.map (replace_var_named_declaration id0 id) nc in + let nc = replace_var_named_declaration id0 id nc in (push_var id0 subst, Id.Set.add id avoid, d :: nc) | Some id0 when hypnaming = FailIfConflict -> user_err Pp.(Id.print id0 ++ str " is already used.") diff --git a/engine/logic_monad.ml b/engine/logic_monad.ml index 2354d2c5e8..7c06bb59f1 100644 --- a/engine/logic_monad.ml +++ b/engine/logic_monad.ml @@ -41,7 +41,7 @@ let _ = CErrors.register_handler begin function | Timeout -> CErrors.user_err ~hdr:"Some timeout function" (Pp.str"Timeout!") | Exception e -> CErrors.print e | TacticFailure e -> CErrors.print e - | _ -> Pervasives.raise CErrors.Unhandled + | _ -> raise CErrors.Unhandled end (** {6 Non-logical layer} *) @@ -70,11 +70,11 @@ struct let map f a = (); fun () -> f (a ()) end) - type 'a ref = 'a Pervasives.ref + type 'a ref = 'a Util.pervasives_ref let ignore a = (); fun () -> ignore (a ()) - let ref a = (); fun () -> Pervasives.ref a + let ref a = (); fun () -> ref a (** [Pervasives.(:=)] *) let (:=) r a = (); fun () -> r := a @@ -93,7 +93,7 @@ struct let (src, info) = CErrors.push src in h (e, info) () - let read_line = fun () -> try Pervasives.read_line () with e -> + let read_line = fun () -> try read_line () with e -> let (e, info) = CErrors.push e in raise ~info e () let print_char = fun c -> (); fun () -> print_char c diff --git a/engine/proofview.ml b/engine/proofview.ml index c4a624e462..8b5bd4cd80 100644 --- a/engine/proofview.ml +++ b/engine/proofview.ml @@ -542,7 +542,7 @@ let tclDISPATCHGEN join tacs = let tacs = CList.map branch tacs in InfoL.tag (Info.Dispatch) (tclDISPATCHGEN0 join tacs) -let tclDISPATCH tacs = tclDISPATCHGEN Pervasives.ignore tacs +let tclDISPATCH tacs = tclDISPATCHGEN ignore tacs let tclDISPATCHL tacs = tclDISPATCHGEN CList.rev tacs @@ -910,7 +910,7 @@ let tclPROGRESS t = exception Timeout let _ = CErrors.register_handler begin function | Timeout -> CErrors.user_err ~hdr:"Proofview.tclTIMEOUT" (Pp.str"Tactic timeout!") - | _ -> Pervasives.raise CErrors.Unhandled + | _ -> raise CErrors.Unhandled end let tclTIMEOUT n t = |