lean4-htt/src/Lean/Environment.lean
Marc Huisinga f989520d2b
fix: invalid namespace completions (#5322)
This PR fixes an issue reported a while ago at
https://leanprover.zulipchat.com/#narrow/stream/270676-lean4/topic/.60Monad.2Emap.60.20is.20a.20namespace.3F/near/425662846
where `Monad.map` was incorrectly reported by the autocompletion as a
namespace.

The underlying issue is that `Monad.map` contains an internal
declaration `_default`. This PR ensures that no namespaces are
registered that only contain internal declarations.

This also means that `open`ing namespaces that only contain internal
declarations will now fail.

The Mathlib adaption for this is a minor change where a declaration
(i.e. a namespace that only contains internal declarations) was `open`ed
by accident.
2024-09-13 12:23:03 +00:00

1119 lines
50 KiB
Text
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

/-
Copyright (c) 2019 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.Control.StateRef
import Init.Data.Array.BinSearch
import Init.Data.Stream
import Lean.ImportingFlag
import Lean.Data.HashMap
import Lean.Data.SMap
import Lean.Declaration
import Lean.LocalContext
import Lean.Util.Path
import Lean.Util.FindExpr
import Lean.Util.Profile
import Lean.Util.InstantiateLevelParams
namespace Lean
/-- Opaque environment extension state. -/
opaque EnvExtensionStateSpec : (α : Type) × Inhabited α := ⟨Unit, ⟨()⟩⟩
def EnvExtensionState : Type := EnvExtensionStateSpec.fst
instance : Inhabited EnvExtensionState := EnvExtensionStateSpec.snd
def ModuleIdx := Nat
deriving BEq, ToString
abbrev ModuleIdx.toNat (midx : ModuleIdx) : Nat := midx
instance : Inhabited ModuleIdx where default := (0 : Nat)
abbrev ConstMap := SMap Name ConstantInfo
structure Import where
module : Name
runtimeOnly : Bool := false
deriving Repr, Inhabited
instance : Coe Name Import := ⟨({module := ·})⟩
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
/--
`constNames` contains all constant names in `constants`.
This information is redundant. It is equal to `constants.map fun c => c.name`,
but it improves the performance of `importModules`. `perf` reports that 12% of the
runtime was being spent on `ConstantInfo.name` when importing a file containing only `import Lean`
-/
constNames : Array Name
constants : Array ConstantInfo
/--
Extra entries for the `const2ModIdx` map in the `Environment` object.
The code generator creates auxiliary declarations that are not in the
mapping `constants`, but we want to know in which module they were generated.
-/
extraConstNames : Array Name
entries : Array (Name × Array EnvExtensionEntry)
deriving Inhabited
/-- Environment fields that are not used often. -/
structure EnvironmentHeader where
/--
The trust level used by the kernel. For example,
the kernel assumes imported constants are type correct when the trust level is greater than zero.
-/
trustLevel : UInt32 := 0
/--
`quotInit = true` if the command `init_quot` has already been executed for the environment, and
`Quot` declarations have been added to the environment.
-/
quotInit : Bool := false
/--
Name of the module being compiled.
-/
mainModule : Name := default
/-- Direct imports -/
imports : Array Import := #[]
/-- Compacted regions for all imported modules. Objects in compacted memory regions do no require any memory management. -/
regions : Array CompactedRegion := #[]
/-- Name of all imported modules (directly and indirectly). -/
moduleNames : Array Name := #[]
/-- Module data for all imported modules. -/
moduleData : Array ModuleData := #[]
deriving Nonempty
/--
An environment stores declarations provided by the user. The kernel
currently supports different kinds of declarations such as definitions, theorems,
and inductive families. Each has a unique identifier (i.e., `Name`), and can be
parameterized by a sequence of universe parameters.
A constant in Lean is just a reference to a `ConstantInfo` object. The main task of
the kernel is to type check these declarations and refuse type incorrect ones. The
kernel does not allow declarations containing metavariables and/or free variables
to be added to an environment. Environments are never destructively updated.
The environment also contains a collection of extensions. For example, the `simp` theorems
declared by users are stored in an environment extension. Users can declare new extensions
using meta-programming.
-/
structure Environment where
/-- The constructor of `Environment` is private to protect against modification
that bypasses the kernel. -/
private mk ::
/--
Mapping from constant name to module (index) where constant has been declared.
Recall that a Lean file has a header where previously compiled modules can be imported.
Each imported module has a unique `ModuleIdx`.
Many extensions use the `ModuleIdx` to efficiently retrieve information stored in imported modules.
Remark: this mapping also contains auxiliary constants, created by the code generator, that are **not** in
the field `constants`. These auxiliary constants are invisible to the Lean kernel and elaborator.
Only the code generator uses them.
-/
const2ModIdx : Std.HashMap Name ModuleIdx
/--
Mapping from constant name to `ConstantInfo`. It contains all constants (definitions, theorems, axioms, etc)
that have been already type checked by the kernel.
-/
constants : ConstMap
/--
Environment extensions. It also includes user-defined extensions.
-/
extensions : Array EnvExtensionState
/--
Constant names to be saved in the field `extraConstNames` at `ModuleData`.
It contains auxiliary declaration names created by the code generator which are not in `constants`.
When importing modules, we want to insert them at `const2ModIdx`.
-/
extraConstNames : NameSet
/-- The header contains additional information that is not updated often. -/
header : EnvironmentHeader := {}
deriving Nonempty
namespace Environment
private def addAux (env : Environment) (cinfo : ConstantInfo) : Environment :=
{ env with constants := env.constants.insert cinfo.name cinfo }
/--
Save an extra constant name that is used to populate `const2ModIdx` when we import
.olean files. We use this feature to save in which module an auxiliary declaration
created by the code generator has been created.
-/
def addExtraName (env : Environment) (name : Name) : Environment :=
if env.constants.contains name then
env
else
{ env with extraConstNames := env.extraConstNames.insert name }
@[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[declName]?
def isConstructor (env : Environment) (declName : Name) : Bool :=
match env.find? declName with
| some (.ctorInfo _) => true
| _ => false
def isSafeDefinition (env : Environment) (declName : Name) : Bool :=
match env.find? declName with
| some (.defnInfo { safety := .safe, .. }) => true
| _ => false
def getModuleIdx? (env : Environment) (moduleName : Name) : Option ModuleIdx :=
env.header.moduleNames.findIdx? (· == moduleName)
end Environment
/-- Exceptions that can be raised by the Kernel when type checking new declarations. -/
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)
| thmTypeIsNotProp (env : Environment) (name : Name) (type : Expr)
| other (msg : String)
| deterministicTimeout
| excessiveMemory
| deepRecursion
| interrupted
namespace Environment
/--
Type check given declaration and add it to the environment
-/
@[extern "lean_add_decl"]
opaque addDeclCore (env : Environment) (maxHeartbeats : USize) (decl : @& Declaration)
(cancelTk? : @& Option IO.CancelToken) : Except KernelException Environment
/--
Add declaration to kernel without type checking it.
**WARNING** This function is meant for temporarily working around kernel performance issues.
It compromises soundness because, for example, a buggy tactic may produce an invalid proof,
and the kernel will not catch it if the new option is set to true.
-/
@[extern "lean_add_decl_without_checking"]
opaque addDeclWithoutChecking (env : Environment) (decl : @& Declaration) : Except KernelException Environment
end Environment
namespace ConstantInfo
def instantiateTypeLevelParams (c : ConstantInfo) (ls : List Level) : Expr :=
c.type.instantiateLevelParams c.levelParams ls
def instantiateValueLevelParams! (c : ConstantInfo) (ls : List Level) : Expr :=
c.value!.instantiateLevelParams c.levelParams ls
end ConstantInfo
/-- Interface for managing environment extensions. -/
structure EnvExtensionInterface where
ext : Type → Type
inhabitedExt : Inhabited σ → Inhabited (ext σ)
registerExt (mkInitial : IO σ) : IO (ext σ)
setState (e : ext σ) (exts : Array EnvExtensionState) : σ → Array EnvExtensionState
modifyState (e : ext σ) (exts : Array EnvExtensionState) : (σσ) → Array EnvExtensionState
getState [Inhabited σ] (e : ext σ) (exts : Array EnvExtensionState) : σ
mkInitialExtStates : IO (Array EnvExtensionState)
ensureExtensionsSize : Array EnvExtensionState → IO (Array EnvExtensionState)
instance : Inhabited EnvExtensionInterface where
default := {
ext := id
inhabitedExt := id
ensureExtensionsSize := fun exts => pure exts
registerExt := fun mk => mk
setState := fun _ exts _ => exts
modifyState := fun _ exts _ => exts
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 (exts : Array EnvExtensionState) : IO (Array EnvExtensionState) := do
loop exts.size exts
where
loop (i : Nat) (exts : Array EnvExtensionState) : IO (Array EnvExtensionState) := do
let envExtensions ← envExtensionsRef.get
if i < envExtensions.size then
let s ← envExtensions[i]!.mkInitial
let exts := exts.push s
loop (i + 1) exts
else
return exts
private def invalidExtMsg := "invalid environment extension has been accessed"
unsafe def setState {σ} (ext : Ext σ) (exts : Array EnvExtensionState) (s : σ) : Array EnvExtensionState :=
if h : ext.idx < exts.size then
exts.set ⟨ext.idx, h⟩ (unsafeCast s)
else
have : Inhabited (Array EnvExtensionState) := ⟨exts⟩
panic! invalidExtMsg
@[inline] unsafe def modifyState {σ : Type} (ext : Ext σ) (exts : Array EnvExtensionState) (f : σσ) : Array EnvExtensionState :=
if ext.idx < exts.size then
exts.modify ext.idx fun s =>
let s : σ := unsafeCast s
let s : σ := f s
unsafeCast s
else
have : Inhabited (Array EnvExtensionState) := ⟨exts⟩
panic! invalidExtMsg
unsafe def getState {σ} [Inhabited σ] (ext : Ext σ) (exts : Array EnvExtensionState) : σ :=
if h : ext.idx < exts.size then
let s : EnvExtensionState := exts.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
@[implemented_by EnvExtensionInterfaceUnsafe.imp]
opaque EnvExtensionInterfaceImp : EnvExtensionInterface
def EnvExtension (σ : Type) : Type := EnvExtensionInterfaceImp.ext σ
private def ensureExtensionsArraySize (env : Environment) : IO Environment := do
let exts ← EnvExtensionInterfaceImp.ensureExtensionsSize env.extensions
return { env with extensions := exts }
namespace EnvExtension
instance {σ} [s : Inhabited σ] : Inhabited (EnvExtension σ) := EnvExtensionInterfaceImp.inhabitedExt s
def setState {σ : Type} (ext : EnvExtension σ) (env : Environment) (s : σ) : Environment :=
{ env with extensions := EnvExtensionInterfaceImp.setState ext env.extensions s }
def modifyState {σ : Type} (ext : EnvExtension σ) (env : Environment) (f : σσ) : Environment :=
{ env with extensions := EnvExtensionInterfaceImp.modifyState ext env.extensions f }
def getState {σ : Type} [Inhabited σ] (ext : EnvExtension σ) (env : Environment) : σ :=
EnvExtensionInterfaceImp.getState ext env.extensions
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 }
extraConstNames := {}
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.
For most extensions, α and β coincide. `α` and ‵β` do not coincide for extensions where the data
used to update the state contains elements which cannot be stored in files (for example, closures).
During elaboration of a module, state of type `σ` can be both read and written. When elaboration is
complete, the state of type `σ` is converted to serialized state of type `Array α` by
`exportEntriesFn`. To read the current module's state, use `PersistentEnvExtension.getState`. To
modify it, use `PersistentEnvExtension.addEntry`, with an `addEntryFn` that performs the appropriate
modification.
When a module is loaded, the values saved by all of its dependencies for this
`PersistentEnvExtension` are are available as an `Array (Array α)` via the environment extension,
with one array per transitively imported module. The state of type `σ` used in the current module
can be initialized from these imports by specifying a suitable `addImportedFn`. The `addImportedFn`
runs at the beginning of elaboration for every module, so it's usually better for performance to
query the array of imported modules directly, because only a fraction of imported entries is usually
queried during elaboration of a module.
The most typical pattern for using `PersistentEnvExtension` is to set `σ` to a datatype such as
`NameMap` that efficiently tracks data for the current module. Then, in `exportEntriesFn`, this type
is converted to an array of pairs, sorted by the key. Given `ext : PersistentEnvExtension α β σ` and
`env : Environment`, the complete array of imported entries sorted by module index can be obtained
using `(ext.toEnvExtension.getState env).importedEntries`. To query the extension for some constant
name `n`, first use `env.getModuleIdxFor? n`. If it returns `none`, look up `n` in the current
module's state (the `NameMap`). If it returns `some idx`, use `ext.getModuleEntries env idx` to get
the array of entries for `n`'s defining module, and query it using `Array.binSearch`. This pattern
imposes a constraint that the extension can only track metadata that is declared in the same module
as the definition to which it applies; relaxing this restriction can make queries slower due to
needing to search _all_ modules. If it is necessary to search all modules, it is usually better to
initialize the state of type `σ` once from all imported entries and choose a more efficient search
datastructure for it.
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`.
-/
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 }
/-- Get the current state of the given extension in the given environment. -/
def getState {α β σ : Type} [Inhabited σ] (ext : PersistentEnvExtension α β σ) (env : Environment) : σ :=
(ext.toEnvExtension.getState env).state
/-- Set the current state of the given extension in the given environment. This change is *not* persisted across files. -/
def setState {α β σ : Type} (ext : PersistentEnvExtension α β σ) (env : Environment) (s : σ) : Environment :=
ext.toEnvExtension.modifyState env fun ps => { ps with state := s }
/-- Modify the state of the given extension in the given environment by applying the given function. This change is *not* persisted across files. -/
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 := by exact decl_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
@[implemented_by 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 := by exact decl_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 α × σ)))
/-- Get the list of values used to update the state of the given
`SimplePersistentEnvExtension` in the current file. -/
def getEntries {α σ : Type} [Inhabited σ] (ext : SimplePersistentEnvExtension α σ) (env : Environment) : List α :=
(PersistentEnvExtension.getState ext env).1
/-- Get the current state of the given `SimplePersistentEnvExtension`. -/
def getState {α σ : Type} [Inhabited σ] (ext : SimplePersistentEnvExtension α σ) (env : Environment) : σ :=
(PersistentEnvExtension.getState ext env).2
/-- Set the current state of the given `SimplePersistentEnvExtension`. This change is *not* persisted across files. -/
def setState {α σ : Type} (ext : SimplePersistentEnvExtension α σ) (env : Environment) (s : σ) : Environment :=
PersistentEnvExtension.modifyState ext env (fun ⟨entries, _⟩ => (entries, s))
/-- Modify the state of the given extension in the given environment by applying the given function. This change is *not* persisted across files. -/
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 := by exact decl_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 :=
have : Inhabited Environment := ⟨env⟩
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 (name : Name := by exact decl_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 :=
have : Inhabited Environment := ⟨env⟩
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 := pExts.map fun pExt =>
let state := pExt.getState env
(pExt.name, pExt.exportEntriesFn state)
let constNames := env.constants.foldStage2 (fun names name _ => names.push name) #[]
let constants := env.constants.foldStage2 (fun cs _ c => cs.push c) #[]
return {
imports := env.header.imports
extraConstNames := env.extraConstNames.toArray
constNames, constants, entries
}
@[export lean_write_module]
def writeModule (env : Environment) (fname : System.FilePath) : IO Unit := do
saveModuleData fname env.mainModule (← mkModuleData env)
/--
Construct a mapping from persistent extension name to entension index at the array of persistent extensions.
We only consider extensions starting with index `>= startingAt`.
-/
def mkExtNameMap (startingAt : Nat) : IO (Std.HashMap Name Nat) := do
let descrs ← persistentEnvExtensionsRef.get
let mut result := {}
for h : i in [startingAt : descrs.size] do
have : i < descrs.size := h.upper
let descr := descrs[i]
result := result.insert descr.name i
return result
private def setImportedEntries (env : Environment) (mods : Array ModuleData) (startingAt : Nat := 0) : IO Environment := do
let mut env := env
let extDescrs ← persistentEnvExtensionsRef.get
/- For extensions starting at `startingAt`, ensure their `importedEntries` array have size `mods.size`. -/
for extDescr in extDescrs[startingAt:] do
env := extDescr.toEnvExtension.modifyState env fun s => { s with importedEntries := mkArray mods.size #[] }
/- For each module `mod`, and `mod.entries`, if the extension name is one of the extensions after `startingAt`, set `entries` -/
let extNameIdx ← mkExtNameMap startingAt
for h : modIdx in [:mods.size] do
have : modIdx < mods.size := h.upper
let mod := mods[modIdx]
for (extName, entries) in mod.entries do
if let some entryIdx := extNameIdx[extName]? then
env := extDescrs[entryIdx]!.toEnvExtension.modifyState env fun s => { s with importedEntries := s.importedEntries.set! modIdx 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 getNumBuiltinAttributes : 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 ← getNumBuiltinAttributes
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 || (← getNumBuiltinAttributes) > 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 : NameHashSet := {}
moduleNames : Array Name := #[]
moduleData : Array ModuleData := #[]
regions : Array CompactedRegion := #[]
def throwAlreadyImported (s : ImportState) (const2ModIdx : Std.HashMap Name ModuleIdx) (modIdx : Nat) (cname : Name) : IO α := do
let modName := s.moduleNames[modIdx]!
let constModName := s.moduleNames[const2ModIdx[cname]!.toNat]!
throw <| IO.userError s!"import {modName} failed, environment already contains '{cname}' from {constModName}"
abbrev ImportStateM := StateRefT ImportState IO
@[inline] nonrec def ImportStateM.run (x : ImportStateM α) (s : ImportState := {}) : IO (α × ImportState) :=
x.run s
partial def importModulesCore (imports : Array Import) : ImportStateM Unit := do
for i in imports do
if i.runtimeOnly || (← get).moduleNameSet.contains i.module then
continue
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
importModulesCore mod.imports
modify fun s => { s with
moduleData := s.moduleData.push mod
regions := s.regions.push region
moduleNames := s.moduleNames.push i.module
}
/--
Return `true` if `cinfo₁` and `cinfo₂` are theorems with the same name, universe parameters,
and types. We allow different modules to prove the same theorem.
Motivation: We want to generate equational theorems on demand and potentially
in different files, and we want them to have non-private names.
We may add support for other kinds of definitions in the future. For now, theorems are
sufficient for our purposes.
We may have to revise this design decision and eagerly generate equational theorems when
we implement the module system.
Remark: we do not check whether the theorem `value` field match. This feature is useful and
ensures the proofs for equational theorems do not need to be identical. This decision
relies on the fact that theorem types are propositions, we have proof irrelevance,
and theorems are (mostly) opaque in Lean. For `Acc.rec`, we may unfold theorems
during type-checking, but we are assuming this is not an issue in practice,
and we are planning to address this issue in the future.
-/
private def equivInfo (cinfo₁ cinfo₂ : ConstantInfo) : Bool := Id.run do
let .thmInfo tval₁ := cinfo₁ | false
let .thmInfo tval₂ := cinfo₂ | false
return tval₁.name == tval₂.name
&& tval₁.type == tval₂.type
&& tval₁.levelParams == tval₂.levelParams
&& tval₁.all == tval₂.all
/--
Construct environment from `importModulesCore` results.
If `leakEnv` is true, we mark the environment as persistent, which means it
will not be freed. We set this when the object would survive until the end of
the process anyway. In exchange, RC updates are avoided, which is especially
important when they would be atomic because the environment is shared across
threads (potentially, storing it in an `IO.Ref` is sufficient for marking it
as such). -/
def finalizeImport (s : ImportState) (imports : Array Import) (opts : Options) (trustLevel : UInt32 := 0)
(leakEnv := false) : IO Environment := do
let numConsts := s.moduleData.foldl (init := 0) fun numConsts mod =>
numConsts + mod.constants.size + mod.extraConstNames.size
let mut const2ModIdx : Std.HashMap Name ModuleIdx := Std.HashMap.empty (capacity := numConsts)
let mut constantMap : Std.HashMap Name ConstantInfo := Std.HashMap.empty (capacity := numConsts)
for h:modIdx in [0:s.moduleData.size] do
let mod := s.moduleData[modIdx]'h.upper
for cname in mod.constNames, cinfo in mod.constants do
match constantMap.getThenInsertIfNew? cname cinfo with
| (cinfoPrev?, constantMap') =>
constantMap := constantMap'
if let some cinfoPrev := cinfoPrev? then
-- Recall that the map has not been modified when `cinfoPrev? = some _`.
unless equivInfo cinfoPrev cinfo do
throwAlreadyImported s const2ModIdx modIdx cname
const2ModIdx := const2ModIdx.insertIfNew cname modIdx
for cname in mod.extraConstNames do
const2ModIdx := const2ModIdx.insertIfNew cname modIdx
let constants : ConstMap := SMap.fromHashMap constantMap false
let exts ← mkInitialExtensionStates
let mut env : Environment := {
const2ModIdx := const2ModIdx
constants := constants
extraConstNames := {}
extensions := exts
header := {
quotInit := !imports.isEmpty -- We assume `core.lean` initializes quotient module
trustLevel := trustLevel
imports := imports
regions := s.regions
moduleNames := s.moduleNames
moduleData := s.moduleData
}
}
env ← setImportedEntries env s.moduleData
if leakEnv then
/- Mark persistent a first time before `finalizePersistenExtensions`, which
avoids costly MT markings when e.g. an interpreter closure (which
contains the environment) is put in an `IO.Ref`. This can happen in e.g.
initializers of user environment extensions and is wasteful because the
environment is marked persistent immediately afterwards anyway when the
constructed extension including the closure is ultimately stored in the
initialized constant. We have seen significant savings in `open Mathlib`
timings, where we have both a big environment and interpreted environment
extensions, from this. There is no significant extra cost to calling
`markPersistent` multiple times like this. -/
env := Runtime.markPersistent env
env ← finalizePersistentExtensions env s.moduleData opts
if leakEnv then
/- Ensure the final environment including environment extension states is
marked persistent as documented. -/
env := Runtime.markPersistent env
pure env
@[export lean_import_modules]
def importModules (imports : Array Import) (opts : Options) (trustLevel : UInt32 := 0)
(leakEnv := false) : 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) ← importModulesCore imports |>.run
finalizeImport (leakEnv := leakEnv) s imports opts trustLevel
/--
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 : Array Import) (opts : Options) (trustLevel : UInt32 := 0) (act : Environment → IO α) : IO α := do
let env ← importModules imports opts trustLevel
try act env finally env.freeRegions
/--
Environment extension for tracking all `namespace` declared by users.
-/
builtin_initialize namespacesExt : SimplePersistentEnvExtension Name NameSSet ←
registerSimplePersistentEnvExtension {
addImportedFn := fun as =>
/-
We compute a `HashMap Name Unit` and then convert to `NameSSet` to improve Lean startup time.
Note: we have used `perf` to profile Lean startup cost when processing a file containing just `import Lean`.
6.18% of the runtime is here. It was 9.31% before the `HashMap` optimization.
-/
let capacity := as.foldl (init := 0) fun r e => r + e.size
let map : Std.HashMap Name Unit := Std.HashMap.empty capacity
let map := mkStateFromImportedEntries (fun map name => map.insert name ()) map as
SMap.fromHashMap map |>.switch
addEntryFn := fun s n => s.insert n
}
structure Kernel.Diagnostics where
/-- Number of times each declaration has been unfolded by the kernel. -/
unfoldCounter : PHashMap Name Nat := {}
/-- If `enabled = true`, kernel records declarations that have been unfolded. -/
enabled : Bool := false
deriving Inhabited
/--
Extension for storting diagnostic information.
Remark: We store kernel diagnostic information in an environment extension to simplify
the interface with the kernel implemented in C/C++. Thus, we can only track
declarations in methods, such as `addDecl`, which return a new environment.
`Kernel.isDefEq` and `Kernel.whnf` do not update the statistics. We claim
this is ok since these methods are mainly used for debugging.
-/
builtin_initialize diagExt : EnvExtension Kernel.Diagnostics ←
registerEnvExtension (pure {})
@[export lean_kernel_diag_is_enabled]
def Kernel.Diagnostics.isEnabled (d : Diagnostics) : Bool :=
d.enabled
/-- Enables/disables kernel diagnostics. -/
def Kernel.enableDiag (env : Environment) (flag : Bool) : Environment :=
diagExt.modifyState env fun s => { s with enabled := flag }
def Kernel.isDiagnosticsEnabled (env : Environment) : Bool :=
diagExt.getState env |>.enabled
def Kernel.resetDiag (env : Environment) : Environment :=
diagExt.modifyState env fun s => { s with unfoldCounter := {} }
@[export lean_kernel_record_unfold]
def Kernel.Diagnostics.recordUnfold (d : Diagnostics) (declName : Name) : Diagnostics :=
if d.enabled then
let cNew := if let some c := d.unfoldCounter.find? declName then c + 1 else 1
{ d with unfoldCounter := d.unfoldCounter.insert declName cNew }
else
d
@[export lean_kernel_get_diag]
def Kernel.getDiagnostics (env : Environment) : Diagnostics :=
diagExt.getState env
@[export lean_kernel_set_diag]
def Kernel.setDiagnostics (env : Environment) (diag : Diagnostics) : Environment :=
diagExt.setState env diag
namespace Environment
/-- Register a new namespace in the environment. -/
def registerNamespace (env : Environment) (n : Name) : Environment :=
if (namespacesExt.getState env).contains n then env else namespacesExt.addEntry env n
/-- Return `true` if `n` is the name of a namespace in `env`. -/
def isNamespace (env : Environment) (n : Name) : Bool :=
(namespacesExt.getState env).contains n
/-- Return a set containing all namespaces in `env`. -/
def getNamespaceSet (env : Environment) : NameSSet :=
namespacesExt.getState env
private def isNamespaceName : Name → Bool
| .str .anonymous _ => true
| .str p _ => isNamespaceName p
| _ => false
private def registerNamePrefixes : Environment → Name → Environment
| env, .str p _ => if isNamespaceName p then registerNamePrefixes (registerNamespace env p) p else env
| env, _ => env
@[export lean_environment_add]
private def add (env : Environment) (cinfo : ConstantInfo) : Environment :=
let name := cinfo.name
let env := match name with
| .str _ s =>
if s.get 0 == '_' then
-- Do not register namespaces that only contain internal declarations.
env
else
registerNamePrefixes env name
| _ => env
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 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) : Except KernelException Bool
def isDefEqGuarded (env : Environment) (lctx : LocalContext) (a b : Expr) : Bool :=
if let .ok result := isDefEq env lctx a b then result else false
/--
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) : Except KernelException Expr
end Kernel
class MonadEnv (m : Type → Type) where
getEnv : m Environment
modifyEnv : (Environment → Environment) → m Unit
export MonadEnv (getEnv modifyEnv)
@[always_inline]
instance (m n) [MonadLift m n] [MonadEnv m] : MonadEnv n where
getEnv := liftM (getEnv : m Environment)
modifyEnv := fun f => liftM (modifyEnv f : m Unit)
/-- Constructs a DefinitionVal, inferring the `unsafe` field -/
def mkDefinitionValInferrringUnsafe [Monad m] [MonadEnv m] (name : Name) (levelParams : List Name)
(type : Expr) (value : Expr) (hints : ReducibilityHints) : m DefinitionVal := do
let env ← getEnv
let safety := if env.hasUnsafe type || env.hasUnsafe value then DefinitionSafety.unsafe else DefinitionSafety.safe
return { name, levelParams, type, value, hints, safety }
end Lean