in
find context wanted t
-let select ~context ~term ~pattern:(wanted,where) =
+let select_in_term ~context ~term ~pattern:(wanted,where) =
let add_ctx context name entry =
(Some (name, entry)) :: context
in
in
find_in_roots roots
-let pattern_of ?(equality=(==)) ~term terms =
- let (===) x y = equality x y in
- let rec aux t =
- match t with
- | t when List.exists (fun t' -> t === t') terms -> Cic.Implicit (Some `Hole)
- | Cic.Var (uri, subst) -> Cic.Var (uri, aux_subst subst)
- | Cic.Meta (i, ctxt) ->
- let ctxt =
- List.map (function None -> None | Some t -> Some (aux t)) ctxt
- in
- Cic.Meta (i, ctxt)
- | Cic.Cast (t, ty) -> Cic.Cast (aux t, aux ty)
- | Cic.Prod (name, s, t) -> Cic.Prod (name, aux s, aux t)
- | Cic.Lambda (name, s, t) -> Cic.Lambda (name, aux s, aux t)
- | Cic.LetIn (name, s, t) -> Cic.LetIn (name, aux s, aux t)
- | Cic.Appl terms -> Cic.Appl (List.map aux terms)
- | Cic.Const (uri, subst) -> Cic.Const (uri, aux_subst subst)
- | Cic.MutInd (uri, tyno, subst) -> Cic.MutInd (uri, tyno, aux_subst subst)
- | Cic.MutConstruct (uri, tyno, consno, subst) ->
- Cic.MutConstruct (uri, tyno, consno, aux_subst subst)
- | Cic.MutCase (uri, tyno, outty, t, pat) ->
- Cic.MutCase (uri, tyno, aux outty, aux t, List.map aux pat)
- | Cic.Fix (funno, funs) ->
- let funs =
- List.map (fun (name, i, ty, bo) -> (name, i, aux ty, aux bo)) funs
- in
- Cic.Fix (funno, funs)
- | Cic.CoFix (funno, funs) ->
- let funs =
- List.map (fun (name, ty, bo) -> (name, aux ty, aux bo)) funs
- in
- Cic.CoFix (funno, funs)
- | Cic.Rel _
- | Cic.Sort _
- | Cic.Implicit _ -> t
- and aux_subst subst =
- List.map (fun (uri, t) -> (uri, aux t)) subst
- in
- aux term
+exception Fail of string
+(** select metasenv conjecture pattern
+* select all subterms of [conjecture] matching [pattern].
+* It returns the set of matched terms (that can be compared using physical
+* equality to the subterms of [conjecture]) together with their contexts.
+* The representation of the set mimics the ProofEngineTypes.pattern type:
+* a list of hypothesis (names of) together with the list of its matched
+* subterms (and their contexts) + the list of matched subterms of the
+* with their context conclusion. Note: in the result the list of hypothesis
+* has an entry for each entry in the context and in the same order.
+* Of course the list of terms (with their context) associated to the
+* hypothesis name may be empty. *)
+let select ~metasenv ~conjecture:(_,context,ty) ~pattern:(what,hyp_patterns,goal_pattern) =
+ let find_pattern_for name =
+ try Some (snd (List.find (fun (n, pat) -> Cic.Name n = name) hyp_patterns))
+ with Not_found -> None in
+ let ty_terms = select_in_term ~context ~term:ty ~pattern:(what,goal_pattern) in
+ let context_len = List.length context in
+ let context_terms =
+ fst
+ (List.fold_right
+ (fun entry (res,context) ->
+ match entry with
+ None -> (None::res),(None::context)
+ | Some (name,Cic.Decl term) ->
+ (match find_pattern_for name with
+ | None -> ((Some (`Decl []))::res),(entry::context)
+ | Some pat ->
+ try
+ let what =
+ match what with
+ None -> None
+ | Some what ->
+ let what,subst',metasenv' =
+ CicMetaSubst.delift_rels [] metasenv
+ (context_len - List.length context) what
+ in
+ assert (subst' = []);
+ assert (metasenv' = metasenv);
+ Some what in
+ let terms = select_in_term ~context ~term ~pattern:(what,pat) in
+ ((Some (`Decl terms))::res),(entry::context)
+ with
+ CicMetaSubst.DeliftingARelWouldCaptureAFreeVariable ->
+ raise
+ (Fail
+ ("The term the user wants to convert is not closed " ^
+ "in the context of the position of the substitution.")))
+ | Some (name,Cic.Def (bo, ty)) ->
+ (match find_pattern_for name with
+ | None ->
+ let selected_ty= match ty with None -> None | Some _ -> Some [] in
+ ((Some (`Def ([],selected_ty)))::res),(entry::context)
+ | Some pat ->
+ try
+ let what =
+ match what with
+ None -> None
+ | Some what ->
+ let what,subst',metasenv' =
+ CicMetaSubst.delift_rels [] metasenv
+ (context_len - List.length context) what
+ in
+ assert (subst' = []);
+ assert (metasenv' = metasenv);
+ Some what in
+ let terms_bo =
+ select_in_term ~context ~term:bo ~pattern:(what,pat) in
+ let terms_ty =
+ match ty with
+ None -> None
+ | Some ty ->
+ Some (select_in_term ~context ~term:ty ~pattern:(what,pat))
+ in
+ ((Some (`Def (terms_bo,terms_ty)))::res),(entry::context)
+ with
+ CicMetaSubst.DeliftingARelWouldCaptureAFreeVariable ->
+ raise
+ (Fail
+ ("The term the user wants to convert is not closed " ^
+ "in the context of the position of the substitution.")))
+ ) context ([],[]))
+ in
+ context_terms, ty_terms
projects / helm.git / blobdiff