]> matita.cs.unibo.it Git - helm.git/commitdiff
reference type made private, added mk_constructor to be used
authorEnrico Tassi <enrico.tassi@inria.fr>
Mon, 7 Apr 2008 09:57:46 +0000 (09:57 +0000)
committerEnrico Tassi <enrico.tassi@inria.fr>
Mon, 7 Apr 2008 09:57:46 +0000 (09:57 +0000)
to create the i-th constructor of an inductive type (used in match typechecking).

fixed name capture in oCic2nCic when typing fixpoint types

helm/software/components/ng_kernel/nCicTypeChecker.ml
helm/software/components/ng_kernel/nReference.ml
helm/software/components/ng_kernel/nReference.mli
helm/software/components/ng_kernel/oCic2NCic.ml

index ceb14d17c4145cd432ee4fc3290bb06c8fb1b082..46caae5acbed96d74038abd74ec7ebead2d80f43 100644 (file)
@@ -736,7 +736,7 @@ let rec typeof ~subst ~metasenv context term =
 *)
        eat_prods ~subst ~metasenv context ty_he args_with_ty
    | C.Appl _ -> raise (AssertFailure (lazy "Appl of length < 2"))
-   | C.Match (Ref.Ref (dummy_depth,uri,Ref.Ind tyno) as r,outtype,term,pl) ->
+   | C.Match (Ref.Ref (_,_,Ref.Ind tyno) as r,outtype,term,pl) ->
       let outsort = typeof_aux context outtype in
       let leftno = E.get_indty_leftno r in
       let parameters, arguments =
@@ -784,7 +784,7 @@ let rec typeof ~subst ~metasenv context term =
           (fun (j,b,old_p_ty,old_exp_p_ty) p ->
             if b then
               let cons = 
-                let cons = Ref.Ref (dummy_depth, uri, Ref.Con (tyno, j)) in
+                let cons = Ref.mk_constructor j r in
                 if parameters = [] then C.Const cons
                 else C.Appl (C.Const cons::parameters)
               in
@@ -804,7 +804,7 @@ let rec typeof ~subst ~metasenv context term =
          (TypeCheckerFailure 
           (lazy (Printf.sprintf ("Branch for constructor %s :=\n%s\n"^^
           "has type %s\nnot convertible with %s") (NCicPp.ppterm (C.Const 
-          (Ref.Ref (dummy_depth, uri, Ref.Con (tyno, j)))))
+          (Ref.mk_constructor j r)))
           (NCicPp.ppterm ~context (List.nth pl (j-1)))
           (NCicPp.ppterm ~context p_ty) (NCicPp.ppterm ~context exp_p_ty)))); 
       let res = outtype::arguments@[term] in
index d83fee65ab20ca6d67acefe078c0cfa295293a9e..4ecf746456504c3475fb206f7bba360aa10d3e7b 100644 (file)
@@ -113,9 +113,16 @@ let string_of_reference (Ref (_,u,indinfo)) =
   | Con (i,j) -> s2 ^ ".con(" ^ string_of_int i ^ "," ^ string_of_int j ^ ")"
 ;;
 
+let mk_constructor j = function
+  | Ref (d, u, Ind i) -> 
+      reference_of_string (string_of_reference (Ref (d, u, Con (i,j))))
+  | _ -> assert false
+;;
+
 let reference_of_ouri u indinfo =
   let u = NUri.nuri_of_ouri u in
   reference_of_string (string_of_reference (Ref (~-1,u,indinfo)))
 ;;
 
 let ouri_of_reference (Ref (_,u,_)) = NUri.ouri_of_nuri u;;
+
index 26145ee797b4a69ecb50b7ce6693e63d3927da2e..de468c3c10cdb67776fb877bab4b02af15bb4857 100644 (file)
@@ -21,11 +21,14 @@ type spec =
  | Ind of int
  | Con of int * int (* indtyno, constrno *)
 
-type reference = Ref of int *  NUri.uri * spec
+type reference = private Ref of int *  NUri.uri * spec
 
 val eq: reference -> reference -> bool
 val string_of_reference: reference -> string 
 
+(* given the reference of an inductive type, returns the i-th contructor *)
+val mk_constructor: int -> reference -> reference
+
 
 (* CACCA *)
 val reference_of_ouri: UriManager.uri -> spec ->  reference
index 2b59549d6178a36063c7feaebdea4275a08c5150..2244c12f826d84129facf7bc2a49fe5e493a442b 100644 (file)
@@ -113,13 +113,13 @@ let convert_term uri t =
         let rno = ref 0 in
         let bctx, fixpoints_tys, tys, _ = 
           List.fold_right 
-            (fun (name,recno,ty,_) (ctx, fixpoints, tys, idx) -> 
+            (fun (name,recno,ty,_) (bctx, fixpoints, tys, idx) -> 
               let ty, fixpoints_ty = aux octx ctx n_fix uri ty in
               if idx = k then rno := recno;
               let r = 
                 NReference.reference_of_ouri buri (NReference.Fix (idx,recno)) 
               in
-              Fix (r,name,ty) :: ctx, fixpoints_ty@fixpoints,ty::tys,idx+1)
+              Fix (r,name,ty) :: bctx, fixpoints_ty@fixpoints,ty::tys,idx+1)
             fl ([], [], [], 0)
         in
         let bctx = bctx @ ctx in