...

[helm.git] / helm / software / components / cic_proof_checking / cicTypeChecker.ml

diff --git a/helm/software/components/cic_proof_checking/cicTypeChecker.ml b/helm/software/components/cic_proof_checking/cicTypeChecker.ml
index e3d9add620f0755fb19b7725eb66fe12c77eac88..289ef4b76dc91d5d1c89593c628b29f7e463094e 100644 (file)
--- a/helm/software/components/cic_proof_checking/cicTypeChecker.ml
+++ b/helm/software/components/cic_proof_checking/cicTypeChecker.ml
@@ -574,10 +574,9 @@ and typecheck_mutual_inductive_defs ~logger uri (itl,_,indparamsno) ugraph =
                with
                   Cic.Sort (Cic.Type u1), Cic.Sort (Cic.Type u2) 
                 | Cic.Sort (Cic.CProp u1), Cic.Sort (Cic.CProp u2) 
-                | Cic.Sort (Cic.Type u1), Cic.Sort (Cic.CProp u2) ->
-                   CicUniv.add_ge u2 u1 ugraph
+                | Cic.Sort (Cic.Type u1), Cic.Sort (Cic.CProp u2)
                 | Cic.Sort (Cic.CProp u1), Cic.Sort (Cic.Type u2) ->
-                   CicUniv.add_gt u2 u1 ugraph
+                   CicUniv.add_ge u2 u1 ugraph
                 | Cic.Sort _, Cic.Sort Cic.Prop
                 | Cic.Sort _, Cic.Sort Cic.CProp _
                 | Cic.Sort _, Cic.Sort Cic.Set
@@ -1367,6 +1366,13 @@ and type_of_aux' ~logger ?(subst = []) metasenv context t ugraph =
           in
             ((CicSubstitution.subst_meta l ty),ugraph1))
       (* TASSI: CONSTRAINTS *)
+    | C.Sort (C.CProp t) -> 
+       let t' = CicUniv.fresh() in
+       (try
+         let ugraph1 = CicUniv.add_gt t' t ugraph in
+           (C.Sort (C.Type t')),ugraph1
+        with
+         CicUniv.UniverseInconsistency msg -> raise (TypeCheckerFailure msg))
     | C.Sort (C.Type t) -> 
        let t' = CicUniv.fresh() in
        (try
@@ -1374,7 +1380,7 @@ and type_of_aux' ~logger ?(subst = []) metasenv context t ugraph =
            (C.Sort (C.Type t')),ugraph1
         with
          CicUniv.UniverseInconsistency msg -> raise (TypeCheckerFailure msg))
-    | C.Sort s -> (C.Sort (C.Type (CicUniv.fresh ()))),ugraph
+    | C.Sort (C.Prop|C.Set) -> (C.Sort (C.Type (CicUniv.fresh ()))),ugraph
     | C.Implicit _ -> raise (AssertFailure (lazy "Implicit found"))
     | C.Cast (te,ty) as t ->
        let _,ugraph1 = type_of_aux ~logger context ty ugraph in
@@ -1839,7 +1845,7 @@ end;
     | (C.Sort s1, C.Sort (C.Prop | C.Set)) ->
          (* different from Coq manual!!! *)
          t2',ugraph
-    | (C.Sort (C.Type t1), C.Sort (C.Type t2)) -> 
+    | (C.Sort (C.Type t1 | C.CProp t1), C.Sort (C.Type t2)) -> 
        let t' = CicUniv.fresh() in
         (try
          let ugraph1 = CicUniv.add_ge t' t1 ugraph in
@@ -1847,7 +1853,7 @@ end;
           C.Sort (C.Type t'),ugraph2
         with
          CicUniv.UniverseInconsistency msg -> raise (TypeCheckerFailure msg))
-    | (C.Sort (C.CProp t1), C.Sort (C.CProp t2)) -> 
+    | (C.Sort (C.CProp t1 | C.Type t1), C.Sort (C.CProp t2)) -> 
        let t' = CicUniv.fresh() in
         (try
          let ugraph1 = CicUniv.add_ge t' t1 ugraph in
@@ -1855,22 +1861,6 @@ end;
           C.Sort (C.CProp t'),ugraph2
         with
          CicUniv.UniverseInconsistency msg -> raise (TypeCheckerFailure msg))
-    | (C.Sort (C.Type t1), C.Sort (C.CProp t2)) -> 
-       let t' = CicUniv.fresh() in
-        (try
-         let ugraph1 = CicUniv.add_ge t' t1 ugraph in
-         let ugraph2 = CicUniv.add_ge t' t2 ugraph1 in
-          C.Sort (C.CProp t'),ugraph2
-        with
-         CicUniv.UniverseInconsistency msg -> raise (TypeCheckerFailure msg))
-    | (C.Sort (C.CProp t1), C.Sort (C.Type t2)) -> 
-       let t' = CicUniv.fresh() in
-        (try
-         let ugraph1 = CicUniv.add_gt t' t1 ugraph in
-         let ugraph2 = CicUniv.add_ge t' t2 ugraph1 in
-          C.Sort (C.Type t'),ugraph2
-        with
-         CicUniv.UniverseInconsistency msg -> raise (TypeCheckerFailure msg))
     | (C.Sort _,C.Sort (C.Type t1)) -> C.Sort (C.Type t1),ugraph 
     | (C.Sort _,C.Sort (C.CProp t1)) -> C.Sort (C.CProp t1),ugraph 
     | (C.Meta _, C.Sort _) -> t2',ugraph