blob: 4b52143f5a07ff9cc51bcfbae0a1c16fe435960c [file] [edit]
/-
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. -/
opaque 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"]
opaque 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 opaque CompactedRegion.free : CompactedRegion → IO Unit
/- Opaque persistent environment extension entry. -/
opaque 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"]
opaque 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"]
opaque 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 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]
opaque 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`.
Note that by default, extension state is *not* stored in .olean files and will not propagate across `import`s.
For that, you need to register a persistent environment extension. -/
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]
opaque 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 _ => {},
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) (declName : Name) : Environment :=
assert! env.getModuleIdxFor? declName |>.isNone -- See comment at `TagDeclarationExtension`
ext.addEntry env declName
def isTagged (ext : TagDeclarationExtension) (env : Environment) (declName : Name) : Bool :=
match env.getModuleIdxFor? declName with
| some modIdx => (ext.getModuleEntries env modIdx).binSearchContains declName Name.quickLt
| none => (ext.getState env).contains declName
end TagDeclarationExtension
/-- Environment extension for mapping declarations to values.
Declarations must only be inserted into the mapping in the module where they were declared. -/
def MapDeclarationExtension (α : Type) := SimplePersistentEnvExtension (Name × α) (NameMap α)
def mkMapDeclarationExtension [Inhabited α] (name : Name) : IO (MapDeclarationExtension α) :=
registerSimplePersistentEnvExtension {
name := name,
addImportedFn := fun _ => {},
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 :=
assert! env.getModuleIdxFor? declName |>.isNone -- See comment at `MapDeclarationExtension`
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"]
opaque saveModuleData (fname : @& System.FilePath) (mod : @& Name) (data : @& ModuleData) : IO Unit
@[extern "lean_read_module_data"]
opaque 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"] opaque updateEnvAttributes : Environment → IO Environment
/-- "Forward declaration" for retrieving the number of builtin attributes. -/
@[extern 1 "lean_get_num_attributes"] opaque 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 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
for imp in imports do
if imp.module matches .anonymous then
throw <| IO.userError "import failed, trying to import module with anonymous name"
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 opaque 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"]
opaque 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"]
opaque 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)
end Lean