added comment for zack

[helm.git] / helm / software / components / ng_kernel / oCic2NCic.ml

diff --git a/helm/software/components/ng_kernel/oCic2NCic.ml b/helm/software/components/ng_kernel/oCic2NCic.ml
index 8e7cb7c21226de2ac743f3ef0548f7a7b16f1011..ee259877dc63f7cde0ec7ef6bb2a8f6664145ba6 100644 (file)
--- a/helm/software/components/ng_kernel/oCic2NCic.ml
+++ b/helm/software/components/ng_kernel/oCic2NCic.ml
@@ -22,6 +22,8 @@ let mk_type n =
      [false, NUri.uri_of_string ("cic:/matita/pts/Type"^string_of_int n^".univ")]
 ;;
 
+let cprop = [false, NUri.uri_of_string ("cic:/matita/pts/CProp.univ")];;
+
 (* porcatissima *)
 type reference = Ref of NUri.uri * NReference.spec
 let reference_of_ouri u indinfo =
@@ -40,6 +42,16 @@ let strictify =
   | Fix l -> `Fix (Lazy.force l)
 ;;
 
+let count_vars vars =
+ List.length 
+  (List.filter (fun v -> 
+     match fst (CicEnvironment.get_obj CicUniv.oblivion_ugraph v) with
+        Cic.Variable (_,Some _,_,_,_) -> false
+      | Cic.Variable (_,None,_,_,_) -> true
+      | _ -> assert false) vars)
+;;
+
+
 (***** A function to restrict the context of a term getting rid of unsed
        variables *******)
 
@@ -621,7 +633,7 @@ let convert_term uri t =
         let ty, fixpoints_ty = aux k octx ctx n_fix uri ty in
         NCic.LetIn ("cast", ty, t, NCic.Rel 1), fixpoints_t @ fixpoints_ty
     | Cic.Sort Cic.Prop -> NCic.Sort NCic.Prop,[]
-    | Cic.Sort Cic.CProp -> NCic.Sort NCic.CProp,[]
+    | Cic.Sort Cic.CProp -> NCic.Sort (NCic.Type cprop),[]
     | Cic.Sort (Cic.Type u) -> 
           NCic.Sort (NCic.Type (mk_type (CicUniv.get_rank u))),[] 
     | Cic.Sort Cic.Set -> NCic.Sort (NCic.Type (mk_type 0)),[] 
@@ -646,29 +658,34 @@ let convert_term uri t =
                NCic.Const (reference_of_ouri curi Ref.Decl)
         | _ -> assert false)
     | Cic.MutInd (curi, tyno, ens) -> 
-       let is_inductive =
+       let is_inductive, lno =
         match fst (CicEnvironment.get_obj CicUniv.oblivion_ugraph curi) with
-           Cic.InductiveDefinition ([],_,_,_) -> true
-         | Cic.InductiveDefinition ((_,b,_,_)::_,_,_,_) -> b
+           Cic.InductiveDefinition ([],vars,lno,_) -> true, lno + count_vars vars
+         | Cic.InductiveDefinition ((_,b,_,_)::_,vars,lno,_) -> b, lno + count_vars vars
          | _ -> assert false
        in
         aux_ens k curi octx ctx n_fix uri ens
-         (NCic.Const (reference_of_ouri curi (Ref.Ind (is_inductive,tyno))))
+         (NCic.Const (reference_of_ouri curi (Ref.Ind (is_inductive,tyno,lno))))
     | Cic.MutConstruct (curi, tyno, consno, ens) -> 
+       let lno =
+        match fst (CicEnvironment.get_obj CicUniv.oblivion_ugraph curi) with
+           Cic.InductiveDefinition (_,vars,lno,_) -> lno + count_vars vars
+         | _ -> assert false
+       in
        aux_ens k curi octx ctx n_fix uri ens
-        (NCic.Const (reference_of_ouri curi (Ref.Con (tyno,consno))))
+        (NCic.Const (reference_of_ouri curi (Ref.Con (tyno,consno,lno))))
     | Cic.Var (curi, ens) ->
        (match fst (CicEnvironment.get_obj CicUniv.oblivion_ugraph curi) with
            Cic.Variable (_,Some bo,_,_,_) ->
             aux k octx ctx n_fix uri (CicSubstitution.subst_vars ens bo)
          | _ -> assert false)
     | Cic.MutCase (curi, tyno, outty, t, branches) ->
-        let is_inductive =
+        let is_inductive,lno =
          match fst (CicEnvironment.get_obj CicUniv.oblivion_ugraph curi) with
-            Cic.InductiveDefinition ([],_,_,_) -> true
-          | Cic.InductiveDefinition ((_,b,_,_)::_,_,_,_) -> b
+            Cic.InductiveDefinition ([],vars,lno,_) -> true, lno + count_vars vars
+          | Cic.InductiveDefinition ((_,b,_,_)::_,vars,lno,_) -> b, lno + count_vars vars
           | _ -> assert false in
-        let r = reference_of_ouri curi (Ref.Ind (is_inductive,tyno)) in
+        let r = reference_of_ouri curi (Ref.Ind (is_inductive,tyno,lno)) in
         let outty, fixpoints_outty = aux k octx ctx n_fix uri outty in
         let t, fixpoints_t = aux k octx ctx n_fix uri t in
         let branches, fixpoints =
@@ -740,7 +757,8 @@ let cook mode vars t =
 
 let is_proof_irrelevant context ty =
   match
-    fst (CicTypeChecker.type_of_aux' [] context ty CicUniv.oblivion_ugraph)
+    CicReduction.whd context
+     (fst (CicTypeChecker.type_of_aux' [] context ty CicUniv.oblivion_ugraph))
   with
      Cic.Sort Cic.Prop -> true
    | Cic.Sort _ -> false
@@ -793,14 +811,7 @@ let convert_obj_aux uri = function
             (get_relevance ty, name, nty, cl)::itl, fix_ty @ fix_cl @ acc)
          itl ([],[])
      in
-     NCic.Inductive(ind, leftno + List.length 
-       (List.filter (fun v -> 
-          match fst (CicEnvironment.get_obj CicUniv.oblivion_ugraph v) with
-             Cic.Variable (_,Some _,_,_,_) -> false
-           | Cic.Variable (_,None,_,_,_) -> true
-           | _ -> assert false)
-          vars)
-       , itl, (`Provided, `Regular)),
+     NCic.Inductive(ind, leftno + count_vars vars, itl, (`Provided, `Regular)),
      fix_itl
  | Cic.Variable _ 
  | Cic.CurrentProof _ -> assert false