]> matita.cs.unibo.it Git - helm.git/commitdiff
Optimization: since an invariant says that the inferred type of a term is
authorClaudio Sacerdoti Coen <claudio.sacerdoticoen@unibo.it>
Thu, 26 Feb 2004 12:01:27 +0000 (12:01 +0000)
committerClaudio Sacerdoti Coen <claudio.sacerdoticoen@unibo.it>
Thu, 26 Feb 2004 12:01:27 +0000 (12:01 +0000)
always a type, then we do not have to call the sort_of_prod to check the
the type of a lambda-abstraction is a well-typed prod. We just have to check
that the source of the lambda is a sort (or a meta).

helm/ocaml/cic_proof_checking/cicTypeChecker.ml
helm/ocaml/cic_unification/cicRefine.ml

index 137f786ab1fc003e7432605ee82116a0e9d6093c..c4d62986e100a84f7800a6cc99beaaf75179ebc8 100644 (file)
@@ -1370,12 +1370,19 @@ and type_of_aux' metasenv context t =
        and sort2 = type_of_aux ((Some (name,(C.Decl s)))::context) t in
         sort_of_prod context (name,s) (sort1,sort2)
    | C.Lambda (n,s,t) ->
-       let sort1 = type_of_aux context s
-       and type2 = type_of_aux ((Some (n,(C.Decl s)))::context) t in
-        let sort2 = type_of_aux ((Some (n,(C.Decl s)))::context) type2 in
-         (* only to check if the product is well-typed *)
-         let _ = sort_of_prod context (n,s) (sort1,sort2) in
-          C.Prod (n,s,type2)
+       let sort1 = type_of_aux context s in
+       (match R.whd context sort1 with
+           C.Meta _
+         | C.Sort _ -> ()
+         | _ ->
+           raise
+            (TypeCheckerFailure (sprintf
+              "Not well-typed lambda-abstraction: the source %s should be a
+               type; instead it is a term of type %s" (CicPp.ppterm s)
+                (CicPp.ppterm sort1)))
+       ) ;
+       let type2 = type_of_aux ((Some (n,(C.Decl s)))::context) t in
+        C.Prod (n,s,type2)
    | C.LetIn (n,s,t) ->
       (* only to check if s is well-typed *)
       let ty = type_of_aux context s in
index 8935d867c570628f4f80d70eac72e9c30ce564cd..bc14681263b80497477efc5294ea38f710d9b11f 100644 (file)
@@ -185,17 +185,19 @@ and type_of_aux' metasenv context t =
         sort_of_prod subst'' metasenv'' context (name,s) (sort1,sort2)
    | C.Lambda (n,s,t) ->
        let sort1,subst',metasenv' = type_of_aux subst metasenv context s in
+       (match CicMetaSubst.whd subst' context sort1 with
+           C.Meta _
+         | C.Sort _ -> ()
+         | _ ->
+           raise (NotRefinable (sprintf
+            "Not well-typed lambda-abstraction: the source %s should be a type;
+             instead it is a term of type %s" (CicPp.ppterm s)
+            (CicPp.ppterm sort1)))
+       ) ;
        let type2,subst'',metasenv'' =
         type_of_aux subst' metasenv' ((Some (n,(C.Decl s)))::context) t
        in
-        let sort2,subst''',metasenv''' =
-         type_of_aux subst'' metasenv''((Some (n,(C.Decl s)))::context) type2
-        in
-         (* only to check if the product is well-typed *)
-         let _,subst'''',metasenv'''' =
-          sort_of_prod subst''' metasenv''' context (n,s) (sort1,sort2)
-         in
-          C.Prod (n,s,type2),subst'''',metasenv''''
+          C.Prod (n,s,type2),subst'',metasenv''
    | C.LetIn (n,s,t) ->
       (* only to check if s is well-typed *)
       let ty,subst',metasenv' = type_of_aux subst metasenv context s in