diff --git a/src/Lean.lean b/src/Lean.lean index e026559b8b..5da1bb9c24 100644 --- a/src/Lean.lean +++ b/src/Lean.lean @@ -37,3 +37,4 @@ import Lean.Log import Lean.Linter import Lean.SubExpr import Lean.LabelAttribute +import Lean.AddDecl diff --git a/src/Lean/AddDecl.lean b/src/Lean/AddDecl.lean new file mode 100644 index 0000000000..4a203f01af --- /dev/null +++ b/src/Lean/AddDecl.lean @@ -0,0 +1,31 @@ +/- +Copyright (c) 2024 Amazon.com, Inc. or its affiliates. All Rights Reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Leonardo de Moura +-/ +prelude +import Lean.CoreM + +namespace Lean + +def Environment.addDecl (env : Environment) (opts : Options) (decl : Declaration) : Except KernelException Environment := + addDeclCore env (Core.getMaxHeartbeats opts).toUSize decl + +def Environment.addAndCompile (env : Environment) (opts : Options) (decl : Declaration) : Except KernelException Environment := do + let env ← addDecl env opts decl + compileDecl env opts decl + +def addDecl (decl : Declaration) : CoreM Unit := do + profileitM Exception "type checking" (← getOptions) do + withTraceNode `Kernel (fun _ => return m!"typechecking declaration") do + if !(← MonadLog.hasErrors) && decl.hasSorry then + logWarning "declaration uses 'sorry'" + match (← getEnv).addDecl (← getOptions) decl with + | .ok env => setEnv env + | .error ex => throwKernelException ex + +def addAndCompile (decl : Declaration) : CoreM Unit := do + addDecl decl + compileDecl decl + +end Lean diff --git a/src/Lean/Compiler/InitAttr.lean b/src/Lean/Compiler/InitAttr.lean index 4e723152fa..4bc0dd9b90 100644 --- a/src/Lean/Compiler/InitAttr.lean +++ b/src/Lean/Compiler/InitAttr.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Leonardo de Moura -/ prelude +import Lean.AddDecl import Lean.Elab.InfoTree.Main namespace Lean diff --git a/src/Lean/Compiler/Old.lean b/src/Lean/Compiler/Old.lean index 2ae6cc23b3..ef87e3ba7f 100644 --- a/src/Lean/Compiler/Old.lean +++ b/src/Lean/Compiler/Old.lean @@ -67,9 +67,4 @@ opaque compileDecls (env : Environment) (opt : @& Options) (decls : @& List Name def compileDecl (env : Environment) (opt : @& Options) (decl : @& Declaration) : Except KernelException Environment := compileDecls env opt (Compiler.getDeclNamesForCodeGen decl) - -def addAndCompile (env : Environment) (opt : Options) (decl : Declaration) : Except KernelException Environment := do - let env ← addDecl env decl - compileDecl env opt decl - end Environment diff --git a/src/Lean/CoreM.lean b/src/Lean/CoreM.lean index 5664bd3319..c92760026c 100644 --- a/src/Lean/CoreM.lean +++ b/src/Lean/CoreM.lean @@ -338,15 +338,6 @@ def mkArrow (d b : Expr) : CoreM Expr := /-- Iterated `mkArrow`, creates the expression `a₁ → a₂ → … → aₙ → b`. Also see `arrowDomainsN`. -/ def mkArrowN (ds : Array Expr) (e : Expr) : CoreM Expr := ds.foldrM mkArrow e -def addDecl (decl : Declaration) : CoreM Unit := do - profileitM Exception "type checking" (← getOptions) do - withTraceNode `Kernel (fun _ => return m!"typechecking declaration") do - if !(← MonadLog.hasErrors) && decl.hasSorry then - logWarning "declaration uses 'sorry'" - match (← getEnv).addDecl decl with - | Except.ok env => setEnv env - | Except.error ex => throwKernelException ex - private def supportedRecursors := #[``Empty.rec, ``False.rec, ``Eq.ndrec, ``Eq.rec, ``Eq.recOn, ``Eq.casesOn, ``False.casesOn, ``Empty.casesOn, ``And.rec, ``And.casesOn] @@ -400,10 +391,6 @@ def compileDecls (decls : List Name) : CoreM Unit := do | Except.error ex => throwKernelException ex -def addAndCompile (decl : Declaration) : CoreM Unit := do - addDecl decl; - compileDecl decl - def getDiag (opts : Options) : Bool := diagnostics.get opts diff --git a/src/Lean/Elab/BuiltinCommand.lean b/src/Lean/Elab/BuiltinCommand.lean index f04669e224..404ecab9bf 100644 --- a/src/Lean/Elab/BuiltinCommand.lean +++ b/src/Lean/Elab/BuiltinCommand.lean @@ -123,7 +123,7 @@ private partial def elabChoiceAux (cmds : Array Syntax) (i : Nat) : CommandElabM n[1].forArgsM addUnivLevel @[builtin_command_elab «init_quot»] def elabInitQuot : CommandElab := fun _ => do - match (← getEnv).addDecl Declaration.quotDecl with + match (← getEnv).addDecl (← getOptions) Declaration.quotDecl with | Except.ok env => setEnv env | Except.error ex => throwError (ex.toMessageData (← getOptions)) diff --git a/src/Lean/Environment.lean b/src/Lean/Environment.lean index 1bb99cd020..1ade563ad3 100644 --- a/src/Lean/Environment.lean +++ b/src/Lean/Environment.lean @@ -246,7 +246,7 @@ namespace Environment /-- Type check given declaration and add it to the environment -/ @[extern "lean_add_decl"] -opaque addDecl (env : Environment) (decl : @& Declaration) : Except KernelException Environment +opaque addDeclCore (env : Environment) (maxHeartbeats : USize) (decl : @& Declaration) : Except KernelException Environment end Environment diff --git a/src/Lean/Meta/Closure.lean b/src/Lean/Meta/Closure.lean index f50c360030..75827f2839 100644 --- a/src/Lean/Meta/Closure.lean +++ b/src/Lean/Meta/Closure.lean @@ -6,6 +6,7 @@ Authors: Leonardo de Moura prelude import Lean.MetavarContext import Lean.Environment +import Lean.AddDecl import Lean.Util.FoldConsts import Lean.Meta.Basic import Lean.Meta.Check diff --git a/src/Lean/Meta/Constructions.lean b/src/Lean/Meta/Constructions.lean index 4eabaf4885..2e4c9808d4 100644 --- a/src/Lean/Meta/Constructions.lean +++ b/src/Lean/Meta/Constructions.lean @@ -5,6 +5,7 @@ Authors: Leonardo de Moura -/ prelude import Lean.AuxRecursor +import Lean.AddDecl import Lean.Meta.AppBuilder namespace Lean diff --git a/src/Lean/Meta/Eqns.lean b/src/Lean/Meta/Eqns.lean index c3ecc055c5..8e29d7a04c 100644 --- a/src/Lean/Meta/Eqns.lean +++ b/src/Lean/Meta/Eqns.lean @@ -5,6 +5,7 @@ Authors: Leonardo de Moura -/ prelude import Lean.ReservedNameAction +import Lean.AddDecl import Lean.Meta.Basic import Lean.Meta.AppBuilder import Lean.Meta.Match.MatcherInfo diff --git a/src/Lean/Meta/Eval.lean b/src/Lean/Meta/Eval.lean index d4aa167213..8ad4784ec0 100644 --- a/src/Lean/Meta/Eval.lean +++ b/src/Lean/Meta/Eval.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Sebastian Ullrich, Leonardo de Moura -/ prelude +import Lean.AddDecl import Lean.Meta.Check namespace Lean.Meta diff --git a/src/Lean/Meta/SizeOf.lean b/src/Lean/Meta/SizeOf.lean index fa38b984cc..291301b8b4 100644 --- a/src/Lean/Meta/SizeOf.lean +++ b/src/Lean/Meta/SizeOf.lean @@ -5,6 +5,7 @@ Authors: Leonardo de Moura -/ prelude import Init.Data.List.BasicAux +import Lean.AddDecl import Lean.Meta.AppBuilder import Lean.Meta.Instances diff --git a/src/Lean/Meta/Tactic/AuxLemma.lean b/src/Lean/Meta/Tactic/AuxLemma.lean index eeb21b8c0d..744ff2b907 100644 --- a/src/Lean/Meta/Tactic/AuxLemma.lean +++ b/src/Lean/Meta/Tactic/AuxLemma.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Leonardo de Moura -/ prelude +import Lean.AddDecl import Lean.Meta.Basic namespace Lean.Meta diff --git a/src/Lean/Replay.lean b/src/Lean/Replay.lean index d44392191e..15bea755d9 100644 --- a/src/Lean/Replay.lean +++ b/src/Lean/Replay.lean @@ -5,6 +5,7 @@ Authors: Scott Morrison -/ prelude import Lean.CoreM +import Lean.AddDecl import Lean.Util.FoldConsts /-! @@ -56,7 +57,7 @@ def throwKernelException (ex : KernelException) : M Unit := do /-- Add a declaration, possibly throwing a `KernelException`. -/ def addDecl (d : Declaration) : M Unit := do - match (← get).env.addDecl d with + match (← get).env.addDecl {} d with | .ok env => modify fun s => { s with env := env } | .error ex => throwKernelException ex diff --git a/src/kernel/environment.cpp b/src/kernel/environment.cpp index d8316d5c9f..3e2d0be2ac 100644 --- a/src/kernel/environment.cpp +++ b/src/kernel/environment.cpp @@ -292,7 +292,8 @@ environment environment::add(declaration const & d, bool check) const { lean_unreachable(); } -extern "C" LEAN_EXPORT object * lean_add_decl(object * env, object * decl) { +extern "C" LEAN_EXPORT object * lean_add_decl(object * env, size_t max_heartbeat, object * decl) { + scope_max_heartbeat s(max_heartbeat); return catch_kernel_exceptions([&]() { return environment(env).add(declaration(decl, true)); }); diff --git a/src/runtime/interrupt.cpp b/src/runtime/interrupt.cpp index 13c242582a..6a0751ad57 100644 --- a/src/runtime/interrupt.cpp +++ b/src/runtime/interrupt.cpp @@ -26,7 +26,7 @@ size_t get_max_heartbeat() { return g_max_heartbeat; } void set_max_heartbeat_thousands(unsigned max) { g_max_heartbeat = static_cast(max) * 1000; } scope_heartbeat::scope_heartbeat(size_t max):flet(g_heartbeat, max) {} -scope_max_heartbeat::scope_max_heartbeat(size_t max):flet(g_max_heartbeat, max) {} +LEAN_EXPORT scope_max_heartbeat::scope_max_heartbeat(size_t max):flet(g_max_heartbeat, max) {} // separate definition to allow breakpoint in debugger void throw_heartbeat_exception() { diff --git a/src/runtime/interrupt.h b/src/runtime/interrupt.h index ccc6793193..0f6b10cc51 100644 --- a/src/runtime/interrupt.h +++ b/src/runtime/interrupt.h @@ -35,9 +35,9 @@ LEAN_EXPORT void set_max_heartbeat_thousands(unsigned max); LEAN_EXPORT size_t get_max_heartbeat(); /* Update the thread local max heartbeat */ -class scope_max_heartbeat : flet { +class LEAN_EXPORT scope_max_heartbeat : flet { public: - scope_max_heartbeat(size_t max); + LEAN_EXPORT scope_max_heartbeat(size_t max); }; LEAN_EXPORT void check_heartbeat(); diff --git a/tests/lean/partialIssue.lean b/tests/lean/partialIssue.lean index 55dc64c0d5..3684a969de 100644 --- a/tests/lean/partialIssue.lean +++ b/tests/lean/partialIssue.lean @@ -1,5 +1,5 @@ import Lean.CoreM - +import Lean.AddDecl #eval Lean.addDecl <| .mutualDefnDecl [{ name := `False_intro levelParams := [] diff --git a/tests/lean/run/kernel_maxheartbeats.lean b/tests/lean/run/kernel_maxheartbeats.lean new file mode 100644 index 0000000000..fa92ea48f9 --- /dev/null +++ b/tests/lean/run/kernel_maxheartbeats.lean @@ -0,0 +1,22 @@ +import Lean + +def ack : Nat → Nat → Nat + | 0, y => y+1 + | x+1, 0 => ack x 1 + | x+1, y+1 => ack x (ack (x+1) y) + +set_option maxHeartbeats 500 +open Lean Meta + +/-- +error: (kernel) deterministic timeout +-/ +#guard_msgs in +run_meta do + let type ← mkEq (← mkAppM ``ack #[mkNatLit 4, mkNatLit 4]) (mkNatLit 100000) + let value ← mkEqRefl (mkNatLit 100000) + addDecl <| .thmDecl { + name := `ack_4_4 + levelParams := [] + type, value + } diff --git a/tests/lean/run/structInstFast.lean b/tests/lean/run/structInstFast.lean index 38551a4aa0..ecc40bc43f 100644 --- a/tests/lean/run/structInstFast.lean +++ b/tests/lean/run/structInstFast.lean @@ -92,7 +92,12 @@ def foo : String := "foo" deep_wide_struct_inst_with String foo 50 20 -/- Structure instances using the `with` pattern should be fast. Without #2478, this takes over 700 - heartbeats. -/ -set_option maxHeartbeats 200 in +/- +Structure instances using the `with` pattern should be fast. +Without #2478, this takes over 700 heartbeats in the elaborator. + +Remark: we are now propagating heartbeats to the kernel, and +had to increase it value to 1000 + -/ +set_option maxHeartbeats 1000 in example : a0 = a'0 := rfl