f2bb86f45c
@Kha @dselsam I was experiencing an insane code explosion with the previous approach. There were too many definitions marked with `@[specialize]`. `Meta.c` was reaching 0.5 million lines of code. We would need a more sophisticated code specializer cache to handle this kind of code. The new approach is much simpler. I don't see any major disadvantages.
89 lines
2.5 KiB
Text
89 lines
2.5 KiB
Text
/-
|
|
Copyright (c) 2019 Microsoft Corporation. All rights reserved.
|
|
Released under Apache 2.0 license as described in the file LICENSE.
|
|
Authors: Leonardo de Moura
|
|
-/
|
|
prelude
|
|
import Init.Lean.Meta.InferType
|
|
|
|
/-
|
|
This is not the Kernel type checker, but an auxiliary method for checking
|
|
whether terms produced by tactics and `isDefEq` are type correct.
|
|
-/
|
|
|
|
namespace Lean
|
|
namespace Meta
|
|
|
|
private def ensureType (e : Expr) : MetaM Unit :=
|
|
do getLevel e; pure ()
|
|
|
|
@[specialize] private def checkLambdaLet
|
|
(check : Expr → MetaM Unit)
|
|
(e : Expr) : MetaM Unit :=
|
|
lambdaTelescope e $ fun xs b => do
|
|
xs.forM $ fun x => do {
|
|
xDecl ← getFVarLocalDecl x;
|
|
match xDecl with
|
|
| LocalDecl.cdecl _ _ _ t _ => do
|
|
ensureType t;
|
|
check t
|
|
| LocalDecl.ldecl _ _ _ t v => do
|
|
ensureType t;
|
|
check t;
|
|
vType ← inferType v;
|
|
unlessM (isExprDefEqAux t vType) $ throwEx $ Exception.letTypeMismatch x.fvarId!;
|
|
check v
|
|
};
|
|
check b
|
|
|
|
@[specialize] private def checkForall
|
|
(check : Expr → MetaM Unit)
|
|
(e : Expr) : MetaM Unit :=
|
|
forallTelescope e $ fun xs b => do
|
|
xs.forM $ fun x => do {
|
|
xDecl ← getFVarLocalDecl x;
|
|
ensureType xDecl.type;
|
|
check xDecl.type
|
|
};
|
|
ensureType b;
|
|
check b
|
|
|
|
private def checkConstant (c : Name) (lvls : List Level) : MetaM Unit :=
|
|
do env ← getEnv;
|
|
match env.find c with
|
|
| none => throwEx $ Exception.unknownConst c
|
|
| some cinfo => unless (lvls.length != cinfo.lparams.length) $ throwEx $ Exception.incorrectNumOfLevels c lvls
|
|
|
|
@[specialize] private def checkApp
|
|
(check : Expr → MetaM Unit)
|
|
(f a : Expr) : MetaM Unit :=
|
|
do check f;
|
|
check a;
|
|
fType ← inferType f;
|
|
fType ← whnf fType;
|
|
match fType with
|
|
| Expr.forallE _ d _ _ => do
|
|
aType ← inferType a;
|
|
unlessM (isExprDefEqAux d aType) $ throwEx $ Exception.appTypeMismatch f a
|
|
| _ => unless fType.isForall $ throwEx $ Exception.functionExpected f a
|
|
|
|
private partial def checkAux : Expr → MetaM Unit
|
|
| e@(Expr.forallE _ _ _ _) => checkForall checkAux e
|
|
| e@(Expr.lam _ _ _ _) => checkLambdaLet checkAux e
|
|
| e@(Expr.letE _ _ _ _ _) => checkLambdaLet checkAux e
|
|
| Expr.const c lvls _ => checkConstant c lvls
|
|
| Expr.app f a _ => checkApp checkAux f a
|
|
| Expr.mdata _ e _ => checkAux e
|
|
| Expr.proj _ _ e _ => checkAux e
|
|
| _ => pure ()
|
|
|
|
def check (e : Expr) : MetaM Unit :=
|
|
usingTransparency TransparencyMode.all $ checkAux e
|
|
|
|
def isTypeCorrect (e : Expr) : MetaM Bool :=
|
|
catch
|
|
(do checkAux e; pure true)
|
|
(fun _ => pure false)
|
|
|
|
end Meta
|
|
end Lean
|