fixed parse error for ocaml 3.08

[helm.git] / helm / ocaml / cic / cicUtil.ml

diff --git a/helm/ocaml/cic/cicUtil.ml b/helm/ocaml/cic/cicUtil.ml
index fb40ad3ba123d6b28afb1dd1592ecc151016d8e7..29b03a07ea130a687d097e9d6a4d9228ef26c95c 100644 (file)
--- a/helm/ocaml/cic/cicUtil.ml
+++ b/helm/ocaml/cic/cicUtil.ml
@@ -24,12 +24,42 @@
  *)
 
 exception Meta_not_found of int
+exception Subst_not_found of int
+
 
 let lookup_meta index metasenv =
   try
     List.find (fun (index', _, _) -> index = index') metasenv
   with Not_found -> raise (Meta_not_found index)
 
+let lookup_subst n subst =
+  try
+    List.assoc n subst
+  with Not_found -> raise (Subst_not_found n)
+
+let exists_meta index = List.exists (fun (index', _, _) -> (index = index'))
+
+(* clean_up_meta take a substitution, a metasenv a meta_inex and a local
+context l and clean up l with respect to the hidden hipothesis in the 
+canonical context *)
+
+let clean_up_local_context subst metasenv n l =
+  let cc =
+    (try
+       let (cc,_) = lookup_subst n subst in cc
+     with Subst_not_found _ ->
+       try
+        let (_,cc,_) = lookup_meta n metasenv in cc
+       with Meta_not_found _ -> assert false) in
+  (try 
+     List.map2
+       (fun t1 t2 ->
+         match t1,t2 with 
+             None , _ -> None
+           | _ , t -> t) cc l
+   with 
+       Invalid_argument _ -> assert false)
+
 let is_closed =
  let module C = Cic in
  let rec is_closed k =
@@ -72,3 +102,42 @@ let is_closed =
 in 
  is_closed 0
 ;;
+
+(* CPS iterators on Cic.term ************************************************)
+
+let rec visit_l visit_t map f r = function
+   | []        -> f r
+   | h :: tail -> 
+      let f r = visit_l visit_t map f r tail in 
+      visit_t f r (map h) 
+
+let meta_closed t =
+   let rec visit_t f r = function
+      | Cic.Meta _                     -> raise Exit
+      | Cic.Implicit _
+      | Cic.Sort _      
+      | Cic.Rel _                      -> f r 
+      | Cic.Cast (t, u) 
+      | Cic.Prod (_, t, u) 
+      | Cic.Lambda (_, t, u) 
+      | Cic.LetIn (_, t, u)            -> 
+         let f r = visit_t f r u in visit_t f r t 
+      | Cic.Appl tl                    -> 
+         visit_l visit_t (fun x -> x) f r tl 
+      | Cic.Fix (_, tl)                ->  
+         let f r = visit_l visit_t (fun (_, _, _, u) -> u) f r tl in
+         visit_l visit_t (fun (_, _, t, _) -> t) f r tl
+      | Cic.CoFix (_, tl)              -> 
+         let f r = visit_l visit_t (fun (_, _, u) -> u) f r tl in
+         visit_l visit_t (fun (_, t, _) -> t) f r tl
+      | Cic.Var (k, tl)
+      | Cic.Const (k, tl)             
+      | Cic.MutInd (k, _, tl) 
+      | Cic.MutConstruct (k, _, _, tl) -> 
+         visit_l visit_t (fun (_, u) -> u) f r tl
+      | Cic.MutCase (_, _, t, u, tl)   -> 
+         let f r = visit_l visit_t (fun u -> u) f r tl in
+         let f r = visit_t f r u in
+         visit_t f r t
+   in    
+   try visit_t (fun x -> x) () t; false with Exit -> true