feat: add baseExt environment extension for storing code generator results

This commit is contained in:
Leonardo de Moura 2022-09-21 17:47:50 -07:00
parent f9898a1d45
commit c52203ff57
5 changed files with 70 additions and 5 deletions

View file

@ -11,6 +11,7 @@ import Lean.Compiler.LCNF.ToDecl
import Lean.Compiler.LCNF.Check
import Lean.Compiler.LCNF.Stage1
import Lean.Compiler.LCNF.PullLetDecls
import Lean.Compiler.LCNF.PhaseExt
import Lean.Compiler.LCNF.CSE
namespace Lean.Compiler.LCNF
@ -67,7 +68,7 @@ def run (declNames : Array Name) : CompilerM (Array Decl) := withAtLeastMaxRecDe
if declNames.isEmpty then return #[]
let mut decls ← declNames.mapM toDecl
let mut manager := { passes := #[{ name := `init, run := pure, phase := .base }] }
let installers := PassInstaller.passInstallerExt.getState (←getEnv)
let installers := PassInstaller.passInstallerExt.getState (← getEnv)
manager ← installers.foldlM (init := manager) PassInstaller.runFromDecl
for pass in manager.passes do
trace[Compiler] s!"Running pass: {pass.name}"
@ -86,6 +87,10 @@ def compileStage1Impl (declNames : Array Name) : CoreM (Array Decl) :=
CompilerM.run do
PassManager.run declNames
def showDecl (phase : Phase) (declName : Name) : CoreM Format := do
let some decl ← getDecl? phase declName | return "<not-available>"
ppDecl' decl
builtin_initialize
registerTraceClass `Compiler.init (inherited := true)
registerTraceClass `Compiler.test (inherited := true)

View file

@ -73,9 +73,9 @@ structure PassManager where
namespace Phase
def toNat : Phase → Nat
| .base => 0
| .mono => 1
| .impure => 2
| .base => 0
| .mono => 1
| .impure => 2
instance : LT Phase where
lt l r := l.toNat < r.toNat

View file

@ -11,6 +11,7 @@ import Lean.Compiler.LCNF.PullFunDecls
import Lean.Compiler.LCNF.ReduceJpArity
import Lean.Compiler.LCNF.JoinPoints
import Lean.Compiler.LCNF.Specialize
import Lean.Compiler.LCNF.PhaseExt
namespace Lean.Compiler.LCNF
@ -24,7 +25,8 @@ namespace Lean.Compiler.LCNF
reduceJpArity,
simp { etaPoly := true, inlinePartial := true, implementedBy := true } (occurrence := 1),
specialize,
simp (occurrence := 2)
simp (occurrence := 2),
saveBase -- End of base phase
]
end Lean.Compiler.LCNF

View file

@ -0,0 +1,56 @@
/-
Copyright (c) 2022 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
import Lean.Compiler.LCNF.PassManager
namespace Lean.Compiler.LCNF
abbrev BaseExtState := Std.PHashMap Name Decl
private abbrev declLt (a b : Decl) :=
Name.quickLt a.name b.name
private abbrev sortDecls (decls : Array Decl) : Array Decl :=
decls.qsort declLt
private abbrev findAtSorted? (decls : Array Decl) (declName : Name) : Option Decl :=
let tmpDecl : Decl := default
let tmpDecl := { tmpDecl with name := declName }
decls.binSearch tmpDecl declLt
builtin_initialize baseExt : SimplePersistentEnvExtension Decl BaseExtState ← do
registerSimplePersistentEnvExtension {
name := `baseDecls
addImportedFn := fun _ => {}
addEntryFn := fun decls decl => decls.insert decl.name decl
toArrayFn := fun es => sortDecls es.toArray
}
def getBaseDeclCore? (env : Environment) (declName : Name) : Option Decl :=
match env.getModuleIdxFor? declName with
| some modIdx => findAtSorted? (baseExt.getModuleEntries env modIdx) declName
| none => dbg_trace "getBaseDeclCore?"; baseExt.getState env |>.find? declName
def getBaseDecl? (declName : Name) : CoreM (Option Decl) := do
IO.println s!">> getBaseDecl? {declName}"
return getBaseDeclCore? (← getEnv) declName
def saveBaseDeclCore (env : Environment) (decl : Decl) : Environment :=
baseExt.addEntry env decl
def Decl.saveBase (decl : Decl) : CoreM Unit := do
IO.println "saving"
IO.println decl.name
modifyEnv (saveBaseDeclCore · decl)
def getDecl? (phase : Phase) (declName : Name) : CoreM (Option Decl) :=
match phase with
| .base => getBaseDecl? declName
| _ => return none -- TODO
def saveBase : Pass :=
.mkPerDeclaration `saveBase (fun decl => do decl.saveBase; return decl) .base
end Lean.Compiler.LCNF

View file

@ -7,6 +7,8 @@ import Lean.CoreM
import Lean.MonadEnv
import Lean.Compiler.LCNF.Basic
-- TODO: delete this file
namespace Lean.Compiler.LCNF
structure Stage1ExtState where