Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

fix: add missing initHeartbeats #1037

Open
wants to merge 3 commits into
base: main
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
23 changes: 10 additions & 13 deletions Batteries/Tactic/Lint/Frontend.lean
Original file line number Diff line number Diff line change
Expand Up @@ -95,25 +95,22 @@ producing a list of results.
-/
def lintCore (decls : Array Name) (linters : Array NamedLinter) :
CoreM (Array (NamedLinter × Std.HashMap Name MessageData)) := do
let env ← getEnv
let options ← getOptions -- TODO: sanitize options?

let tasks : Array (NamedLinter × Array (Name × Task (Option MessageData))) ←
let tasks : Array (NamedLinter × Array (Name × Task (Except Exception <| Option MessageData))) ←
linters.mapM fun linter => do
let decls ← decls.filterM (shouldBeLinted linter.name)
(linter, ·) <$> decls.mapM fun decl => (decl, ·) <$> do
BaseIO.asTask do
match ← withCurrHeartbeats (linter.test decl)
|>.run' mkMetaContext -- We use the context used by `Command.liftTermElabM`
|>.run' {options, fileName := "", fileMap := default} {env}
|>.toBaseIO with
| Except.ok msg? => pure msg?
| Except.error err => pure m!"LINTER FAILED:\n{err.toMessageData}"
EIO.asTask <| ← Lean.Core.wrapAsync fun _ => do
(linter.test decl) |>.run' mkMetaContext
-- We use the context used by `Command.liftTermElabM`

tasks.mapM fun (linter, decls) => do
let mut msgs : Std.HashMap Name MessageData := {}
for (declName, msg?) in decls do
if let some msg := msg?.get then
for (declName, msgTask) in decls do
let msg? ← match msgTask.get with
| Except.ok msg? => pure msg?
| Except.error err => pure m!"LINTER FAILED:\n{err.toMessageData}"

if let .some msg := msg? then
msgs := msgs.insert declName msg
pure (linter, msgs)

Expand Down
22 changes: 9 additions & 13 deletions Batteries/Util/Cache.lean
Original file line number Diff line number Diff line change
Expand Up @@ -46,26 +46,22 @@ instance : Nonempty (Cache α) := inferInstanceAs <| Nonempty (IO.Ref _)
/-- Creates a cache with an initialization function. -/
def Cache.mk (init : MetaM α) : IO (Cache α) := IO.mkRef <| Sum.inl init

@[inherit_doc Core.wrapAsync]
def _root_.Lean.Meta.wrapAsync (act : Unit → MetaM α) : MetaM (EIO Exception α) := do
let metaCtx ← readThe Meta.Context
let metaSt ← getThe Meta.State
Core.wrapAsync fun _ =>
act () |>.run' metaCtx metaSt

/--
Access the cache. Calling this function for the first time will initialize the cache
with the function provided in the constructor.
-/
def Cache.get [Monad m] [MonadEnv m] [MonadLog m] [MonadOptions m] [MonadLiftT BaseIO m]
[MonadExcept Exception m] (cache : Cache α) : m α := do
def Cache.get (cache : Cache α) : MetaM α := do
let t ← match ← ST.Ref.get (m := BaseIO) cache with
| .inr t => pure t
| .inl init =>
let env ← getEnv
let fileName ← getFileName
let fileMap ← getFileMap
let options ← getOptions -- TODO: sanitize options?
-- Default heartbeats to a reasonable value.
-- otherwise exact? times out on mathlib
-- TODO: add customization option
let options := maxHeartbeats.set options <|
options.get? maxHeartbeats.name |>.getD 1000000
let res ← EIO.asTask <|
init {} |>.run' {} { options, fileName, fileMap } |>.run' { env }
let res ← EIO.asTask <| ← Meta.wrapAsync fun _ => init
cache.set (m := BaseIO) (.inr res)
pure res
match t.get with
Expand Down
Loading