- let change_tac ~what ~with_what (proof, goal) =
- let curi,metasenv,pbo,pty = proof in
- let metano,context,ty = CicUtil.lookup_meta goal metasenv in
- (* are_convertible works only on well-typed terms *)
- ignore (CicTypeChecker.type_of_aux' metasenv context with_what) ;
- if CicReduction.are_convertible context what with_what then
- begin
- let replace =
- ProofEngineReduction.replace
- ~equality:(==) ~what:[what] ~with_what:[with_what]
- in
- let ty' = replace ty in
- let context' =
- List.map
- (function
- Some (name,Cic.Def (t,None))->Some (name,Cic.Def ((replace t),None))
- | Some (name,Cic.Decl t) -> Some (name,Cic.Decl (replace t))
- | None -> None
- | Some (_,Cic.Def (_,Some _)) -> assert false
- ) context
- in
- let metasenv' =
- List.map
- (function
- (n,_,_) when n = metano -> (metano,context',ty')
- | _ as t -> t
- ) metasenv
- in
- (curi,metasenv',pbo,pty), [metano]
- end
- else
- raise (ProofEngineTypes.Fail "Not convertible")
- in
- mk_tactic (change_tac ~what ~with_what)
+ let change_tac ~what ~with_what (proof, goal) =
+ let curi,metasenv,pbo,pty = proof in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
+ (* are_convertible works only on well-typed terms *)
+ let _,u =
+ CicTypeChecker.type_of_aux' metasenv context with_what
+ CicUniv.empty_ugraph
+ in (* TASSI: FIXME *)
+ let b,_ =
+ CicReduction.are_convertible context what with_what u
+ in
+ if b then
+ begin
+ let replace =
+ ProofEngineReduction.replace
+ ~equality:(==) ~what:[what] ~with_what:[with_what]
+ in
+ let ty' = replace ty in
+ let context' =
+ List.map
+ (function
+ Some (name,Cic.Def (t,None))->
+ Some (name,Cic.Def ((replace t),None))
+ | Some (name,Cic.Decl t) -> Some (name,Cic.Decl (replace t))
+ | None -> None
+ | Some (_,Cic.Def (_,Some _)) -> assert false
+ ) context
+ in
+ let metasenv' =
+ List.map
+ (function
+ (n,_,_) when n = metano -> (metano,context',ty')
+ | _ as t -> t
+ ) metasenv
+ in
+ (curi,metasenv',pbo,pty), [metano]
+ end
+ else
+ raise (ProofEngineTypes.Fail "Not convertible")
+ in
+ mk_tactic (change_tac ~what ~with_what)
+