- if ctx = context then term else
- if is_prefix ctx context then
- (name, context,
- NCicSubstitution.lift (List.length context - List.length ctx) t)
- else
- assert false
-;;
-
-let disambiguate (status : lowtac_status) (t : ast_term)
- (ty : cic_term option) (where : position) =
- let uri,height,metasenv,subst,obj = status.pstatus in
- let context = match where with Ctx c -> c | Term (_,c,_) -> c in
- let expty =
- match ty with
- | None -> None | Some ty -> let _,_,x = relocate ty context in Some x
- in
- let metasenv, subst, lexicon_status, t =
- GrafiteDisambiguate.disambiguate_nterm expty
- status.lstatus context metasenv subst t
+ match res with
+ | None -> raise (NTacStatus.Error (lazy("No tactic left")))
+ | Some x -> x
+;;
+
+let exact_tac t = distribute_tac (fun status goal ->
+ let goalty = get_goalty status goal in
+ let status, t = disambiguate status t (Some goalty) (ctx_of goalty) in
+ instantiate status goal t)
+;;
+
+let assumption_tac status = distribute_tac (fun status goal ->
+ let gty = get_goalty status goal in
+ let context = ctx_of gty in
+ let htac =
+ first_tac
+ (List.map (fun (name,_) -> exact_tac ("",0,(Ast.Ident (name,None))))
+ context)
+ in
+ exec htac status goal) status
+;;
+
+let find_in_context name context =
+ let rec aux acc = function
+ | [] -> raise Not_found
+ | (hd,_) :: tl when hd = name -> acc
+ | _ :: tl -> aux (acc + 1) tl
+ in
+ aux 1 context
+;;
+
+let clear_tac names =
+ if names = [] then id_tac
+ else
+ distribute_tac (fun status goal ->
+ let goalty = get_goalty status goal in
+ let js =
+ List.map
+ (fun name ->
+ try find_in_context name (ctx_of goalty)
+ with Not_found ->
+ fail (lazy ("hypothesis '" ^ name ^ "' not found")))
+ names
+ in
+ let n,h,metasenv,subst,o = status#obj in
+ let metasenv,subst,_ = NCicMetaSubst.restrict metasenv subst goal js in
+ status#set_obj (n,h,metasenv,subst,o))
+;;
+
+let generalize0_tac args =
+ if args = [] then id_tac
+ else exact_tac ("",0,Ast.Appl (Ast.Implicit :: args))
+;;
+
+let select0_tac ~where:(wanted,hyps,where) ~job =
+ let found, postprocess =
+ match job with
+ | `Substexpand argsno -> mk_in_scope, mk_out_scope argsno
+ | `Collect l -> (fun s t -> l := t::!l; mk_in_scope s t), mk_out_scope 1
+ | `ChangeWith f -> f,(fun s t -> s, t)