X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2FgTopLevel%2FlogicalOperations.ml;h=074e66c806da7ece2f4e1735603b3bc7378ee594;hb=b855d2cee134386df462125b5a395f0063c7a93e;hp=277451bf42ed2774e99c46303822c03f47f1dec0;hpb=e627ae3edfbe950b87069b625ec9317acaf03ec5;p=helm.git diff --git a/helm/gTopLevel/logicalOperations.ml b/helm/gTopLevel/logicalOperations.ml index 277451bf4..074e66c80 100644 --- a/helm/gTopLevel/logicalOperations.ml +++ b/helm/gTopLevel/logicalOperations.ml @@ -5,7 +5,6 @@ let get_parent id ids_to_terms ids_to_father_ids = ;; let get_context ids_to_terms ids_to_father_ids = - let module P = ProofEngine in let module C = Cic in let rec aux id = match get_parent id ids_to_terms ids_to_father_ids with @@ -20,15 +19,14 @@ let get_context ids_to_terms ids_to_father_ids = | C.Sort _ | C.Implicit | C.Cast _ -> [] - | C.Prod (n,s,t) when t == term -> [P.Declaration,n,s] + | C.Prod (n,s,t) when t == term -> [Some (n,C.Decl s)] | C.Prod _ -> [] - | C.Lambda (n,s,t) when t == term -> [P.Declaration,n,s] + | C.Lambda (n,s,t) when t == term -> [Some (n,C.Decl s)] | C.Lambda _ -> [] - | C.LetIn (n,s,t) when t == term -> [P.Definition,n,s] + | C.LetIn (n,s,t) when t == term -> [Some (n,C.Def s)] | C.LetIn _ -> [] | C.Appl _ | C.Const _ -> [] - | C.Abst _ -> assert false | C.MutInd _ | C.MutConstruct _ | C.MutCase _ -> [] @@ -37,7 +35,7 @@ let get_context ids_to_terms ids_to_father_ids = let counter = ref 0 in List.rev_map (function (name,_,ty,bo) -> - let res = (P.Definition, C.Name name, C.Fix (!counter,ifl)) in + let res = Some (C.Name name, (C.Def (C.Fix (!counter,ifl)))) in incr counter ; res ) ifl @@ -45,7 +43,7 @@ let get_context ids_to_terms ids_to_father_ids = let counter = ref 0 in List.rev_map (function (name,ty,bo) -> - let res = (P.Definition, C.Name name, C.CoFix (!counter,ifl)) in + let res = Some (C.Name name,(C.Def (C.CoFix (!counter,ifl)))) in incr counter ; res ) ifl @@ -57,33 +55,34 @@ let get_context ids_to_terms ids_to_father_ids = exception NotImplemented;; -(* It returns true iff the proof has been perforated, i.e. if a subterm *) -(* has been changed into a meta. *) +(* A subterm is changed into a fresh meta *) let to_sequent id ids_to_terms ids_to_father_ids = let module P = ProofEngine in let term = Hashtbl.find ids_to_terms id in let context = get_context ids_to_terms ids_to_father_ids id in - let type_checker_env_of_context = - List.map - (function - P.Declaration,_,t -> t - | P.Definition,_,_ -> raise NotImplemented - ) context + let metasenv = + match !P.proof with + None -> assert false + | Some (_,metasenv,_,_) -> metasenv + in + let ty = CicTypeChecker.type_of_aux' metasenv context term in + P.perforate context term ty (* P.perforate also sets the goal *) +;; + +exception FocusOnlyOnMeta;; + +(* If the current selection is a Meta, that Meta becomes the current goal *) +let focus id ids_to_terms ids_to_father_ids = + let module P = ProofEngine in + let term = Hashtbl.find ids_to_terms id in + let context = get_context ids_to_terms ids_to_father_ids id in + let metasenv = + match !P.proof with + None -> assert false + | Some (_,metasenv,_,_) -> metasenv in - let metasenv = - match !P.proof with - None -> assert false - | Some (_,metasenv,_,_) -> metasenv - in - let ty = - CicTypeChecker.type_of_aux' metasenv type_checker_env_of_context term - in - let (meta,perforated) = - (* If the selected term is already a meta, we return it. *) - (* Otherwise, we are trying to refine a non-meta term... *) - match term with - Cic.Meta n -> P.goal := Some (n,(context,ty)) ; n,false - | _ -> P.perforate context term ty,true (* P.perforate also sets the goal *) - in - perforated + let ty = CicTypeChecker.type_of_aux' metasenv context term in + match term with + Cic.Meta (n,_) -> P.goal := Some n + | _ -> raise FocusOnlyOnMeta ;;