From c9995e146dc70bed25b9fe2913f3d5d31a4f9086 Mon Sep 17 00:00:00 2001
From: Claudio Sacerdoti Coen <claudio.sacerdoticoen@unibo.it>
Date: Thu, 26 Feb 2004 12:01:27 +0000
Subject: [PATCH] Optimization: since an invariant says that the inferred type
 of a term is 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).

---
 .../cic_proof_checking/cicTypeChecker.ml      | 19 +++++++++++++------
 helm/ocaml/cic_unification/cicRefine.ml       | 18 ++++++++++--------
 2 files changed, 23 insertions(+), 14 deletions(-)

diff --git a/helm/ocaml/cic_proof_checking/cicTypeChecker.ml b/helm/ocaml/cic_proof_checking/cicTypeChecker.ml
index 137f786ab..c4d62986e 100644
--- a/helm/ocaml/cic_proof_checking/cicTypeChecker.ml
+++ b/helm/ocaml/cic_proof_checking/cicTypeChecker.ml
@@ -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
diff --git a/helm/ocaml/cic_unification/cicRefine.ml b/helm/ocaml/cic_unification/cicRefine.ml
index 8935d867c..bc1468126 100644
--- a/helm/ocaml/cic_unification/cicRefine.ml
+++ b/helm/ocaml/cic_unification/cicRefine.ml
@@ -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
-- 
2.39.2