refactor: use PersistentArray instead of Array for default [MonadTracer] implementation

Motivation: flexibility. Now, the default implementation is better
suited for code that uses traces nonlinearly (e.g., `TermElabM`).
This commit is contained in:
Leonardo de Moura 2019-12-22 07:36:26 -08:00
parent 80165d24a1
commit 050008cb84
2 changed files with 21 additions and 11 deletions

View file

@ -243,6 +243,9 @@ end
@[inline] def foldl {β} (t : PersistentArray α) (f : β → α → β) (b : β) : β :=
Id.run (t.foldlM f b)
def toArray (t : PersistentArray α) : Array α :=
t.foldl Array.push #[]
@[inline] def find? {β} (t : PersistentArray α) (f : α → (Option β)) : Option β :=
Id.run (t.findM? f)

View file

@ -18,8 +18,8 @@ class MonadTracerAdapter (m : Type → Type) :=
(isTracingEnabledFor {} : Name → m Bool)
(addContext {} : MessageData → m MessageData)
(enableTracing {} : Bool → m Bool)
(getTraces {} : m (Array MessageData))
(modifyTraces {} : (Array MessageData → Array MessageData) → m Unit)
(getTraces {} : m (PersistentArray MessageData))
(modifyTraces {} : (PersistentArray MessageData → PersistentArray MessageData) → m Unit)
namespace MonadTracerAdapter
@ -28,14 +28,14 @@ variables {m : Type → Type}
variables [Monad m] [MonadTracerAdapter m]
variables {α : Type}
private def addNode (oldTraces : Array MessageData) (cls : Name) : m Unit :=
private def addNode (oldTraces : PersistentArray MessageData) (cls : Name) : m Unit :=
modifyTraces $ fun traces =>
let d := MessageData.tagged cls (MessageData.node traces);
let d := MessageData.tagged cls (MessageData.node traces.toArray);
oldTraces.push d
private def getResetTraces : m (Array MessageData) := do
private def getResetTraces : m (PersistentArray MessageData) := do
oldTraces ← getTraces;
modifyTraces $ fun _ => #[];
modifyTraces $ fun _ => {};
pure oldTraces
def addTrace (cls : Name) (msg : MessageData) : m Unit := do
@ -93,13 +93,20 @@ instance monadTracerAdapterExcept {ε : Type} {m : Type → Type} [Monad m] [Mon
structure TraceState :=
(enabled : Bool := true)
(traces : Array MessageData := #[])
(traces : PersistentArray MessageData := {})
namespace TraceState
instance : Inhabited TraceState := ⟨{}⟩
instance : HasFormat TraceState := ⟨fun s => Format.joinArraySep s.traces Format.line⟩
private def toFormat (traces : PersistentArray MessageData) (sep : Format) : Format :=
traces.size.fold
(fun i r =>
let curr := format $ traces.get! i;
if i > 0 then r ++ sep ++ curr else r ++ curr)
Format.nil
instance : HasFormat TraceState := ⟨fun s => toFormat s.traces Format.line⟩
instance : HasToString TraceState := ⟨toString ∘ fmt⟩
@ -134,13 +141,13 @@ let oldEnabled := s.enabled;
modifyTraceState $ fun s => { enabled := b, .. s };
pure oldEnabled
@[inline] def getTraces : m (Array MessageData) := do
@[inline] def getTraces : m (PersistentArray MessageData) := do
s ← getTraceState; pure s.traces
@[inline] def modifyTraces (f : Array MessageData → Array MessageData) : m Unit :=
@[inline] def modifyTraces (f : PersistentArray MessageData → PersistentArray MessageData) : m Unit :=
modifyTraceState $ fun s => { traces := f s.traces, .. s }
@[inline] def setTrace (f : Array MessageData → Array MessageData) : m Unit :=
@[inline] def setTrace (f : PersistentArray MessageData → PersistentArray MessageData) : m Unit :=
modifyTraceState $ fun s => { traces := f s.traces, .. s }
@[inline] def setTraceState (s : TraceState) : m Unit :=