feat: add support for Lean.reduceNat and Lean.reduceBool at MetaM isDefEq

src/Init/Lean/Meta/ExprDefEq.lean

@@ -36,6 +36,18 @@ if a.isLambda && !b.isLambda then do
 else
   pure false
 
+/-- Support for `Lean.reduceBool` and `Lean.reduceNat` -/
+def isDefEqNative (s t : Expr) : MetaM LBool := do
+let isDefEq (s t) : MetaM LBool := toLBoolM $ isExprDefEqAux s t;
+s? ← reduceNative? s;
+match s? with
+| some s => isDefEq s t
+| none => do
+  t? ← reduceNative? t;
+  match t? with
+  | some t => isDefEq s t
+  | none   => pure LBool.undef
+
 /--
   Return `true` if `e` is of the form `fun (x_1 ... x_n) => ?m x_1 ... x_n)`, and `?m` is unassigned.
   Remark: `n` may be 0. -/
@@ -990,6 +1002,7 @@ partial def isExprDefEqAuxImpl : Expr → Expr → MetaM Bool
   whenUndefDo (isDefEqProofIrrel t s) $
   isDefEqWHNF t s $ fun t s => do
   condM (isDefEqEta t s <||> isDefEqEta s t) (pure true) $
+  whenUndefDo (isDefEqNative t s) $ do
   whenUndefDo (isDefEqOffset t s) $ do
   whenUndefDo (isDefEqDelta t s) $
   match t, s with

src/Init/Lean/Meta/WHNF.lean

@@ -21,13 +21,41 @@ Lean.WHNF.unfoldDefinitionAux getConstNoEx isAuxDef? whnf inferType isExprDefEq
 def whnfCore (e : Expr) : MetaM Expr :=
 Lean.WHNF.whnfCore getConstNoEx isAuxDef? whnf inferType isExprDefEqAux getLocalDecl getExprMVarAssignment? e
 
+unsafe def reduceNativeConst (α : Type) (typeName : Name) (constName : Name) : MetaM α := do
+env ← getEnv;
+match env.evalConstCheck α typeName constName with
+| Except.error ex => throw $ Exception.other ex
+| Except.ok v     => pure v
+
+unsafe def reduceBoolNativeUnsafe (constName : Name) : MetaM Bool := reduceNativeConst Bool `Bool constName
+unsafe def reduceNatNativeUnsafe (constName : Name) : MetaM Nat := reduceNativeConst Nat `Nat constName
+@[implementedBy reduceBoolNativeUnsafe] constant reduceBoolNative (constName : Name) : MetaM Bool := arbitrary _
+@[implementedBy reduceNatNativeUnsafe] constant reduceNatNative (constName : Name) : MetaM Nat := arbitrary _
+
+def reduceNative? (e : Expr) : MetaM (Option Expr) :=
+match e with
+| Expr.app (Expr.const fName _ _) (Expr.const argName _ _) _ =>
+  if fName == `Lean.reduceBool then do
+    b ← reduceBoolNative argName;
+    pure $ if b then some $ mkConst `Bool.true else some $ mkConst `Bool.false
+  else if fName == `Lean.reduceNat then do
+    n ← reduceNatNative argName;
+    pure $ some $ mkNatLit n
+  else
+    pure none
+| _ => pure none
+
 partial def whnfImpl : Expr → MetaM Expr
 | e => Lean.WHNF.whnfEasyCases getLocalDecl getExprMVarAssignment? e $ fun e => do
   e ← whnfCore e;
-  e? ← unfoldDefinition? e;
-  match e? with
-  | some e => whnfImpl e
-  | none   => pure e
+  v? ← reduceNative? e;
+  match v? with
+  | some v => pure v
+  | none => do
+    e? ← unfoldDefinition? e;
+    match e? with
+    | some e => whnfImpl e
+    | none   => pure e
 
 @[init] def setWHNFRef : IO Unit :=
 whnfRef.set whnfImpl

tests/lean/run/reduce1.lean

@@ -0,0 +1,17 @@
+def fact : Nat → Nat
+| 0     => 1
+| (n+1) => (n+1)*fact n
+
+#eval fact 10
+
+new_frontend
+
+def v1 : Nat := fact 10
+
+theorem tst1 : Lean.reduceNat v1 = 3628800 :=
+rfl
+
+def v2 : Bool := 10000000000000000 < 200000000000000000000
+
+theorem tst2 : Lean.reduceBool v2 = true :=
+rfl