82 lines
2.6 KiB
Text
82 lines
2.6 KiB
Text
import Init.Lean.Meta
|
|
open Lean
|
|
open Lean.Meta
|
|
|
|
def dbgOpt : Options :=
|
|
let opt : Options := {};
|
|
let opt := opt.setBool `trace.Meta true;
|
|
-- let opt := opt.setBool `trace.Meta.check false;
|
|
opt
|
|
|
|
def print (msg : MessageData) : MetaM Unit :=
|
|
trace! `Meta.debug msg
|
|
|
|
def check (x : MetaM Bool) : MetaM Unit :=
|
|
unlessM x $ throw $ Exception.other "check failed"
|
|
|
|
def run (mods : List Name) (x : MetaM Unit) (opts : Options := dbgOpt) : IO Unit :=
|
|
do env ← importModules $ mods.map $ fun m => {module := m};
|
|
match x { config := { opts := opts } } { env := env } with
|
|
| EStateM.Result.ok _ s => do
|
|
s.traceState.traces.forM $ fun m => IO.println $ format m;
|
|
pure ()
|
|
| EStateM.Result.error err s => do
|
|
s.traceState.traces.forM $ fun m => IO.println $ format m;
|
|
throw (IO.userError (toString err))
|
|
|
|
def tst1 : MetaM Unit :=
|
|
do print "----- tst1 -----";
|
|
let nat := mkConst `Nat;
|
|
mvar ← mkFreshExprMVar nat;
|
|
check $ isExprDefEq mvar (mkNatLit 10);
|
|
check $ isExprDefEq mvar (mkNatLit 10);
|
|
pure ()
|
|
|
|
#eval run [`Init.Data.Nat] tst1
|
|
|
|
def tst2 : MetaM Unit :=
|
|
do print "----- tst2 -----";
|
|
let nat := mkConst `Nat;
|
|
let succ := mkConst `Nat.succ;
|
|
mvar ← mkFreshExprMVar nat;
|
|
check $ isExprDefEq (mkApp succ mvar) (mkApp succ (mkNatLit 10));
|
|
check $ isExprDefEq mvar (mkNatLit 10);
|
|
pure ()
|
|
|
|
#eval run [`Init.Data.Nat] tst2
|
|
|
|
def tst3 : MetaM Unit :=
|
|
do print "----- tst3 -----";
|
|
let nat := mkConst `Nat;
|
|
let add := mkConst `Nat.add;
|
|
let t := mkLambda `x BinderInfo.default nat $ mkBVar 0;
|
|
mvar ← mkFreshExprMVar (mkForall `x BinderInfo.default nat nat);
|
|
lambdaTelescope t $ fun xs _ => do {
|
|
let x := xs.get! 0;
|
|
check $ isExprDefEq (mkApp mvar x) (mkAppN add #[x, mkAppN add #[mkNatLit 10, x]]);
|
|
pure ()
|
|
};
|
|
some v ← getExprMVarAssignment mvar.mvarId! | pure ();
|
|
print v;
|
|
pure ()
|
|
|
|
#eval run [`Init.Data.Nat] tst3
|
|
|
|
def tst4 : MetaM Unit :=
|
|
do print "----- tst4 -----";
|
|
let nat := mkConst `Nat;
|
|
let add := mkConst `Nat.add;
|
|
let t := mkLambda `x BinderInfo.default nat $ mkBVar 0;
|
|
lambdaTelescope t $ fun xs _ => do {
|
|
let x := xs.get! 0;
|
|
mvar ← mkFreshExprMVar (mkForall `x BinderInfo.default nat nat);
|
|
-- the following `isExprDefEq` fails because `x` is also in the context of `mvar`
|
|
check $ not <$> isExprDefEq (mkApp mvar x) (mkAppN add #[x, mkAppN add #[mkNatLit 10, x]]);
|
|
check $ approxDefEq $ isExprDefEq (mkApp mvar x) (mkAppN add #[x, mkAppN add #[mkNatLit 10, x]]);
|
|
some v ← getExprMVarAssignment mvar.mvarId! | pure ();
|
|
print v;
|
|
pure ()
|
|
};
|
|
pure ()
|
|
|
|
#eval run [`Init.Data.Nat] tst4
|