X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=matita%2Fcomponents%2Fng_tactics%2FnTacStatus.ml;h=fc525c84a772034db42886a5359e540da26de1f7;hb=f00a612006ac05f49a42ab507a95d3298bc1457a;hp=271f9a0404b10d9d217997f57bda007058e15f46;hpb=90c448900e236db71d670f75ee82b41729a61735;p=helm.git diff --git a/matita/components/ng_tactics/nTacStatus.ml b/matita/components/ng_tactics/nTacStatus.ml index 271f9a040..fc525c84a 100644 --- a/matita/components/ng_tactics/nTacStatus.ml +++ b/matita/components/ng_tactics/nTacStatus.ml @@ -97,24 +97,24 @@ let ctx_of (c,_) = c ;; let mk_cic_term c t = c,t ;; let ppterm (status:#pstatus) t = - let uri,height,metasenv,subst,obj = status#obj in + let _uri,_height,metasenv,subst,_obj = status#obj in let context,t = t in status#ppterm ~metasenv ~subst ~context t ;; let ppcontext (status: #pstatus) c = - let uri,height,metasenv,subst,obj = status#obj in + let _uri,_height,metasenv,subst,_obj = status#obj in status#ppcontext ~metasenv ~subst c ;; let ppterm_and_context (status: #pstatus) t = - let uri,height,metasenv,subst,obj = status#obj in + let _uri,_height,metasenv,subst,_obj = status#obj in let context,t = t in status#ppcontext ~metasenv ~subst context ^ "\n ⊢ "^ status#ppterm ~metasenv ~subst ~context t ;; -let relocate status destination (source,t as orig) = +let relocate status destination (source,_t as orig) = pp(lazy("relocate:\n" ^ ppterm_and_context status orig)); pp(lazy("relocate in:\n" ^ ppcontext status destination)); let rc = @@ -134,13 +134,13 @@ let relocate status destination (source,t as orig) = compute_ops (e::ctx) (cl1,cl2) else [ `Delift ctx; `Lift (List.rev ex) ] - | (n1, NCic.Def (b1,t1) as e)::cl1 as ex, (n2, NCic.Decl t2)::cl2 -> + | (n1, NCic.Def (_b1,t1) as e)::cl1 as ex, (n2, NCic.Decl t2)::cl2 -> if n1 = n2 && NCicReduction.are_convertible status ctx ~subst ~metasenv t1 t2 then compute_ops (e::ctx) (cl1,cl2) else [ `Delift ctx; `Lift (List.rev ex) ] - | (n1, NCic.Decl _)::cl1 as ex, (n2, NCic.Def _)::cl2 -> + | (_n1, NCic.Decl _)::_cl1 as ex, (_n2, NCic.Def _)::_cl2 -> [ `Delift ctx; `Lift (List.rev ex) ] | _::_ as ex, [] -> [ `Lift (List.rev ex) ] | [], _::_ -> [ `Delift ctx ] @@ -187,9 +187,11 @@ let term_of_cic_term s t c = let disambiguate status context t ty = let status, expty = match ty with - | None -> status, None - | Some ty -> - let status, (_,x) = relocate status context ty in status, Some x + | `XTSome ty -> + let status, (_,x) = relocate status context ty in status, `XTSome x + | `XTNone -> status, `XTNone + | `XTSort -> status, `XTSort + | `XTInd -> status, `XTInd in let uri,height,metasenv,subst,obj = status#obj in let metasenv, subst, status, t = @@ -254,9 +256,11 @@ let refine status ctx term expty = let status, (_,term) = relocate status ctx term in let status, expty = match expty with - None -> status, None - | Some e -> - let status, (_, e) = relocate status ctx e in status, Some e + | `XTSome e -> + let status, (_, e) = relocate status ctx e in status, `XTSome e + | `XTNone -> status, `XTNone + | `XTSort -> status, `XTSort + | `XTInd -> status, `XTInd in let name,height,metasenv,subst,obj = status#obj in let metasenv,subst,t,ty = @@ -289,7 +293,7 @@ let instantiate status ?refine:(dorefine=true) i t = let _,_,metasenv,_,_ = status#obj in let gname, context, gty = List.assoc i metasenv in if dorefine then - let status, (_,t), (_,ty) = refine status context t (Some (context,gty)) in + let status, (_,t), (_,ty) = refine status context t (`XTSome (context,gty)) in to_subst status i (gname,context,t,ty) else let status,(_,ty) = typeof status context t in @@ -300,7 +304,7 @@ let instantiate_with_ast status i t = let _,_,metasenv,_,_ = status#obj in let gname, context, gty = List.assoc i metasenv in let ggty = mk_cic_term context gty in - let status, (_,t) = disambiguate status context t (Some ggty) in + let status, (_,t) = disambiguate status context t (`XTSome ggty) in to_subst status i (gname,context,t,gty) ;; @@ -365,7 +369,7 @@ let select_term else let _,_,_,subst,_ = status#obj in match t with - | NCic.Meta (i,lc) when List.mem_assoc i subst -> + | NCic.Meta (i,_lc) when List.mem_assoc i subst -> let _,_,t,_ = NCicUtils.lookup_subst i subst in aux ctx (status,already_found) t | NCic.Meta _ -> (status,already_found),t @@ -424,7 +428,7 @@ let select_term | NCic.Implicit `Hole, t -> (match wanted with | Some wanted -> - let status', wanted = disambiguate status ctx wanted None in + let status', wanted = disambiguate status ctx wanted `XTNone in pp(lazy("wanted: "^ppterm status' wanted)); let (status',found), t' = match_term status' ctx wanted t in if found then status',t' else status,t