- no longer build mathql per default

[helm.git] / helm / ocaml / cic_proof_checking / cicReduction.ml

diff --git a/helm/ocaml/cic_proof_checking/cicReduction.ml b/helm/ocaml/cic_proof_checking/cicReduction.ml
index 55ffb8edb99787b69b77fa2218caf8f96b0b21dd..14b858491d8c55c8e4c9010ecb5781836e796845 100644 (file)
--- a/helm/ocaml/cic_proof_checking/cicReduction.ml
+++ b/helm/ocaml/cic_proof_checking/cicReduction.ml
@@ -1066,6 +1066,7 @@ let rec normalize ?(delta=true) ?(subst=[]) ctx term =
       let s' = aux ctx s in
       C.LetIn (n, s, aux ((def n s')::ctx) t)
   | C.Appl (h::l) -> C.Appl (h::(List.map (aux ctx) l))
+  | C.Appl [] -> assert false
   | C.Const (uri,exp_named_subst) ->
       C.Const (uri, List.map (fun (n,t) -> n,aux ctx t) exp_named_subst)
   | C.MutInd (uri,typeno,exp_named_subst) ->
@@ -1079,9 +1080,25 @@ let rec normalize ?(delta=true) ?(subst=[]) ctx term =
   | C.CoFix _ -> t
 
 let normalize ?delta ?subst ctx term =  
-  prerr_endline ("NORMALIZE:" ^ CicPp.ppterm term); 
+(*  prerr_endline ("NORMALIZE:" ^ CicPp.ppterm term); *)
   let t = normalize ?delta ?subst ctx term in
-  prerr_endline ("NORMALIZED:" ^ CicPp.ppterm t); 
+(*  prerr_endline ("NORMALIZED:" ^ CicPp.ppterm t); *)
   t
   
   
+(* performs an head beta/cast reduction *)
+let rec head_beta_reduce =
+ function
+    (Cic.Appl (Cic.Lambda (_,_,t)::he'::tl')) ->
+      let he'' = CicSubstitution.subst he' t in
+       if tl' = [] then
+        he''
+       else
+        let he''' =
+         match he'' with
+            Cic.Appl l -> Cic.Appl (l@tl')
+          | _ -> Cic.Appl (he''::tl')
+        in
+         head_beta_reduce he'''
+  | Cic.Cast (te,_) -> head_beta_reduce te
+  | t -> t