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.5