809 lines
35 KiB
Text
809 lines
35 KiB
Text
/-
|
||
Copyright (c) 2019 Microsoft Corporation. All rights reserved.
|
||
Released under Apache 2.0 license as described in the file LICENSE.
|
||
Authors: Leonardo de Moura
|
||
-/
|
||
import Std.Data.HashMap
|
||
import Lean.ImportingFlag
|
||
import Lean.Data.SMap
|
||
import Lean.Declaration
|
||
import Lean.LocalContext
|
||
import Lean.Util.Path
|
||
import Lean.Util.FindExpr
|
||
import Lean.Util.Profile
|
||
|
||
namespace Lean
|
||
/- Opaque environment extension state. -/
|
||
constant EnvExtensionStateSpec : (α : Type) × Inhabited α := ⟨Unit, ⟨()⟩⟩
|
||
def EnvExtensionState : Type := EnvExtensionStateSpec.fst
|
||
instance : Inhabited EnvExtensionState := EnvExtensionStateSpec.snd
|
||
|
||
def ModuleIdx := Nat
|
||
|
||
instance : Inhabited ModuleIdx := inferInstanceAs (Inhabited Nat)
|
||
|
||
abbrev ConstMap := SMap Name ConstantInfo
|
||
|
||
structure Import where
|
||
module : Name
|
||
runtimeOnly : Bool := false
|
||
|
||
instance : ToString Import := ⟨fun imp => toString imp.module ++ if imp.runtimeOnly then " (runtime)" else ""⟩
|
||
|
||
/--
|
||
A compacted region holds multiple Lean objects in a contiguous memory region, which can be read/written to/from disk.
|
||
Objects inside the region do not have reference counters and cannot be freed individually. The contents of .olean
|
||
files are compacted regions. -/
|
||
def CompactedRegion := USize
|
||
|
||
@[extern "lean_compacted_region_is_memory_mapped"]
|
||
constant CompactedRegion.isMemoryMapped : CompactedRegion → Bool
|
||
|
||
/-- Free a compacted region and its contents. No live references to the contents may exist at the time of invocation. -/
|
||
@[extern "lean_compacted_region_free"]
|
||
unsafe constant CompactedRegion.free : CompactedRegion → IO Unit
|
||
|
||
/- Opaque persistent environment extension entry. -/
|
||
constant EnvExtensionEntrySpec : NonemptyType.{0}
|
||
def EnvExtensionEntry : Type := EnvExtensionEntrySpec.type
|
||
instance : Nonempty EnvExtensionEntry := EnvExtensionEntrySpec.property
|
||
|
||
/- Content of a .olean file.
|
||
We use `compact.cpp` to generate the image of this object in disk. -/
|
||
structure ModuleData where
|
||
imports : Array Import
|
||
constants : Array ConstantInfo
|
||
entries : Array (Name × Array EnvExtensionEntry)
|
||
deriving Inhabited
|
||
|
||
/- Environment fields that are not used often. -/
|
||
structure EnvironmentHeader where
|
||
trustLevel : UInt32 := 0
|
||
quotInit : Bool := false
|
||
mainModule : Name := default
|
||
imports : Array Import := #[] -- direct imports
|
||
regions : Array CompactedRegion := #[] -- compacted regions of all imported modules
|
||
moduleNames : Array Name := #[] -- names of all imported modules
|
||
moduleData : Array ModuleData := #[] -- ModuleData of all imported modules
|
||
deriving Inhabited
|
||
|
||
open Std (HashMap)
|
||
|
||
structure Environment where
|
||
const2ModIdx : HashMap Name ModuleIdx
|
||
constants : ConstMap
|
||
extensions : Array EnvExtensionState
|
||
header : EnvironmentHeader := {}
|
||
deriving Inhabited
|
||
|
||
namespace Environment
|
||
|
||
def addAux (env : Environment) (cinfo : ConstantInfo) : Environment :=
|
||
{ env with constants := env.constants.insert cinfo.name cinfo }
|
||
|
||
@[export lean_environment_find]
|
||
def find? (env : Environment) (n : Name) : Option ConstantInfo :=
|
||
/- It is safe to use `find'` because we never overwrite imported declarations. -/
|
||
env.constants.find?' n
|
||
|
||
def contains (env : Environment) (n : Name) : Bool :=
|
||
env.constants.contains n
|
||
|
||
def imports (env : Environment) : Array Import :=
|
||
env.header.imports
|
||
|
||
def allImportedModuleNames (env : Environment) : Array Name :=
|
||
env.header.moduleNames
|
||
|
||
@[export lean_environment_set_main_module]
|
||
def setMainModule (env : Environment) (m : Name) : Environment :=
|
||
{ env with header := { env.header with mainModule := m } }
|
||
|
||
@[export lean_environment_main_module]
|
||
def mainModule (env : Environment) : Name :=
|
||
env.header.mainModule
|
||
|
||
@[export lean_environment_mark_quot_init]
|
||
private def markQuotInit (env : Environment) : Environment :=
|
||
{ env with header := { env.header with quotInit := true } }
|
||
|
||
@[export lean_environment_quot_init]
|
||
private def isQuotInit (env : Environment) : Bool :=
|
||
env.header.quotInit
|
||
|
||
@[export lean_environment_trust_level]
|
||
private def getTrustLevel (env : Environment) : UInt32 :=
|
||
env.header.trustLevel
|
||
|
||
def getModuleIdxFor? (env : Environment) (declName : Name) : Option ModuleIdx :=
|
||
env.const2ModIdx.find? declName
|
||
|
||
def isConstructor (env : Environment) (declName : Name) : Bool :=
|
||
match env.find? declName with
|
||
| ConstantInfo.ctorInfo _ => true
|
||
| _ => false
|
||
|
||
def getModuleIdx? (env : Environment) (moduleName : Name) : Option ModuleIdx :=
|
||
env.header.moduleNames.findIdx? (. == moduleName)
|
||
|
||
end Environment
|
||
|
||
inductive KernelException where
|
||
| unknownConstant (env : Environment) (name : Name)
|
||
| alreadyDeclared (env : Environment) (name : Name)
|
||
| declTypeMismatch (env : Environment) (decl : Declaration) (givenType : Expr)
|
||
| declHasMVars (env : Environment) (name : Name) (expr : Expr)
|
||
| declHasFVars (env : Environment) (name : Name) (expr : Expr)
|
||
| funExpected (env : Environment) (lctx : LocalContext) (expr : Expr)
|
||
| typeExpected (env : Environment) (lctx : LocalContext) (expr : Expr)
|
||
| letTypeMismatch (env : Environment) (lctx : LocalContext) (name : Name) (givenType : Expr) (expectedType : Expr)
|
||
| exprTypeMismatch (env : Environment) (lctx : LocalContext) (expr : Expr) (expectedType : Expr)
|
||
| appTypeMismatch (env : Environment) (lctx : LocalContext) (app : Expr) (funType : Expr) (argType : Expr)
|
||
| invalidProj (env : Environment) (lctx : LocalContext) (proj : Expr)
|
||
| other (msg : String)
|
||
|
||
namespace Environment
|
||
|
||
/- Type check given declaration and add it to the environment -/
|
||
@[extern "lean_add_decl"]
|
||
constant addDecl (env : Environment) (decl : @& Declaration) : Except KernelException Environment
|
||
|
||
/- Compile the given declaration, it assumes the declaration has already been added to the environment using `addDecl`. -/
|
||
@[extern "lean_compile_decl"]
|
||
constant compileDecl (env : Environment) (opt : @& Options) (decl : @& Declaration) : Except KernelException Environment
|
||
|
||
def addAndCompile (env : Environment) (opt : Options) (decl : Declaration) : Except KernelException Environment := do
|
||
let env ← addDecl env decl
|
||
compileDecl env opt decl
|
||
|
||
end Environment
|
||
|
||
/- Interface for managing environment extensions. -/
|
||
structure EnvExtensionInterface where
|
||
ext : Type → Type
|
||
inhabitedExt {σ} : Inhabited σ → Inhabited (ext σ)
|
||
registerExt {σ} (mkInitial : IO σ) : IO (ext σ)
|
||
setState {σ} (e : ext σ) (env : Environment) : σ → Environment
|
||
modifyState {σ} (e : ext σ) (env : Environment) : (σ → σ) → Environment
|
||
getState {σ} [Inhabited σ] (e : ext σ) (env : Environment) : σ
|
||
mkInitialExtStates : IO (Array EnvExtensionState)
|
||
ensureExtensionsSize : Environment → IO Environment
|
||
|
||
instance : Inhabited EnvExtensionInterface where
|
||
default := {
|
||
ext := id
|
||
inhabitedExt := id
|
||
ensureExtensionsSize := fun env => pure env
|
||
registerExt := fun mk => mk
|
||
setState := fun _ env _ => env
|
||
modifyState := fun _ env _ => env
|
||
getState := fun ext _ => ext
|
||
mkInitialExtStates := pure #[]
|
||
}
|
||
|
||
/- Unsafe implementation of `EnvExtensionInterface` -/
|
||
namespace EnvExtensionInterfaceUnsafe
|
||
|
||
structure Ext (σ : Type) where
|
||
idx : Nat
|
||
mkInitial : IO σ
|
||
deriving Inhabited
|
||
|
||
private builtin_initialize envExtensionsRef : IO.Ref (Array (Ext EnvExtensionState)) ← IO.mkRef #[]
|
||
|
||
/--
|
||
User-defined environment extensions are declared using the `initialize` command.
|
||
This command is just syntax sugar for the `init` attribute.
|
||
When we `import` lean modules, the vector stored at `envExtensionsRef` may increase in size because of
|
||
user-defined environment extensions. When this happens, we must adjust the size of the `env.extensions`.
|
||
This method is invoked when processing `import`s.
|
||
-/
|
||
partial def ensureExtensionsArraySize (env : Environment) : IO Environment := do
|
||
loop env.extensions.size env
|
||
where
|
||
loop (i : Nat) (env : Environment) : IO Environment := do
|
||
let envExtensions ← envExtensionsRef.get
|
||
if h : i < envExtensions.size then
|
||
let s ← envExtensions[i].mkInitial
|
||
let env := { env with extensions := env.extensions.push s }
|
||
loop (i + 1) env
|
||
else
|
||
return env
|
||
|
||
private def invalidExtMsg := "invalid environment extension has been accessed"
|
||
|
||
unsafe def setState {σ} (ext : Ext σ) (env : Environment) (s : σ) : Environment :=
|
||
if h : ext.idx < env.extensions.size then
|
||
{ env with extensions := env.extensions.set ⟨ext.idx, h⟩ (unsafeCast s) }
|
||
else
|
||
panic! invalidExtMsg
|
||
|
||
@[inline] unsafe def modifyState {σ : Type} (ext : Ext σ) (env : Environment) (f : σ → σ) : Environment :=
|
||
if ext.idx < env.extensions.size then
|
||
{ env with
|
||
extensions := env.extensions.modify ext.idx fun s =>
|
||
let s : σ := unsafeCast s
|
||
let s : σ := f s
|
||
unsafeCast s }
|
||
else
|
||
panic! invalidExtMsg
|
||
|
||
unsafe def getState {σ} [Inhabited σ] (ext : Ext σ) (env : Environment) : σ :=
|
||
if h : ext.idx < env.extensions.size then
|
||
let s : EnvExtensionState := env.extensions.get ⟨ext.idx, h⟩
|
||
unsafeCast s
|
||
else
|
||
panic! invalidExtMsg
|
||
|
||
unsafe def registerExt {σ} (mkInitial : IO σ) : IO (Ext σ) := do
|
||
unless (← initializing) do
|
||
throw (IO.userError "failed to register environment, extensions can only be registered during initialization")
|
||
let exts ← envExtensionsRef.get
|
||
let idx := exts.size
|
||
let ext : Ext σ := {
|
||
idx := idx,
|
||
mkInitial := mkInitial,
|
||
}
|
||
envExtensionsRef.modify fun exts => exts.push (unsafeCast ext)
|
||
pure ext
|
||
|
||
def mkInitialExtStates : IO (Array EnvExtensionState) := do
|
||
let exts ← envExtensionsRef.get
|
||
exts.mapM fun ext => ext.mkInitial
|
||
|
||
unsafe def imp : EnvExtensionInterface := {
|
||
ext := Ext
|
||
ensureExtensionsSize := ensureExtensionsArraySize
|
||
inhabitedExt := fun _ => ⟨default⟩
|
||
registerExt := registerExt
|
||
setState := setState
|
||
modifyState := modifyState
|
||
getState := getState
|
||
mkInitialExtStates := mkInitialExtStates
|
||
}
|
||
|
||
end EnvExtensionInterfaceUnsafe
|
||
|
||
@[implementedBy EnvExtensionInterfaceUnsafe.imp]
|
||
constant EnvExtensionInterfaceImp : EnvExtensionInterface
|
||
|
||
def EnvExtension (σ : Type) : Type := EnvExtensionInterfaceImp.ext σ
|
||
|
||
private def ensureExtensionsArraySize (env : Environment) : IO Environment :=
|
||
EnvExtensionInterfaceImp.ensureExtensionsSize env
|
||
|
||
namespace EnvExtension
|
||
instance {σ} [s : Inhabited σ] : Inhabited (EnvExtension σ) := EnvExtensionInterfaceImp.inhabitedExt s
|
||
def setState {σ : Type} (ext : EnvExtension σ) (env : Environment) (s : σ) : Environment := EnvExtensionInterfaceImp.setState ext env s
|
||
def modifyState {σ : Type} (ext : EnvExtension σ) (env : Environment) (f : σ → σ) : Environment := EnvExtensionInterfaceImp.modifyState ext env f
|
||
def getState {σ : Type} [Inhabited σ] (ext : EnvExtension σ) (env : Environment) : σ := EnvExtensionInterfaceImp.getState ext env
|
||
end EnvExtension
|
||
|
||
/- Environment extensions can only be registered during initialization.
|
||
Reasons:
|
||
1- Our implementation assumes the number of extensions does not change after an environment object is created.
|
||
2- We do not use any synchronization primitive to access `envExtensionsRef`. -/
|
||
def registerEnvExtension {σ : Type} (mkInitial : IO σ) : IO (EnvExtension σ) := EnvExtensionInterfaceImp.registerExt mkInitial
|
||
private def mkInitialExtensionStates : IO (Array EnvExtensionState) := EnvExtensionInterfaceImp.mkInitialExtStates
|
||
|
||
@[export lean_mk_empty_environment]
|
||
def mkEmptyEnvironment (trustLevel : UInt32 := 0) : IO Environment := do
|
||
let initializing ← IO.initializing
|
||
if initializing then throw (IO.userError "environment objects cannot be created during initialization")
|
||
let exts ← mkInitialExtensionStates
|
||
pure {
|
||
const2ModIdx := {},
|
||
constants := {},
|
||
header := { trustLevel := trustLevel },
|
||
extensions := exts
|
||
}
|
||
|
||
structure PersistentEnvExtensionState (α : Type) (σ : Type) where
|
||
importedEntries : Array (Array α) -- entries per imported module
|
||
state : σ
|
||
|
||
structure ImportM.Context where
|
||
env : Environment
|
||
opts : Options
|
||
|
||
abbrev ImportM := ReaderT Lean.ImportM.Context IO
|
||
|
||
/- An environment extension with support for storing/retrieving entries from a .olean file.
|
||
- α is the type of the entries that are stored in .olean files.
|
||
- β is the type of values used to update the state.
|
||
- σ is the actual state.
|
||
|
||
Remark: for most extensions α and β coincide.
|
||
|
||
Note that `addEntryFn` is not in `IO`. This is intentional, and allows us to write simple functions such as
|
||
```
|
||
def addAlias (env : Environment) (a : Name) (e : Name) : Environment :=
|
||
aliasExtension.addEntry env (a, e)
|
||
```
|
||
without using `IO`. We have many functions like `addAlias`.
|
||
|
||
`α` and ‵β` do not coincide for extensions where the data used to update the state contains, for example,
|
||
closures which we currently cannot store in files. -/
|
||
structure PersistentEnvExtension (α : Type) (β : Type) (σ : Type) where
|
||
toEnvExtension : EnvExtension (PersistentEnvExtensionState α σ)
|
||
name : Name
|
||
addImportedFn : Array (Array α) → ImportM σ
|
||
addEntryFn : σ → β → σ
|
||
exportEntriesFn : σ → Array α
|
||
statsFn : σ → Format
|
||
|
||
instance {α σ} [Inhabited σ] : Inhabited (PersistentEnvExtensionState α σ) :=
|
||
⟨{importedEntries := #[], state := default }⟩
|
||
|
||
instance {α β σ} [Inhabited σ] : Inhabited (PersistentEnvExtension α β σ) where
|
||
default := {
|
||
toEnvExtension := default,
|
||
name := default,
|
||
addImportedFn := fun _ => default,
|
||
addEntryFn := fun s _ => s,
|
||
exportEntriesFn := fun _ => #[],
|
||
statsFn := fun _ => Format.nil
|
||
}
|
||
|
||
namespace PersistentEnvExtension
|
||
|
||
def getModuleEntries {α β σ : Type} [Inhabited σ] (ext : PersistentEnvExtension α β σ) (env : Environment) (m : ModuleIdx) : Array α :=
|
||
(ext.toEnvExtension.getState env).importedEntries.get! m
|
||
|
||
def addEntry {α β σ : Type} (ext : PersistentEnvExtension α β σ) (env : Environment) (b : β) : Environment :=
|
||
ext.toEnvExtension.modifyState env fun s =>
|
||
let state := ext.addEntryFn s.state b;
|
||
{ s with state := state }
|
||
|
||
def getState {α β σ : Type} [Inhabited σ] (ext : PersistentEnvExtension α β σ) (env : Environment) : σ :=
|
||
(ext.toEnvExtension.getState env).state
|
||
|
||
def setState {α β σ : Type} (ext : PersistentEnvExtension α β σ) (env : Environment) (s : σ) : Environment :=
|
||
ext.toEnvExtension.modifyState env fun ps => { ps with state := s }
|
||
|
||
def modifyState {α β σ : Type} (ext : PersistentEnvExtension α β σ) (env : Environment) (f : σ → σ) : Environment :=
|
||
ext.toEnvExtension.modifyState env fun ps => { ps with state := f (ps.state) }
|
||
|
||
end PersistentEnvExtension
|
||
|
||
builtin_initialize persistentEnvExtensionsRef : IO.Ref (Array (PersistentEnvExtension EnvExtensionEntry EnvExtensionEntry EnvExtensionState)) ← IO.mkRef #[]
|
||
|
||
structure PersistentEnvExtensionDescr (α β σ : Type) where
|
||
name : Name
|
||
mkInitial : IO σ
|
||
addImportedFn : Array (Array α) → ImportM σ
|
||
addEntryFn : σ → β → σ
|
||
exportEntriesFn : σ → Array α
|
||
statsFn : σ → Format := fun _ => Format.nil
|
||
|
||
unsafe def registerPersistentEnvExtensionUnsafe {α β σ : Type} [Inhabited σ] (descr : PersistentEnvExtensionDescr α β σ) : IO (PersistentEnvExtension α β σ) := do
|
||
let pExts ← persistentEnvExtensionsRef.get
|
||
if pExts.any (fun ext => ext.name == descr.name) then throw (IO.userError s!"invalid environment extension, '{descr.name}' has already been used")
|
||
let ext ← registerEnvExtension do
|
||
let initial ← descr.mkInitial
|
||
let s : PersistentEnvExtensionState α σ := {
|
||
importedEntries := #[],
|
||
state := initial
|
||
}
|
||
pure s
|
||
let pExt : PersistentEnvExtension α β σ := {
|
||
toEnvExtension := ext,
|
||
name := descr.name,
|
||
addImportedFn := descr.addImportedFn,
|
||
addEntryFn := descr.addEntryFn,
|
||
exportEntriesFn := descr.exportEntriesFn,
|
||
statsFn := descr.statsFn
|
||
}
|
||
persistentEnvExtensionsRef.modify fun pExts => pExts.push (unsafeCast pExt)
|
||
return pExt
|
||
|
||
@[implementedBy registerPersistentEnvExtensionUnsafe]
|
||
constant registerPersistentEnvExtension {α β σ : Type} [Inhabited σ] (descr : PersistentEnvExtensionDescr α β σ) : IO (PersistentEnvExtension α β σ)
|
||
|
||
/- Simple PersistentEnvExtension that implements exportEntriesFn using a list of entries. -/
|
||
|
||
def SimplePersistentEnvExtension (α σ : Type) := PersistentEnvExtension α α (List α × σ)
|
||
|
||
@[specialize] def mkStateFromImportedEntries {α σ : Type} (addEntryFn : σ → α → σ) (initState : σ) (as : Array (Array α)) : σ :=
|
||
as.foldl (fun r es => es.foldl (fun r e => addEntryFn r e) r) initState
|
||
|
||
structure SimplePersistentEnvExtensionDescr (α σ : Type) where
|
||
name : Name
|
||
addEntryFn : σ → α → σ
|
||
addImportedFn : Array (Array α) → σ
|
||
toArrayFn : List α → Array α := fun es => es.toArray
|
||
|
||
def registerSimplePersistentEnvExtension {α σ : Type} [Inhabited σ] (descr : SimplePersistentEnvExtensionDescr α σ) : IO (SimplePersistentEnvExtension α σ) :=
|
||
registerPersistentEnvExtension {
|
||
name := descr.name,
|
||
mkInitial := pure ([], descr.addImportedFn #[]),
|
||
addImportedFn := fun as => pure ([], descr.addImportedFn as),
|
||
addEntryFn := fun s e => match s with
|
||
| (entries, s) => (e::entries, descr.addEntryFn s e),
|
||
exportEntriesFn := fun s => descr.toArrayFn s.1.reverse,
|
||
statsFn := fun s => format "number of local entries: " ++ format s.1.length
|
||
}
|
||
|
||
namespace SimplePersistentEnvExtension
|
||
|
||
instance {α σ : Type} [Inhabited σ] : Inhabited (SimplePersistentEnvExtension α σ) :=
|
||
inferInstanceAs (Inhabited (PersistentEnvExtension α α (List α × σ)))
|
||
|
||
def getEntries {α σ : Type} [Inhabited σ] (ext : SimplePersistentEnvExtension α σ) (env : Environment) : List α :=
|
||
(PersistentEnvExtension.getState ext env).1
|
||
|
||
def getState {α σ : Type} [Inhabited σ] (ext : SimplePersistentEnvExtension α σ) (env : Environment) : σ :=
|
||
(PersistentEnvExtension.getState ext env).2
|
||
|
||
def setState {α σ : Type} (ext : SimplePersistentEnvExtension α σ) (env : Environment) (s : σ) : Environment :=
|
||
PersistentEnvExtension.modifyState ext env (fun ⟨entries, _⟩ => (entries, s))
|
||
|
||
def modifyState {α σ : Type} (ext : SimplePersistentEnvExtension α σ) (env : Environment) (f : σ → σ) : Environment :=
|
||
PersistentEnvExtension.modifyState ext env (fun ⟨entries, s⟩ => (entries, f s))
|
||
|
||
end SimplePersistentEnvExtension
|
||
|
||
/-- Environment extension for tagging declarations.
|
||
Declarations must only be tagged in the module where they were declared. -/
|
||
def TagDeclarationExtension := SimplePersistentEnvExtension Name NameSet
|
||
|
||
def mkTagDeclarationExtension (name : Name) : IO TagDeclarationExtension :=
|
||
registerSimplePersistentEnvExtension {
|
||
name := name,
|
||
addImportedFn := fun as => {},
|
||
addEntryFn := fun s n => s.insert n,
|
||
toArrayFn := fun es => es.toArray.qsort Name.quickLt
|
||
}
|
||
|
||
namespace TagDeclarationExtension
|
||
|
||
instance : Inhabited TagDeclarationExtension :=
|
||
inferInstanceAs (Inhabited (SimplePersistentEnvExtension Name NameSet))
|
||
|
||
def tag (ext : TagDeclarationExtension) (env : Environment) (n : Name) : Environment :=
|
||
ext.addEntry env n
|
||
|
||
def isTagged (ext : TagDeclarationExtension) (env : Environment) (n : Name) : Bool :=
|
||
match env.getModuleIdxFor? n with
|
||
| some modIdx => (ext.getModuleEntries env modIdx).binSearchContains n Name.quickLt
|
||
| none => (ext.getState env).contains n
|
||
|
||
end TagDeclarationExtension
|
||
|
||
/-- Environment extension for mapping declarations to values. -/
|
||
|
||
def MapDeclarationExtension (α : Type) := SimplePersistentEnvExtension (Name × α) (NameMap α)
|
||
|
||
def mkMapDeclarationExtension [Inhabited α] (name : Name) : IO (MapDeclarationExtension α) :=
|
||
registerSimplePersistentEnvExtension {
|
||
name := name,
|
||
addImportedFn := fun as => {},
|
||
addEntryFn := fun s n => s.insert n.1 n.2 ,
|
||
toArrayFn := fun es => es.toArray.qsort (fun a b => Name.quickLt a.1 b.1)
|
||
}
|
||
|
||
namespace MapDeclarationExtension
|
||
|
||
instance : Inhabited (MapDeclarationExtension α) :=
|
||
inferInstanceAs (Inhabited (SimplePersistentEnvExtension ..))
|
||
|
||
def insert (ext : MapDeclarationExtension α) (env : Environment) (declName : Name) (val : α) : Environment :=
|
||
ext.addEntry env (declName, val)
|
||
|
||
def find? [Inhabited α] (ext : MapDeclarationExtension α) (env : Environment) (declName : Name) : Option α :=
|
||
match env.getModuleIdxFor? declName with
|
||
| some modIdx =>
|
||
match (ext.getModuleEntries env modIdx).binSearch (declName, default) (fun a b => Name.quickLt a.1 b.1) with
|
||
| some e => some e.2
|
||
| none => none
|
||
| none => (ext.getState env).find? declName
|
||
|
||
def contains [Inhabited α] (ext : MapDeclarationExtension α) (env : Environment) (declName : Name) : Bool :=
|
||
match env.getModuleIdxFor? declName with
|
||
| some modIdx => (ext.getModuleEntries env modIdx).binSearchContains (declName, default) (fun a b => Name.quickLt a.1 b.1)
|
||
| none => (ext.getState env).contains declName
|
||
|
||
end MapDeclarationExtension
|
||
|
||
@[extern "lean_save_module_data"]
|
||
constant saveModuleData (fname : @& System.FilePath) (mod : @& Name) (data : @& ModuleData) : IO Unit
|
||
@[extern "lean_read_module_data"]
|
||
constant readModuleData (fname : @& System.FilePath) : IO (ModuleData × CompactedRegion)
|
||
|
||
/--
|
||
Free compacted regions of imports. No live references to imported objects may exist at the time of invocation; in
|
||
particular, `env` should be the last reference to any `Environment` derived from these imports. -/
|
||
@[noinline, export lean_environment_free_regions]
|
||
unsafe def Environment.freeRegions (env : Environment) : IO Unit :=
|
||
/-
|
||
NOTE: This assumes `env` is not inferred as a borrowed parameter, and is freed after extracting the `header` field.
|
||
Otherwise, we would encounter undefined behavior when the constant map in `env`, which may reference objects in
|
||
compacted regions, is freed after the regions.
|
||
|
||
In the currently produced IR, we indeed see:
|
||
```
|
||
def Lean.Environment.freeRegions (x_1 : obj) (x_2 : obj) : obj :=
|
||
let x_3 : obj := proj[3] x_1;
|
||
inc x_3;
|
||
dec x_1;
|
||
...
|
||
```
|
||
|
||
TODO: statically check for this. -/
|
||
env.header.regions.forM CompactedRegion.free
|
||
|
||
def mkModuleData (env : Environment) : IO ModuleData := do
|
||
let pExts ← persistentEnvExtensionsRef.get
|
||
let entries : Array (Name × Array EnvExtensionEntry) := pExts.size.fold
|
||
(fun i result =>
|
||
let state := (pExts.get! i).getState env
|
||
let exportEntriesFn := (pExts.get! i).exportEntriesFn
|
||
let extName := (pExts.get! i).name
|
||
result.push (extName, exportEntriesFn state))
|
||
#[]
|
||
pure {
|
||
imports := env.header.imports,
|
||
constants := env.constants.foldStage2 (fun cs _ c => cs.push c) #[],
|
||
entries := entries
|
||
}
|
||
|
||
@[export lean_write_module]
|
||
def writeModule (env : Environment) (fname : System.FilePath) : IO Unit := do
|
||
saveModuleData fname env.mainModule (← mkModuleData env)
|
||
|
||
private partial def getEntriesFor (mod : ModuleData) (extId : Name) (i : Nat) : Array EnvExtensionEntry :=
|
||
if i < mod.entries.size then
|
||
let curr := mod.entries.get! i;
|
||
if curr.1 == extId then curr.2 else getEntriesFor mod extId (i+1)
|
||
else
|
||
#[]
|
||
|
||
private def setImportedEntries (env : Environment) (mods : Array ModuleData) (startingAt : Nat := 0) : IO Environment := do
|
||
let mut env := env
|
||
let pExtDescrs ← persistentEnvExtensionsRef.get
|
||
for mod in mods do
|
||
for extDescr in pExtDescrs[startingAt:] do
|
||
let entries := getEntriesFor mod extDescr.name 0
|
||
env := extDescr.toEnvExtension.modifyState env fun s => { s with importedEntries := s.importedEntries.push entries }
|
||
return env
|
||
|
||
/--
|
||
"Forward declaration" needed for updating the attribute table with user-defined attributes.
|
||
User-defined attributes are declared using the `initialize` command. The `initialize` command is just syntax sugar for the `init` attribute.
|
||
The `init` attribute is initialized after the `attributeExtension` is initialized. We cannot change the order since the `init` attribute is an attribute,
|
||
and requires this extension.
|
||
The `attributeExtension` initializer uses `attributeMapRef` to initialize the attribute mapping.
|
||
When we a new user-defined attribute declaration is imported, `attributeMapRef` is updated.
|
||
Later, we set this method with code that adds the user-defined attributes that were imported after we initialized `attributeExtension`.
|
||
-/
|
||
@[extern 2 "lean_update_env_attributes"] constant updateEnvAttributes : Environment → IO Environment
|
||
/-- "Forward declaration" for retrieving the number of builtin attributes. -/
|
||
@[extern 1 "lean_get_num_attributes"] constant getNumBuiltiAttributes : IO Nat
|
||
|
||
private partial def finalizePersistentExtensions (env : Environment) (mods : Array ModuleData) (opts : Options) : IO Environment := do
|
||
loop 0 env
|
||
where
|
||
loop (i : Nat) (env : Environment) : IO Environment := do
|
||
-- Recall that the size of the array stored `persistentEnvExtensionRef` may increase when we import user-defined environment extensions.
|
||
let pExtDescrs ← persistentEnvExtensionsRef.get
|
||
if h : i < pExtDescrs.size then
|
||
let extDescr := pExtDescrs[i]
|
||
let s := extDescr.toEnvExtension.getState env
|
||
let prevSize := (← persistentEnvExtensionsRef.get).size
|
||
let prevAttrSize ← getNumBuiltiAttributes
|
||
let newState ← extDescr.addImportedFn s.importedEntries { env := env, opts := opts }
|
||
let mut env := extDescr.toEnvExtension.setState env { s with state := newState }
|
||
env ← ensureExtensionsArraySize env
|
||
if (← persistentEnvExtensionsRef.get).size > prevSize || (← getNumBuiltiAttributes) > prevAttrSize then
|
||
-- This branch is executed when `pExtDescrs[i]` is the extension associated with the `init` attribute, and
|
||
-- a user-defined persistent extension is imported.
|
||
-- Thus, we invoke `setImportedEntries` to update the array `importedEntries` with the entries for the new extensions.
|
||
env ← setImportedEntries env mods prevSize
|
||
-- See comment at `updateEnvAttributesRef`
|
||
env ← updateEnvAttributes env
|
||
loop (i + 1) env
|
||
else
|
||
return env
|
||
|
||
structure ImportState where
|
||
moduleNameSet : NameSet := {}
|
||
moduleNames : Array Name := #[]
|
||
moduleData : Array ModuleData := #[]
|
||
regions : Array CompactedRegion := #[]
|
||
|
||
@[export lean_import_modules]
|
||
partial def importModules (imports : List Import) (opts : Options) (trustLevel : UInt32 := 0) : IO Environment := profileitIO "import" opts do
|
||
withImporting do
|
||
let (_, s) ← importMods imports |>.run {}
|
||
let mut numConsts := 0
|
||
for mod in s.moduleData do
|
||
numConsts := numConsts + mod.constants.size
|
||
let mut modIdx : Nat := 0
|
||
let mut const2ModIdx : HashMap Name ModuleIdx := Std.mkHashMap (capacity := numConsts)
|
||
let mut constantMap : HashMap Name ConstantInfo := Std.mkHashMap (capacity := numConsts)
|
||
for mod in s.moduleData do
|
||
for cinfo in mod.constants do
|
||
const2ModIdx := const2ModIdx.insert cinfo.name modIdx
|
||
match constantMap.insert' cinfo.name cinfo with
|
||
| (constantMap', replaced) =>
|
||
constantMap := constantMap'
|
||
if replaced then throw (IO.userError s!"import failed, environment already contains '{cinfo.name}'")
|
||
modIdx := modIdx + 1
|
||
let constants : ConstMap := SMap.fromHashMap constantMap false
|
||
let exts ← mkInitialExtensionStates
|
||
let env : Environment := {
|
||
const2ModIdx := const2ModIdx,
|
||
constants := constants,
|
||
extensions := exts,
|
||
header := {
|
||
quotInit := !imports.isEmpty, -- We assume `core.lean` initializes quotient module
|
||
trustLevel := trustLevel,
|
||
imports := imports.toArray,
|
||
regions := s.regions,
|
||
moduleNames := s.moduleNames
|
||
moduleData := s.moduleData
|
||
}
|
||
}
|
||
let env ← setImportedEntries env s.moduleData
|
||
let env ← finalizePersistentExtensions env s.moduleData opts
|
||
pure env
|
||
where
|
||
importMods : List Import → StateRefT ImportState IO Unit
|
||
| [] => pure ()
|
||
| i::is => do
|
||
if i.runtimeOnly || (← get).moduleNameSet.contains i.module then
|
||
importMods is
|
||
else do
|
||
modify fun s => { s with moduleNameSet := s.moduleNameSet.insert i.module }
|
||
let mFile ← findOLean i.module
|
||
unless (← mFile.pathExists) do
|
||
throw <| IO.userError s!"object file '{mFile}' of module {i.module} does not exist"
|
||
let (mod, region) ← readModuleData mFile
|
||
importMods mod.imports.toList
|
||
modify fun s => { s with
|
||
moduleData := s.moduleData.push mod
|
||
regions := s.regions.push region
|
||
moduleNames := s.moduleNames.push i.module
|
||
}
|
||
importMods is
|
||
|
||
/--
|
||
Create environment object from imports and free compacted regions after calling `act`. No live references to the
|
||
environment object or imported objects may exist after `act` finishes. -/
|
||
unsafe def withImportModules {α : Type} (imports : List Import) (opts : Options) (trustLevel : UInt32 := 0) (x : Environment → IO α) : IO α := do
|
||
let env ← importModules imports opts trustLevel
|
||
try x env finally env.freeRegions
|
||
|
||
builtin_initialize namespacesExt : SimplePersistentEnvExtension Name NameSSet ←
|
||
registerSimplePersistentEnvExtension {
|
||
name := `namespaces,
|
||
addImportedFn := fun as => mkStateFromImportedEntries NameSSet.insert NameSSet.empty as |>.switch,
|
||
addEntryFn := fun s n => s.insert n
|
||
}
|
||
|
||
namespace Environment
|
||
|
||
def registerNamespace (env : Environment) (n : Name) : Environment :=
|
||
if (namespacesExt.getState env).contains n then env else namespacesExt.addEntry env n
|
||
|
||
def isNamespace (env : Environment) (n : Name) : Bool :=
|
||
(namespacesExt.getState env).contains n
|
||
|
||
def getNamespaceSet (env : Environment) : NameSSet :=
|
||
namespacesExt.getState env
|
||
|
||
private def isNamespaceName : Name → Bool
|
||
| Name.str Name.anonymous _ _ => true
|
||
| Name.str p _ _ => isNamespaceName p
|
||
| _ => false
|
||
|
||
private def registerNamePrefixes : Environment → Name → Environment
|
||
| env, Name.str p _ _ => if isNamespaceName p then registerNamePrefixes (registerNamespace env p) p else env
|
||
| env, _ => env
|
||
|
||
@[export lean_environment_add]
|
||
def add (env : Environment) (cinfo : ConstantInfo) : Environment :=
|
||
let env := registerNamePrefixes env cinfo.name
|
||
env.addAux cinfo
|
||
|
||
@[export lean_display_stats]
|
||
def displayStats (env : Environment) : IO Unit := do
|
||
let pExtDescrs ← persistentEnvExtensionsRef.get
|
||
IO.println ("direct imports: " ++ toString env.header.imports);
|
||
IO.println ("number of imported modules: " ++ toString env.header.regions.size);
|
||
IO.println ("number of memory-mapped modules: " ++ toString (env.header.regions.filter (·.isMemoryMapped) |>.size));
|
||
IO.println ("number of consts: " ++ toString env.constants.size);
|
||
IO.println ("number of imported consts: " ++ toString env.constants.stageSizes.1);
|
||
IO.println ("number of local consts: " ++ toString env.constants.stageSizes.2);
|
||
IO.println ("number of buckets for imported consts: " ++ toString env.constants.numBuckets);
|
||
IO.println ("trust level: " ++ toString env.header.trustLevel);
|
||
IO.println ("number of extensions: " ++ toString env.extensions.size);
|
||
pExtDescrs.forM fun extDescr => do
|
||
IO.println ("extension '" ++ toString extDescr.name ++ "'")
|
||
let s := extDescr.toEnvExtension.getState env
|
||
let fmt := extDescr.statsFn s.state
|
||
unless fmt.isNil do IO.println (" " ++ toString (Format.nest 2 (extDescr.statsFn s.state)))
|
||
IO.println (" number of imported entries: " ++ toString (s.importedEntries.foldl (fun sum es => sum + es.size) 0))
|
||
|
||
/--
|
||
Evaluate the given declaration under the given environment to a value of the given type.
|
||
This function is only safe to use if the type matches the declaration's type in the environment
|
||
and if `enableInitializersExecution` has been used before importing any modules. -/
|
||
@[extern "lean_eval_const"]
|
||
unsafe constant evalConst (α) (env : @& Environment) (opts : @& Options) (constName : @& Name) : Except String α
|
||
|
||
private def throwUnexpectedType {α} (typeName : Name) (constName : Name) : ExceptT String Id α :=
|
||
throw ("unexpected type at '" ++ toString constName ++ "', `" ++ toString typeName ++ "` expected")
|
||
|
||
/-- Like `evalConst`, but first check that `constName` indeed is a declaration of type `typeName`.
|
||
Note that this function cannot guarantee that `typeName` is in fact the name of the type `α`. -/
|
||
unsafe def evalConstCheck (α) (env : Environment) (opts : Options) (typeName : Name) (constName : Name) : ExceptT String Id α :=
|
||
match env.find? constName with
|
||
| none => throw ("unknown constant '" ++ toString constName ++ "'")
|
||
| some info =>
|
||
match info.type with
|
||
| Expr.const c _ _ =>
|
||
if c != typeName then throwUnexpectedType typeName constName
|
||
else env.evalConst α opts constName
|
||
| _ => throwUnexpectedType typeName constName
|
||
|
||
def hasUnsafe (env : Environment) (e : Expr) : Bool :=
|
||
let c? := e.find? fun e => match e with
|
||
| Expr.const c _ _ =>
|
||
match env.find? c with
|
||
| some cinfo => cinfo.isUnsafe
|
||
| none => false
|
||
| _ => false;
|
||
c?.isSome
|
||
|
||
end Environment
|
||
|
||
namespace Kernel
|
||
/- Kernel API -/
|
||
|
||
/--
|
||
Kernel isDefEq predicate. We use it mainly for debugging purposes.
|
||
Recall that the Kernel type checker does not support metavariables.
|
||
When implementing automation, consider using the `MetaM` methods. -/
|
||
@[extern "lean_kernel_is_def_eq"]
|
||
constant isDefEq (env : Environment) (lctx : LocalContext) (a b : Expr) : Bool
|
||
|
||
/--
|
||
Kernel WHNF function. We use it mainly for debugging purposes.
|
||
Recall that the Kernel type checker does not support metavariables.
|
||
When implementing automation, consider using the `MetaM` methods. -/
|
||
@[extern "lean_kernel_whnf"]
|
||
constant whnf (env : Environment) (lctx : LocalContext) (a : Expr) : Expr
|
||
|
||
end Kernel
|
||
|
||
class MonadEnv (m : Type → Type) where
|
||
getEnv : m Environment
|
||
modifyEnv : (Environment → Environment) → m Unit
|
||
|
||
export MonadEnv (getEnv modifyEnv)
|
||
|
||
instance (m n) [MonadLift m n] [MonadEnv m] : MonadEnv n where
|
||
getEnv := liftM (getEnv : m Environment)
|
||
modifyEnv := fun f => liftM (modifyEnv f : m Unit)
|
||
|
||
/--
|
||
If `env` does not contain a declaration with name `declName ++ elemSuffix`, then return `declName`.
|
||
Otherwise, find the smallest positive `Nat` `i` such that `declName ++ suffix.appendIndexAfter i ++ elemSuffix` is not
|
||
the name of a declaration in the given environment.
|
||
-/
|
||
partial def mkBaseNameFor (env : Environment) (declName : Name) (elemSuffix : Name) (suffix : Name) : Name :=
|
||
if !env.contains (declName ++ elemSuffix) then
|
||
declName
|
||
else
|
||
go 1
|
||
where
|
||
go (idx : Nat) : Name :=
|
||
let baseName := declName ++ suffix.appendIndexAfter idx
|
||
if !env.contains (baseName ++ elemSuffix) then
|
||
baseName
|
||
else
|
||
go (idx + 1)
|
||
|
||
|
||
end Lean
|