X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fcic%2FcicUtil.ml;h=81834251577822662c5121c70ea0cf98a11aaf5f;hb=4167cea65ca58897d1a3dbb81ff95de5074700cc;hp=149a9bc2e1f2b028c7c30dfb0ed0d2d30984bc0b;hpb=e2fb8962f72096d3f0bb19f40b00a3502a11e932;p=helm.git diff --git a/helm/ocaml/cic/cicUtil.ml b/helm/ocaml/cic/cicUtil.ml index 149a9bc2e..818342515 100644 --- a/helm/ocaml/cic/cicUtil.ml +++ b/helm/ocaml/cic/cicUtil.ml @@ -173,87 +173,6 @@ let uri_of_term = function (tyno + 1) consno) | _ -> raise (Invalid_argument "uri_of_term") -let select ~term ~context = - (* i is the number of binder traversed *) - let rec aux i context term = - match (context, term) with - | Cic.Implicit (Some `Hole), t -> [i,t] - | Cic.Implicit None,_ -> [] - | Cic.Meta (_, ctxt1), Cic.Meta (_, ctxt2) -> - List.concat - (List.map2 - (fun t1 t2 -> - (match (t1, t2) with Some t1, Some t2 -> aux i t1 t2 | _ -> [])) - ctxt1 ctxt2) - | Cic.Cast (te1, ty1), Cic.Cast (te2, ty2) -> aux i te1 te2 @ aux i ty1 ty2 - | Cic.Prod (_, s1, t1), Cic.Prod (_, s2, t2) - | Cic.Lambda (_, s1, t1), Cic.Lambda (_, s2, t2) - | Cic.LetIn (_, s1, t1), Cic.LetIn (_, s2, t2) -> - aux i s1 s2 @ aux (i+1) t1 t2 - | Cic.Appl terms1, Cic.Appl terms2 -> auxs i terms1 terms2 - | Cic.Var (_, subst1), Cic.Var (_, subst2) - | Cic.Const (_, subst1), Cic.Const (_, subst2) - | Cic.MutInd (_, _, subst1), Cic.MutInd (_, _, subst2) - | Cic.MutConstruct (_, _, _, subst1), Cic.MutConstruct (_, _, _, subst2) -> - auxs i (List.map snd subst1) (List.map snd subst2) - | Cic.MutCase (_, _, out1, t1, pat1), Cic.MutCase (_ , _, out2, t2, pat2) -> - aux i out1 out2 @ aux i t1 t2 @ auxs i pat1 pat2 - | Cic.Fix (_, funs1), Cic.Fix (_, funs2) -> - List.concat - (List.map2 - (fun (_, _, ty1, bo1) (_, _, ty2, bo2) -> - aux i ty1 ty2 @ aux i bo1 bo2) - funs1 funs2) - | Cic.CoFix (_, funs1), Cic.CoFix (_, funs2) -> - List.concat - (List.map2 - (fun (_, ty1, bo1) (_, ty2, bo2) -> aux i ty1 ty2 @ aux i bo1 bo2) - funs1 funs2) - | _ -> assert false - and auxs i terms1 terms2 = (* as aux for list of terms *) - List.concat (List.map2 (fun t1 t2 -> aux i t1 t2) terms1 terms2) - in - aux 0 context term - -let context_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 (* let pack terms = @@ -290,18 +209,21 @@ let rec mk_rels howmany from = | 0 -> [] | _ -> (Cic.Rel (howmany + from)) :: (mk_rels (howmany-1) from) -let profile = - function s -> - let total = ref 0.0 in - let profile f x = - let before = Unix.gettimeofday () in - let res = f x in - let after = Unix.gettimeofday () in - total := !total +. (after -. before); - res - in - at_exit - (fun () -> - print_endline - ("!! TOTAL TIME SPENT IN " ^ s ^ ": " ^ string_of_float !total)); - profile +let id_of_annterm = + function + | Cic.ARel (id,_,_,_) + | Cic.AVar (id,_,_) + | Cic.AMeta (id,_,_) + | Cic.ASort (id,_) + | Cic.AImplicit (id,_) + | Cic.ACast (id,_,_) + | Cic.AProd (id,_,_,_) + | Cic.ALambda (id,_,_,_) + | Cic.ALetIn (id,_,_,_) + | Cic.AAppl (id,_) + | Cic.AConst (id,_,_) + | Cic.AMutInd (id,_,_,_) + | Cic.AMutConstruct (id,_,_,_,_) + | Cic.AMutCase (id,_,_,_,_,_) + | Cic.AFix (id,_,_) + | Cic.ACoFix (id,_,_) -> id