diff --git a/src/Init/Lean/Meta/ExprDefEq.lean b/src/Init/Lean/Meta/ExprDefEq.lean index e447f51ddb..e028e2a980 100644 --- a/src/Init/Lean/Meta/ExprDefEq.lean +++ b/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 diff --git a/src/Init/Lean/Meta/WHNF.lean b/src/Init/Lean/Meta/WHNF.lean index 61eff6c4f4..5975d794da 100644 --- a/src/Init/Lean/Meta/WHNF.lean +++ b/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 diff --git a/tests/lean/run/reduce1.lean b/tests/lean/run/reduce1.lean new file mode 100644 index 0000000000..06040b608f --- /dev/null +++ b/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