feat: basic precompiled modules + builtin module facets

closes leanprover/lake#47
This commit is contained in:
tydeu 2022-06-22 13:20:15 -04:00
parent aa4b82c53f
commit f7451e025c
24 changed files with 1017 additions and 263 deletions

View file

@ -34,7 +34,8 @@ def proc (args : IO.Process.SpawnArgs) : BuildM PUnit := do
def compileLeanModule (leanFile : FilePath)
(oleanFile? ileanFile? cFile? : Option FilePath)
(oleanPath : SearchPath := []) (rootDir : FilePath := ".")
(leanArgs : Array String := #[]) (lean : FilePath := "lean")
(dynlibs : Array FilePath := #[]) (leanArgs : Array String := #[])
(lean : FilePath := "lean")
: BuildM PUnit := do
let mut args := leanArgs ++
#[leanFile.toString, "-R", rootDir.toString]
@ -47,8 +48,10 @@ def compileLeanModule (leanFile : FilePath)
if let some cFile := cFile? then
createParentDirs cFile
args := args ++ #["-c", cFile.toString]
for dynlib in dynlibs do
args := args.push s!"--load-dynlib={dynlib}"
proc {
args,
args
cmd := lean.toString
env := #[("LEAN_PATH", oleanPath.toString)]
}

View file

@ -6,40 +6,23 @@ Authors: Mac Malone
import Lake.Build.Package
import Lake.Build.Targets
open System
open Std System
open Lean (Name NameMap)
namespace Lake
-- # Build Package .o Files
def Package.oFileTargetsOf
(targetMap : ModuleMap ActiveOpaqueTarget) (self : Package) : Array FileTarget :=
targetMap.fold (fun arr k v => arr.push (k, v)) #[] |>.filterMap fun (key, target) =>
if key.facet == `lean.c && self.isLocalModule key.module then
let mod : Module := ⟨self, key.module⟩
let target := Target.active <| target.withInfo mod.cFile
leanOFileTarget mod.oFile target self.moreLeancArgs
else
none
def Module.mkOTarget (modTarget : OpaqueTarget) (self : Module) : FileTarget :=
leanOFileTarget self.oFile (self.mkCTarget modTarget) self.leancArgs
def Module.oTarget (self : Module) : FileTarget :=
self.mkOTarget <| self.leanBinTarget (c := true)
-- # Build Package Static Lib
def Package.mkStaticLibTarget (self : Package) (lib : LeanLibConfig) : FileTarget :=
def Package.localTargetsOf (map : NameMap (ActiveBuildTarget α)) (self : Package) : Array (BuildTarget α) :=
map.fold (fun a n v => if self.isLocalModule n then a.push (Target.active v) else a) #[]
def Package.mkStaticLibTarget (lib : LeanLibConfig) (self : Package) : FileTarget :=
let libFile := self.libDir / lib.staticLibFileName
BuildTarget.mk' libFile do
let depTarget ← self.buildExtraDepsTarget
let mods ← self.getLibModuleArray lib
let moduleTargetMap ← buildModuleMap mods $
recBuildModuleTargetWithDeps depTarget (c := true)
let oFileTargets := self.oFileTargetsOf moduleTargetMap
staticLibTarget libFile oFileTargets |>.materializeAsync
withExtraDepTarget (← self.buildExtraDepsTarget) do
let mods ← self.getLibModuleArray lib
let oFileTargets := self.localTargetsOf <| ← buildModuleMap mods &`lean.o
staticLibTarget libFile oFileTargets |>.materializeAsync
protected def Package.staticLibTarget (self : Package) : FileTarget :=
self.mkStaticLibTarget self.builtinLibConfig
@ -47,29 +30,27 @@ protected def Package.staticLibTarget (self : Package) : FileTarget :=
-- # Build Package Shared Lib
def Package.linkTargetsOf
(targetMap : ModuleMap ActiveOpaqueTarget) (self : Package) : LakeM (Array FileTarget) := do
(targetMap : NameMap ActiveFileTarget) (self : Package) : LakeM (Array FileTarget) := do
let collect dep recurse := do
let pkg := (← findPackage? dep.name).get!
pkg.dependencies.forM fun dep => discard <| recurse dep
return pkg.oFileTargetsOf targetMap ++ pkg.externLibTargets
let ⟨x, map⟩ ← RBTopT.run (cmp := Name.quickCmp) <| self.dependencies.forM fun dep =>
discard <| buildTop collect Dependency.name dep
let pkg := (← findPackage? dep.name).get!
pkg.dependencies.forM fun dep => discard <| recurse dep
return pkg.localTargetsOf targetMap ++ pkg.externLibTargets
let ⟨x, map⟩ ← EStateT.run (mkRBMap _ _ Name.quickCmp) <|
self.dependencies.forM fun dep => discard <| buildTop Dependency.name collect dep
match x with
| Except.ok _ =>
let ts := map.fold (fun acc _ vs => acc ++ vs) #[]
return self.oFileTargetsOf targetMap ++ self.externLibTargets ++ ts
return self.localTargetsOf targetMap ++ self.externLibTargets ++ ts
| Except.error _ => panic! "dependency cycle emerged after resolution"
def Package.mkSharedLibTarget (self : Package) (lib : LeanLibConfig) : FileTarget :=
let libFile := self.libDir / lib.sharedLibFileName
BuildTarget.mk' libFile do
let depTarget ← self.buildExtraDepsTarget
let mods ← self.getLibModuleArray lib
let moduleTargetMap ← buildModuleMap mods $
recBuildModuleTargetWithDeps depTarget (c := true)
let linkTargets ← self.linkTargetsOf moduleTargetMap
let target := leanSharedLibTarget libFile linkTargets lib.linkArgs
target.materializeAsync
withExtraDepTarget (← self.buildExtraDepsTarget) do
let mods ← self.getLibModuleArray lib
let linkTargets ← self.linkTargetsOf <| ← buildModuleMap mods &`lean.o
let target := leanSharedLibTarget libFile linkTargets lib.linkArgs
target.materializeAsync
protected def Package.sharedLibTarget (self : Package) : FileTarget :=
self.mkSharedLibTarget self.builtinLibConfig
@ -79,20 +60,19 @@ protected def Package.sharedLibTarget (self : Package) : FileTarget :=
def Package.mkExeTarget (self : Package) (exe : LeanExeConfig) : FileTarget :=
let exeFile := self.binDir / exe.fileName
BuildTarget.mk' exeFile do
let root : Module := ⟨self, exe.root⟩
let depTarget ← self.buildExtraDepsTarget
let moduleTargetMap ← buildModuleMap #[root] $
recBuildModuleTargetWithDeps depTarget (c := true)
let pkgLinkTargets ← self.linkTargetsOf moduleTargetMap
let linkTargets :=
if self.isLocalModule exe.root then
pkgLinkTargets
else
let rootTarget := moduleTargetMap.find? (root.key `lean) |>.get!
let rootLinkTarget := root.mkOTarget <| Target.active rootTarget
#[rootLinkTarget] ++ pkgLinkTargets
let target := leanExeTarget exeFile linkTargets exe.linkArgs
target.materializeAsync
let root : Module := ⟨self, WfName.ofName exe.root⟩
withExtraDepTarget (← self.buildExtraDepsTarget) do
let cTargetMap ← buildModuleMap #[root] &`lean.c
let pkgLinkTargets ← self.linkTargetsOf cTargetMap
let linkTargets :=
if self.isLocalModule exe.root then
pkgLinkTargets
else
let rootTarget := cTargetMap.find? root.name |>.get!
let rootLinkTarget := root.mkOTarget <| Target.active rootTarget
#[rootLinkTarget] ++ pkgLinkTargets
let target := leanExeTarget exeFile linkTargets exe.linkArgs
target.materializeAsync
protected def Package.exeTarget (self : Package) : FileTarget :=
self.mkExeTarget self.builtinExeConfig

View file

@ -13,9 +13,16 @@ import Lake.Build.Trace
open System
namespace Lake
/-- The `Task` monad for Lake builds. -/
abbrev BuildTask := OptionIOTask
/-- A Lake build job. -/
abbrev Job := BuildTask BuildTrace
/-- A Lake context with some additional caching for builds. -/
structure BuildContext extends Context where
leanTrace : BuildTrace
extraDepJob : Job := pure nilTrace
/-- A transformer to equip a monad with a `BuildContext`. -/
abbrev BuildT := ReaderT BuildContext
@ -26,12 +33,6 @@ abbrev SchedulerM := BuildT <| LogT BaseIO
/-- The monad for Lake builds. -/
abbrev BuildM := BuildT <| MonadLogT BaseIO OptionIO
/-- The `Task` monad for Lake builds. -/
abbrev BuildTask := OptionIOTask
/-- A Lake build job. -/
abbrev Job := BuildTask BuildTrace
instance : MonadError BuildM := ⟨MonadLog.error⟩
instance : MonadLift IO BuildM := ⟨MonadError.runIO⟩

View file

@ -3,25 +3,68 @@ Copyright (c) 2021 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sebastian Ullrich, Mac Malone
-/
import Lean.Data.Name
import Lake.Util.EStateT
import Lean.Elab.Import
import Lake.Build.Target
import Lake.Build.Actions
import Lake.Build.Recursive
import Lake.Build.TargetTypes
import Lake.Build.Targets
import Lake.Config.Module
open System
open Std System
open Lean hiding SearchPath
namespace Lake
abbrev ModuleSet := RBTree Module (·.name.quickCmp ·.name)
@[inline] def ModuleSet.empty : ModuleSet := RBTree.empty
abbrev ModuleMap (α) := RBMap Module α (·.name.quickCmp ·.name)
@[inline] def ModuleMap.empty : ModuleMap α := RBMap.empty
-- # Dynamic Data
class DynamicType {α : Type u} (Δ : α → Type v) (a : α) (β : outParam $ Type v) : Prop where
eq_dynamic_type : Δ a = β
export DynamicType (eq_dynamic_type)
@[inline] def toDynamic (a : α) [DynamicType Δ a β] (b : β) : Δ a :=
cast eq_dynamic_type.symm b
@[inline] def ofDynamic (a : α) [DynamicType Δ a β] (b : Δ a) : β :=
cast eq_dynamic_type b
@[inline]
instance [MonadDStore κ β m] [t : DynamicType β k α] : MonadStore1 k α m where
fetch? := cast (by rw [t.eq_dynamic_type]) <| fetch? (m := m) k
store o := store k <| cast t.eq_dynamic_type.symm o
-- ## For Facets
opaque FacetData : WfName → Type
macro "register_facet_data " id:ident " : " ty:term : command =>
let key := WfName.quoteFrom id <| WfName.ofName <| id.getId
let axm := mkIdent <| ``FacetData ++ id.getId
`(@[simp] axiom $axm : FacetData $key = $ty
instance : DynamicType FacetData $key $ty := ⟨$axm⟩)
register_facet_data lean : ActiveOpaqueTarget
register_facet_data olean : ActiveOpaqueTarget
register_facet_data ilean : ActiveOpaqueTarget
register_facet_data lean.c : ActiveFileTarget
register_facet_data lean.o : ActiveFileTarget
register_facet_data lean.dynlib : ActiveFileTarget
register_facet_data lean.imports : Array Module × Array Module
register_facet_data lean.extraDep : ActiveOpaqueTarget
-- # Build Key
structure ModuleBuildKey where
module : Name
facet : Name
deriving Inhabited, Repr, BEq, Hashable
module : WfName
facet : WfName
deriving Inhabited, Repr, DecidableEq, Hashable
namespace ModuleBuildKey
@ -30,6 +73,22 @@ def quickCmp (lhs rhs : ModuleBuildKey) :=
| .eq => lhs.facet.quickCmp rhs.facet
| ord => ord
theorem eq_of_quickCmp :
{k k' : _} → quickCmp k k' = Ordering.eq → k = k' := by
intro ⟨m, f⟩ ⟨m', f'⟩
unfold quickCmp
split
next mod_eq =>
intro facet_eq
let mod_eq := WfName.eq_of_quickCmp mod_eq
let facet_eq := WfName.eq_of_quickCmp facet_eq
simp only [mod_eq, facet_eq]
next =>
intros; contradiction
instance : EqOfCmp ModuleBuildKey quickCmp where
eq_of_cmp := eq_of_quickCmp
protected def toString (self : ModuleBuildKey) :=
s!"{self.module}:{self.facet}"
@ -37,13 +96,54 @@ instance : ToString ModuleBuildKey := ⟨(·.toString)⟩
end ModuleBuildKey
def Module.key (facet : Name) (self : Module) : ModuleBuildKey :=
⟨self.name, facet⟩
-- ## Static Keys
-- # Single Module Target
abbrev DModuleBuildKey (facet : WfName) :=
{k : ModuleBuildKey // k.facet = facet}
def moduleTarget (mod : Module)
(depTarget : BuildTarget x) (c := true) : OpaqueTarget :=
def Module.mkBuildKey (facet : WfName) (self : Module) : DModuleBuildKey facet :=
⟨⟨self.name, facet⟩, rfl⟩
abbrev ModuleBuildKeyData (key : ModuleBuildKey) := FacetData key.facet
@[inline]
instance [MonadDStore ModuleBuildKey ModuleBuildKeyData m]
[h : DynamicType FacetData f α] : MonadStore (DModuleBuildKey f) α m where
fetch? k :=
let of_data := by
unfold ModuleBuildKeyData
rw [k.property, h.eq_dynamic_type]
cast of_data <| MonadDStore.fetch? (m := m) k.val
store k o :=
let to_data := by
unfold ModuleBuildKeyData
rw [k.property, h.eq_dynamic_type]
MonadDStore.store (m := m) k.val <| cast to_data o
-- # Module Build Info
structure ModuleBuildInfo extends Module where
facet : WfName
instance : Coe ModuleBuildInfo Module := ⟨(·.toModule)⟩
def ModuleBuildInfo.buildKey (self : ModuleBuildInfo) : DModuleBuildKey self.facet :=
self.mkBuildKey self.facet
structure DModuleBuildInfo (facet : WfName) extends ModuleBuildInfo where
law : toModuleBuildInfo.facet = facet
instance : Coe (DModuleBuildInfo k) ModuleBuildInfo := ⟨(·.toModuleBuildInfo)⟩
abbrev Module.mkFacetInfo (facet : WfName) (self : Module) : DModuleBuildInfo facet :=
⟨⟨self, facet⟩, rfl⟩
abbrev ModuleBuildData (info : ModuleBuildInfo) := FacetData info.facet
-- # Solo Module Targets
def Module.soloTarget (mod : Module)
(dynlibs : Array FilePath) (depTarget : BuildTarget x) (c := true) : OpaqueTarget :=
Target.opaque <| depTarget.bindOpaqueSync fun depTrace => do
let argTrace : BuildTrace := pureHash mod.leanArgs
let srcTrace : BuildTrace ← computeTrace mod.leanFile
@ -53,93 +153,225 @@ def moduleTarget (mod : Module)
let cUpToDate ← modTrace.checkAgainstFile mod.cFile mod.cTraceFile
unless modUpToDate && cUpToDate do
compileLeanModule mod.leanFile mod.oleanFile mod.ileanFile mod.cFile
(← getOleanPath) mod.pkg.rootDir mod.leanArgs (← getLean)
(← getOleanPath) mod.pkg.rootDir dynlibs mod.leanArgs (← getLean)
modTrace.writeToFile mod.cTraceFile
else
unless modUpToDate do
compileLeanModule mod.leanFile mod.oleanFile mod.ileanFile none
(← getOleanPath) mod.pkg.rootDir mod.leanArgs (← getLean)
(← getOleanPath) mod.pkg.rootDir dynlibs mod.leanArgs (← getLean)
modTrace.writeToFile mod.traceFile
return depTrace
def Module.mkCTarget (modTarget : BuildTarget x) (self : Module) : FileTarget :=
Target.mk self.cFile <| modTarget.bindOpaqueSync fun _ =>
return mixTrace (← computeTrace self.cFile) (← getLeanTrace)
@[inline]
def Module.mkOTarget (cTarget : FileTarget) (self : Module) : FileTarget :=
leanOFileTarget self.oFile cTarget self.leancArgs
@[inline]
def Module.mkDynlibTarget (linkTargets : Array FileTarget) (self : Module) : FileTarget :=
leanSharedLibTarget self.dynlib linkTargets self.linkArgs
-- # Recursive Building
/--
Produces a recursive module target builder that builds the target module
with the `build` function after recursively building its local imports
(relative to the workspace).
-/
def recBuildModuleWithLocalImports [Monad m] [MonadLiftT BuildM m]
(build : Module → List α → m α) : RecBuild Module α m := fun mod recurse => do
have : MonadLift BuildM m := ⟨liftM⟩
let contents ← IO.FS.readFile mod.leanFile
let (imports, _, _) ← Elab.parseImports contents mod.leanFile.toString
-- we construct the import targets even if a rebuild is not required
-- because other build processes (ex. `.o`) rely on the map being complete
let importTargets ← imports.filterMapM fun imp => OptionT.run do
recurse <| ← OptionT.mk <| findModule? imp.module
build mod importTargets
abbrev ModuleBuild (m) :=
DBuild ModuleBuildInfo ModuleBuildData m
abbrev FacetBuildMap (m : Type → Type v) :=
DRBMap WfName (cmp := WfName.quickCmp) fun k =>
Module → ModuleBuild m → m (FacetData k)
@[inline] def FacetBuildMap.empty : FacetBuildMap m := DRBMap.empty
@[inline] def mkFacetBuild {facet : WfName} (build : Module → ModuleBuild m → m α)
[h : DynamicType FacetData facet α] : Module → ModuleBuild m → m (FacetData facet) :=
cast (by rw [← h.eq_dynamic_type]) build
@[inline] def buildFacet {m : Type → Type v}
(mod : Module) (facet : WfName) [DynamicType FacetData facet α]
(build : (info : ModuleBuildInfo) → m (ModuleBuildData info)) : m α :=
cast (by simp only [ModuleBuildData, eq_dynamic_type]) (build ⟨mod, facet⟩)
section
variable [Monad m] [MonadLiftT BuildM m]
[MonadDStore ModuleBuildKey ModuleBuildKeyData m]
/--
Produces a recursive module target builder that builds the
`olean`, `ilean`, and (optionally) `c` files of a module and its local imports
after `extraDepTarget` finishes building.
Recursively build a module and its (transitive, local) imports,
optionally outputting a `.c` file as well if `c` is set to `true`.
-/
def recBuildModuleTargetWithDeps
[Monad m] [MonadLiftT BuildM m] [MonadStore ModuleBuildKey ActiveOpaqueTarget m]
(extraDepTarget : ActiveBuildTarget x) (c := true) : RecBuild Module ActiveOpaqueTarget m :=
recBuildModuleWithLocalImports fun mod importTargets => do
have : MonadLift BuildM m := ⟨liftM⟩
let importTarget ← ActiveTarget.collectOpaqueList importTargets
let allDepsTarget := Target.active <| ← extraDepTarget.mixOpaqueAsync importTarget
let modTarget := (← moduleTarget mod allDepsTarget c |>.activate).withoutInfo
@[inline] def Module.recBuildLeanModule (mod : Module) (c : Bool)
(recurse : ModuleBuild m) : m ActiveOpaqueTarget := do
have : MonadLift BuildM m := ⟨liftM⟩
let extraDepTarget ← buildFacet mod &`lean.extraDep recurse
let (imports, transImports) ← buildFacet mod &`lean.imports recurse
let dynlibsTarget ←
if mod.shouldPrecompile then
ActiveTarget.collectArray
<| ← transImports.mapM (buildFacet · &`lean.dynlib recurse)
else
pure <| ActiveTarget.nil.withInfo #[]
let importTarget ←
if c then
let cTarget ← liftM (m := SchedulerM) do
return ActiveTarget.opaque <| ← modTarget.bindOpaqueSync (m := BuildM) fun _ => do
return mixTrace (← computeTrace mod.cFile) (← getLeanTrace)
store (mod.key `lean.c) cTarget
ActiveTarget.collectOpaqueArray
<| ← imports.mapM (buildFacet · &`lean.c recurse)
else
ActiveTarget.collectOpaqueArray
<| ← imports.mapM (buildFacet · &`lean recurse)
let depTarget := Target.active <| ← extraDepTarget.mixOpaqueAsync
<| ← dynlibsTarget.mixOpaqueAsync importTarget
let modTarget ← mod.soloTarget dynlibsTarget.info depTarget c |>.activate
store (mod.mkBuildKey &`lean) modTarget
store (mod.mkBuildKey &`olean) modTarget
store (mod.mkBuildKey &`ilean) modTarget
if c then
let cTarget ← mod.mkCTarget (Target.active modTarget) |>.activate
store (mod.mkBuildKey &`lean.c) cTarget
return cTarget.withoutInfo
else
return modTarget
-- ## Definitions
/--
A facet name to build function map that contains builders
for the initial set of Lake module facets (i.e. `lean.{imports, c, o, dynlib]`).
-/
@[specialize] def facetBuildMap : FacetBuildMap m :=
have : MonadLift BuildM m := ⟨liftM⟩
FacetBuildMap.empty.insert
-- Get extra module dependency job (i.e., for package dependencies)
&`lean.extraDep (mkFacetBuild <| fun _ _ => do
return ActiveTarget.opaque <| (← read).extraDepJob
) |>.insert
-- Compute unique imports (direct × transitive)
&`lean.imports (mkFacetBuild <| fun mod recurse => do
let contents ← IO.FS.readFile mod.leanFile
let (imports, _, _) ← Elab.parseImports contents mod.leanFile.toString
let importSet ← imports.foldlM (init := ModuleSet.empty) fun a imp => do
if let some mod ← findModule? imp.module then return a.insert mod else return a
let mut imports := #[]
let mut transImports := ModuleSet.empty
for imp in importSet do
let (_, impTransImports) ← buildFacet imp &`lean.imports recurse
for imp in impTransImports do
transImports := transImports.insert imp
transImports := transImports.insert imp
imports := imports.push imp
return (imports, transImports.toArray)
) |>.insert
-- Build module (`.olean` and `.ilean`)
&`lean (mkFacetBuild <| fun mod recurse => do
mod.recBuildLeanModule false recurse
) |>.insert
&`olean (mkFacetBuild <| fun mod recurse => do
buildFacet mod &`lean recurse
) |>.insert
&`ilean (mkFacetBuild <| fun mod recurse => do
buildFacet mod &`lean recurse
) |>.insert
-- Build module `.c` (and `.olean` and `.ilean`)
&`lean.c (mkFacetBuild <| fun mod recurse => do
mod.recBuildLeanModule true recurse <&> (·.withInfo mod.cFile)
) |>.insert
-- Build module `.o`
&`lean.o (mkFacetBuild <| fun mod recurse => do
let cTarget ← buildFacet mod &`lean.c recurse
mod.mkOTarget (Target.active cTarget) |>.activate
) |>.insert
-- Build shared library for `--load-dynlb`
&`lean.dynlib (mkFacetBuild <| fun mod recurse => do
let oTarget ← buildFacet mod &`lean.o recurse
let dynlibTargets ← if mod.shouldPrecompile then
let (_, transImports) ← buildFacet mod &`lean.imports recurse
transImports.mapM fun mod => buildFacet mod &`lean.dynlib recurse
else
pure #[]
-- TODO: Link in external libraries
-- let externLibTargets ← mod.pkg.externLibTargets.mapM (·.activate)
-- let linkTargets := #[oTarget] ++ sharedLibTargets ++ externLibTargets |>.map Target.active
let linkTargets := #[oTarget] ++ dynlibTargets |>.map Target.active
mod.mkDynlibTarget linkTargets |>.activate
)
abbrev ModuleMap (α) :=
Std.RBMap ModuleBuildKey α ModuleBuildKey.quickCmp
/-- Recursively builder for module facets. -/
@[inline] def recBuildModuleFacet : DRecBuild ModuleBuildInfo ModuleBuildData m :=
have : MonadLift BuildM m := ⟨liftM⟩
fun info recurse => do
if let some build := facetBuildMap.find? info.facet then
build info recurse
else
error s!"do not know how to build module facet `{info.facet}`"
abbrev ModuleBuildM (α) :=
-- equivalent to `RBTopT ModuleBuildKey α BuildM ModuleBuildKey.quickCmp`
-- phrased this way to use `ModuleMap`
EStateT (List ModuleBuildKey) (ModuleMap α) BuildM
/-- Auxiliary function for `buildModuleTop` and `buildModuleTop'`. -/
@[specialize] def buildModuleTopCore (mod : Module)
(facet : WfName) : CycleT ModuleBuildKey m (FacetData facet) :=
let of_data := by
simp [ModuleBuildKeyData, ModuleBuildInfo.buildKey, Module.mkBuildKey]
cast of_data <| buildDTop (m := m) ModuleBuildKeyData (·.buildKey)
recBuildModuleFacet (ModuleBuildInfo.mk mod facet)
abbrev RecModuleBuild (o) :=
RecBuild Module o (ModuleBuildM o)
/--
Build the module's specified facet recursively using a topological-sort
based scheduler, storing the results in the monad's store and returning the
result of the top-level build.
-/
@[inline] def buildModuleTop (mod : Module) (facet : WfName)
[h : DynamicType FacetData facet α] : CycleT ModuleBuildKey m α :=
let of_data := by rw [h.eq_dynamic_type]
cast of_data <| buildModuleTopCore mod facet
abbrev RecModuleTargetBuild :=
RecModuleBuild ActiveOpaqueTarget
/--
Build the module's specified facet recursively using a topological-sort
based scheduler, storing the results in the monad's store and returning nothing.
-/
@[inline] def buildModuleTop' (mod : Module) (facet : WfName) : CycleT ModuleBuildKey m PUnit :=
discard <| buildModuleTopCore mod facet
end
-- ## Module Map
abbrev ModuleFacetMap :=
DRBMap ModuleBuildKey ModuleBuildKeyData ModuleBuildKey.quickCmp
def ModuleFacetMap.empty : ModuleFacetMap := DRBMap.empty
-- ## Multi-Module Builders
/-- Build a single module using the recursive module build function `build`. -/
def buildModule (mod : Module)
[Inhabited o] (build : RecModuleBuild o) : BuildM o := do
failOnBuildCycle <| ← RBTopT.run' do
buildTop build (·.key `lean) mod
/--
Recursively build the specified facet of the given module,
returning the result.
-/
def buildModule (mod : Module) (facet : WfName) [DynamicType FacetData facet α] : BuildM α := do
failOnBuildCycle <| ← EStateT.run' ModuleFacetMap.empty do
buildModuleTop mod facet
/--
Build each module using the recursive module function `build`,
constructing an `Array` of the results.
Recursively build the specified facet of each module,
returning an `Array` of the results.
-/
def buildModuleArray (mods : Array Module)
[Inhabited o] (build : RecModuleBuild o) : BuildM (Array o) := do
failOnBuildCycle <| ← RBTopT.run' <| mods.mapM <|
buildTop build (·.key `lean)
def buildModuleArray
(mods : Array Module) (facet : WfName)
[DynamicType FacetData facet α] : BuildM (Array α) := do
failOnBuildCycle <| ← EStateT.run' ModuleFacetMap.empty <| mods.mapM fun mod =>
buildModuleTop mod facet
/--
Build each module using the recursive module function `build`,
constructing a module-target `NameMap` of the results.
Recursively build the specified facet of the given module,
returning the resulting map of built modules and their results.
-/
def buildModuleMap (mods : Array Module)
[Inhabited o] (build : RecModuleBuild o) : BuildM (ModuleMap o) := do
let (x, map) ← RBTopT.run <| mods.forM fun mod =>
discard <| buildTop build (·.key `lean) mod
def buildModuleMap
(mods : Array Module) (facet : WfName)
[DynamicType FacetData facet α] : BuildM (NameMap α) := do
let (x, fullMap) ← EStateT.run ModuleFacetMap.empty <| mods.forM fun mod =>
buildModuleTop' mod facet
failOnBuildCycle x
return map
let mut res : NameMap α := RBMap.empty
for ⟨k, v⟩ in fullMap do
if h : k.facet = facet then
let of_data := by
unfold ModuleBuildKeyData
simp [h, eq_dynamic_type]
res := res.insert k.module <| cast of_data v
return res

View file

@ -5,7 +5,7 @@ Authors: Gabriel Ebner, Sebastian Ullrich, Mac Malone
-/
import Lake.Build.Module
open System
open Std System
open Lean hiding SearchPath
namespace Lake
@ -22,8 +22,8 @@ protected def Package.buildExtraDepsTarget (self : Package) : SchedulerM ActiveO
let pkg := (← findPackage? dep.name).get!
let depTargets ← pkg.dependencies.mapM recurse
liftM <| collect pkg depTargets
let targetsE ← RBTopT.run' (cmp := Name.quickCmp) <| self.dependencies.mapM fun dep =>
buildTop build Dependency.name dep
let targetsE ← EStateT.run' (mkRBMap _ _ Name.quickCmp) <|
self.dependencies.mapM fun dep => buildTop Dependency.name build dep
match targetsE with
| Except.ok targets => collect self targets
| Except.error _ => panic! "dependency cycle emerged after resolution"
@ -35,49 +35,52 @@ def buildExtraDepsTarget : SchedulerM ActiveOpaqueTarget := do
-- # Build Package Modules
def withExtraDepTarget (depTarget : ActiveOpaqueTarget) (act : BuildT m α) : BuildT m α :=
fun ctx => act {ctx with extraDepJob := depTarget.task}
def Package.getLibModuleArray (lib : LeanLibConfig) (self : Package) : IO (Array Module) := do
return (← lib.getModuleArray self.srcDir).map (Module.mk self)
return (← lib.getModuleArray self.srcDir).map (⟨self, WfName.ofName ·⟩)
/--
Build the `extraDepTarget` of a package and its (transitive) dependencies
and then build the library's modules recursively using the `build` function,
constructing a single opaque target for the whole build.
and then build the target `facet` of library's modules recursively, constructing
a single opaque target for the whole build.
-/
def Package.buildLibModules (self : Package) (lib : LeanLibConfig)
(build : ActiveOpaqueTarget → RecModuleTargetBuild) : SchedulerM Job := do
let depTarget ← self.buildExtraDepsTarget
let buildMods : BuildM _ := do
let mods ← self.getLibModuleArray lib
let modTargets ← buildModuleArray mods (build depTarget)
(·.task) <$> ActiveTarget.collectOpaqueArray modTargets
buildMods.catchFailure fun _ => pure <| failure
def Package.buildLibModules
(self : Package) (lib : LeanLibConfig) (facet : WfName)
[DynamicType FacetData facet (ActiveBuildTarget α)] : SchedulerM Job := do
withExtraDepTarget (← self.buildExtraDepsTarget) do
let buildMods : BuildM _ := do
let mods ← self.getLibModuleArray lib
let modTargets ← buildModuleArray mods facet
(·.task) <$> ActiveTarget.collectOpaqueArray modTargets
buildMods.catchFailure fun _ => pure <| failure
def Package.mkLibTarget (self : Package) (lib : LeanLibConfig) : OpaqueTarget :=
Target.opaque <| self.buildLibModules lib
(recBuildModuleTargetWithDeps · (c := false))
Target.opaque <| self.buildLibModules lib &`lean
def Package.libTarget (self : Package) : OpaqueTarget :=
self.mkLibTarget self.builtinLibConfig
-- # Build Specific Modules of the Package
def Module.leanBinTarget (c := false) (self : Module) : OpaqueTarget :=
def Module.facetTarget (facet : WfName) (self : Module)
[DynamicType FacetData facet (ActiveBuildTarget α)] : OpaqueTarget :=
BuildTarget.mk' () do
let depTarget ← self.pkg.buildExtraDepsTarget
let build := recBuildModuleTargetWithDeps depTarget (c := c)
return (← buildModule self build).task
withExtraDepTarget (← self.pkg.buildExtraDepsTarget) do
return (← buildModule self facet).task
@[inline] def Module.oleanTarget (self : Module) : FileTarget :=
self.leanBinTarget false |>.withInfo self.oleanFile
self.facetTarget &`lean |>.withInfo self.oleanFile
@[inline] def Module.ileanTarget (self : Module) : FileTarget :=
self.leanBinTarget false |>.withInfo self.ileanFile
def Module.mkCTarget (modTarget : OpaqueTarget) (self : Module) : FileTarget :=
Target.mk self.cFile <| modTarget.bindOpaqueSync fun _ => computeTrace self.cFile
self.facetTarget &`lean |>.withInfo self.ileanFile
@[inline] def Module.cTarget (self : Module) : FileTarget :=
self.mkCTarget <| self.leanBinTarget (c := true)
self.facetTarget &`lean.c |>.withInfo self.cFile
@[inline] def Module.oTarget (self : Module) : FileTarget :=
self.facetTarget &`lean.o |>.withInfo self.oFile
-- # Build Imports
@ -109,10 +112,8 @@ def Package.buildImportsAndDeps (imports : List String) (self : Package) : Build
-- build local imports from list
let mods := (← getWorkspace).processImportList imports
if self.leanExes.isEmpty && self.defaultFacet matches .none | .leanLib | .oleans then
let build := recBuildModuleTargetWithDeps depTarget (c := false)
let targets ← buildModuleArray mods build
let targets ← buildModuleArray mods &`lean
targets.forM (·.buildOpaque)
else
let build := recBuildModuleTargetWithDeps depTarget (c := true)
let targets ← buildModuleArray mods build
let targets ← buildModuleArray mods &`lean.c
targets.forM (·.buildOpaque)

View file

@ -3,102 +3,99 @@ Copyright (c) 2021 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sebastian Ullrich, Mac Malone
-/
import Std.Data.RBMap
import Lake.Util.DRBMap
open Std
namespace Lake
--------------------------------------------------------------------------------
-- # Build Store
--------------------------------------------------------------------------------
/-- A monad equipped with a dependently typed key-value store for a particular key. -/
class MonadStore1 {κ : Type u} (k : κ) (α : outParam $ Type v) (m : Type v → Type w) where
fetch? : m (Option α)
store : α → m PUnit
export MonadStore1 (fetch? store)
/-- A monad equipped with a dependently typed key-object store. -/
class MonadDStore (κ : Type u) (β : outParam $ κ → Type v) (m : Type v → Type w) where
fetch? : (key : κ) → m (Option (β key))
store : (key : κ) → β key → m PUnit
instance [MonadDStore κ β m] : MonadStore1 k (β k) m where
fetch? := MonadDStore.fetch? k
store o := MonadDStore.store k o
/-- A monad equipped with a key-object store. -/
abbrev MonadStore κ α m := MonadDStore κ (fun _ => α) m
instance [MonadLiftT m n] [MonadDStore κ β m] : MonadDStore κ β n where
fetch? k := liftM (m := m) <| fetch? k
store k a := liftM (m := m) <| store k a
instance [Monad m] [EqOfCmpWrt κ β cmp] : MonadDStore κ β (StateT (DRBMap κ β cmp) m) where
fetch? k := return (← get).find? k
store k a := modify (·.insert k a)
instance [Monad m] : MonadStore κ α (StateT (RBMap κ α cmp) m) where
fetch? k := return (← get).find? k
store k a := modify (·.insert k a)
--------------------------------------------------------------------------------
-- # Topological / Suspending Builder
--------------------------------------------------------------------------------
-- ## Abstractions
/-- A dependently typed object builder. -/
abbrev DBuild.{u,v,w} (ι : Type u) (β : ι → Type v) (m : Type v → Type w) :=
(i : ι) → m (β i)
/-- A dependently typed recursive object builder. -/
abbrev DRecBuild.{u,v,w} (ι : Type u) (β : ι → Type v) (m : Type v → Type w) :=
(i : ι) → DBuild ι β m → m (β i)
/-- A recursive object builder. -/
def RecBuild.{u,v,w} (i : Type u) (o : Type v) (m : Type v → Type w) :=
i → (i → m o) → m o
abbrev RecBuild ι α m := DRecBuild ι (fun _ => α) m
/-- A monad equipped with a key-object store. -/
class MonadStore (k : Type u) (o : outParam $ Type v) (m : Type v → Type w) where
fetch? : k → m (Option o)
store : k → o → m PUnit
export MonadStore (fetch? store)
instance [Monad m] [MonadStore k o m] : MonadStore k o (ExceptT ε m) where
fetch? key := liftM (m := m) <| fetch? key
store key obj := liftM (m := m) <| store key obj
/-- `ExceptT` for build cycles. -/
abbrev CycleT (κ) :=
ExceptT (List κ)
-- ## Algorithm
/-- Auxiliary function for `buildTop`. -/
partial def buildTopCore [BEq k] [Inhabited o] [Monad m] [MonadStore k o m]
(parents : List k) (build : RecBuild i o (ExceptT (List k) m)) (keyOf : i → k) (info : i) : ExceptT (List k) m o := do
@[specialize] partial def buildTopCore [BEq κ] [Monad m] [MonadDStore κ β m]
(parents : List κ) (keyOf : ι → κ) (build : DRecBuild ι (β ∘ keyOf) (CycleT κ m))
(info : ι) : CycleT κ m (β (keyOf info)) := do
let key := keyOf info
-- detect cyclic builds
if parents.contains key then
throw <| key :: (parents.partition (· != key)).1 ++ [key]
-- return previous output if already built
if let some output ← fetch? key then
return output
-- detect cyclic builds
if parents.contains key then
throw <| key :: (parents.partition (· != key)).1 ++ [key]
-- build the key recursively
let output ← build info <| buildTopCore (key :: parents) build keyOf
let output ← build info <| buildTopCore (key :: parents) keyOf build
-- save the output (to prevent repeated builds of the same key)
store key output
return output
/-- Dependently typed version of `buildTop`. -/
@[inline] def buildDTop (β) [BEq κ] [Monad m] [MonadDStore κ β m]
(keyOf : ι → κ) (build : DRecBuild ι (β ∘ keyOf) (CycleT κ m))
(info : ι) : CycleT κ m (β (keyOf info)) :=
buildTopCore [] keyOf build info
/--
Recursively fills a `MonadStore` of key-object pairs by
building objects topologically (i.e., via a depth-first search with memoization).
building objects topologically (ι.e., via a depth-first search with memoization).
If a cycle is detected, the list of keys traversed is thrown.
Called a suspending scheduler in "Build systems à la carte".
-/
def buildTop [BEq k] [Inhabited o] [Monad m] [MonadStore k o m]
(build : RecBuild i o (ExceptT (List k) m)) (keyOf : i → k) (info : i) : ExceptT (List k) m o :=
buildTopCore [] build keyOf info
--------------------------------------------------------------------------------
-- # RBMap Version
--------------------------------------------------------------------------------
/-- A exception plus state monad transformer (i.e., `ExceptT` + `StateT`). -/
abbrev EStateT.{u,v} (ε : Type u) (σ : Type u) (m : Type u → Type v) :=
ExceptT ε <| StateT σ m
namespace EStateT
variable {ε : Type u} {σ : Type u} {m : Type u → Type v}
def run (state : σ) (self : EStateT ε σ m α) : m (Except ε α × σ) :=
ExceptT.run self |>.run state
def run' [Monad m] (state : σ) (self : EStateT ε σ m α) : m (Except ε α) :=
ExceptT.run self |>.run' state
end EStateT
/-- A transformer that adds an `RBMap` store to a monad. -/
abbrev RBMapT.{u,v} (k : Type u) (o : Type u) (cmp : k → k → Ordering) (m : Type u → Type v) :=
StateT (RBMap k o cmp) m
instance (cmp) [Monad m] : MonadStore k o (RBMapT k o cmp m) where
fetch? key := return (← get).find? key
store key obj := modify (·.insert key obj)
/-- Monad transformer for an `RBMap`-based topological walk. -/
abbrev RBTopT.{u,v} (k : Type u) (o : Type u) (cmp : k → k → Ordering) (m : Type u → Type v) :=
EStateT (List k) (RBMap k o cmp) m
namespace RBTopT
variable {k : Type u} {o : Type u} {cmp : k → k → Ordering} {m : Type u → Type v}
def runWith [Monad m] (map : RBMap.{u,u} k o cmp) (self : RBTopT k o cmp m α) :=
EStateT.run map self
def run [Monad m] (self : RBTopT k o cmp m α) :=
self.runWith {}
def run' [Monad m] (self : RBTopT k o cmp m α) :=
Functor.map (·.1) self.run
end RBTopT
@[inline] def buildTop [BEq κ] [Monad m] [MonadStore κ α m]
(keyOf : ι → κ) (build : RecBuild ι α (CycleT κ m)) (info : ι) : CycleT κ m α :=
buildDTop (fun _ => α) keyOf build info

View file

@ -27,12 +27,18 @@ def parsePackageSpec (ws : Workspace) (spec : String) : Except CliError Package
| none => throw <| CliError.unknownPackage spec
def resolveModuleTarget (mod : Module) (facet : String) : Except CliError OpaqueTarget :=
if facet.isEmpty || facet == "bin" || facet == "ilean" || facet == "olean" then
return mod.leanBinTarget (c := false)
if facet.isEmpty || facet == "bin" then
return mod.facetTarget &`lean
else if facet == "ilean" then
return mod.facetTarget &`ilean
else if facet == "olean" then
return mod.facetTarget &`olean
else if facet == "c" then
return mod.leanBinTarget (c := true)
return mod.facetTarget &`lean.c
else if facet == "o" then
return mod.oTarget.withoutInfo
return mod.facetTarget &`lean.o
else if facet == "dynlib" then
return mod.facetTarget &`lean.dynlib
else
throw <| CliError.unknownFacet "module" facet

View file

@ -69,30 +69,31 @@ A target is specified with a string of the form:
The optional `@` and `+` markers can be used to disambiguate packages
and modules from other kinds of targets (i.e., executables and libraries).
PACKAGE FACETS:
exe build the package's binary executable
leanLib build the package's lean library (*.olean, *.ilean)
staticLib build the package's static library
sharedLib build the package's shared library
PACKAGE FACETS: build the package's ...
exe binary executable
leanLib Lean library (*.olean and *.ilean files)
staticLib static library
sharedLib shared library
LIBRARY FACETS:
lean build the library's lean binaries (*.olean, *.ilean)
static build the library's static binary
shared build the library's shared binary
LIBRARY FACETS: build the library's ...
lean Lean binaries (*.olean and *.ilean files)
static static binary
shared shared binary
MODULE FACETS:
[default] build the module's *.olean and *.ilean files
c build the module's *.c file
o build the module's *.o file
MODULE FACETS: build the module's ...
[default] Lean binaries (*.olean and *.ilean files)
c *.c file
o *.o file (of the *.c file)
dynlib shared library (e.g., for `--load-dynlib`)
TARGET EXAMPLES:
a build the default facet of target `a`
@a build the default target(s) of package `a`
+A build the .olean and .ilean files of module `A`
a/b build the default facet of target `b` of package `a`
a/+A:c build the .c file of module `A` of package `a`
@a:leanLib build the lean library of package `a`
:exe build the root package's executable
TARGET EXAMPLES: build the ...
a default facet of target `a`
@a default target(s) of package `a`
+A olean and .ilean files of module `A`
a/b default facet of target `b` of package `a`
a/+A:c c file of module `A` of package `a`
@a:leanLib lean library of package `a`
:exe root package's executable
A bare `build` command will build the default facet of the root package.
Arguments to the `Packager` itself can be specified with `args`.

View file

@ -5,6 +5,7 @@ Authors: Mac Malone
-/
import Lake.Build.Trace
import Lake.Config.Package
import Lake.Util.Name
namespace Lake
open System Lean
@ -12,11 +13,12 @@ open System Lean
/-- A buildable Lean module of a `Package`. -/
structure Module where
pkg : Package
name : Name
name : WfName
deriving Inhabited
/-- Locate the named module in the package (if it is local to it). -/
def Package.findModule? (mod : Name) (self : Package) : Option Module :=
let mod := WfName.ofName mod
if self.isBuildableModule mod then some ⟨self, mod⟩ else none
namespace Module
@ -42,12 +44,22 @@ def cTraceFile (self : Module) : FilePath :=
def oFile (self : Module) : FilePath :=
Lean.modToFilePath self.pkg.irDir self.name "o"
def dynlib (self : Module) : FilePath :=
Lean.modToFilePath self.pkg.oleanDir self.name sharedLibExt
@[inline] def leanArgs (self : Module) : Array String :=
self.pkg.moreLeanArgs
@[inline] def leancArgs (self : Module) : Array String :=
self.pkg.moreLeancArgs
@[inline] def linkArgs (self : Module) : Array String :=
-- TODO: derive link arguments from library, not package
self.pkg.config.moreLinkArgs
@[inline] def shouldPrecompile (self : Module) : Bool :=
self.pkg.precompileModules
-- ## Trace Helpers
protected def getMTime (self : Module) : IO MTime := do

View file

@ -95,6 +95,15 @@ structure PackageConfig extends WorkspaceConfig where
-/
defaultFacet : PackageFacet := .exe
/--
Whether to compile each module into a native shared library that is loaded
whenever the module is imported. This speeds up evaluation of metaprograms
and enables the interpreter to run functions marked `@[extern]`.
Defaults to `false`.
-/
precompileModules : Bool := false
/--
Additional arguments to pass to the Lean language server
(i.e., `lean --server`) launched by `lake server`.
@ -348,6 +357,10 @@ def externLibTargets (self : Package) : Array FileTarget :=
self.externLibs.fold (fun xs _ x => xs.push x.target) #[] ++
self.config.moreLibTargets
/-- The package's `precompileModules` configuration. -/
def precompileModules (self : Package) : Bool :=
self.config.precompileModules
/-- The package's `moreServerArgs` configuration. -/
def moreServerArgs (self : Package) : Array String :=
self.config.moreServerArgs

View file

@ -4,12 +4,13 @@ Released under Apache 2.0 license as described in the file LICENSE.
Authors: Gabriel Ebner, Sebastian Ullrich, Mac Malone
-/
import Lake.Util.Git
import Lake.Util.EStateT
import Lake.Config.Load
import Lake.Config.Manifest
import Lake.Config.Workspace
import Lake.Build.Recursive
open System
open Std System
open Lean (Name NameMap)
namespace Lake
@ -120,8 +121,8 @@ def resolveDeps (ws : Workspace) (pkg : Package)
let pkg ← resolveDep ws pkg dep shouldUpdate
pkg.dependencies.forM fun dep => discard <| resolve dep
return pkg
let (res, map) ← RBTopT.run (cmp := Name.quickCmp) <| pkg.dependencies.forM fun dep =>
discard <| buildTop resolve Dependency.name dep
let (res, map) ← EStateT.run (mkRBMap _ _ Name.quickCmp) <|
pkg.dependencies.forM fun dep => discard <| buildTop Dependency.name resolve dep
match res with
| Except.ok _ => return map
| Except.error cycle => do

52
Lake/Util/Compare.lean Normal file
View file

@ -0,0 +1,52 @@
/-
Copyright (c) 2022 Mac Malone. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mac Malone
-/
namespace Lake
/--
Proof that that equality of a compare function corresponds
to propositional equality.
-/
class EqOfCmp (α : Type u) (cmp : αα → Ordering) where
eq_of_cmp {a a' : α} : cmp a a' = Ordering.eq → a = a'
export EqOfCmp (eq_of_cmp)
/--
Proof that that equality of a compare function corresponds
to propositional equality with respect to a given function.
-/
class EqOfCmpWrt (α : Type u) {β : Type v} (f : α → β) (cmp : αα → Ordering) where
eq_of_cmp_wrt {a a' : α} : cmp a a' = Ordering.eq → f a = f a'
export EqOfCmpWrt (eq_of_cmp_wrt)
instance [EqOfCmp α cmp] : EqOfCmpWrt α f cmp where
eq_of_cmp_wrt h := by rw [eq_of_cmp h]
instance : EqOfCmpWrt α (fun _ => α) cmp := ⟨fun _ => rfl⟩
theorem eq_of_compareOfLessAndEq
{a a' : α} [LT α] [DecidableEq α] [Decidable (a < a')]
(h : compareOfLessAndEq a a' = Ordering.eq) : a = a' := by
unfold compareOfLessAndEq at h
split at h; case inl => exact False.elim h
split at h; case inr => exact False.elim h
assumption
theorem Nat.eq_of_compare
{n n' : Nat} : compare n n' = Ordering.eq → n = n' := by
simp only [compare]; exact eq_of_compareOfLessAndEq
instance : EqOfCmp Nat compare where
eq_of_cmp h := Nat.eq_of_compare h
theorem String.eq_of_compare
{s s' : String} : compare s s' = Ordering.eq → s = s' := by
simp only [compare]; exact eq_of_compareOfLessAndEq
instance : EqOfCmp String compare where
eq_of_cmp h := String.eq_of_compare h

146
Lake/Util/DRBMap.lean Normal file
View file

@ -0,0 +1,146 @@
/-
Copyright (c) 2022 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Mac Malone
-/
import Std.Data.RBMap
import Lake.Util.Compare
namespace Lake
open Std RBNode
/-!
This module includes a dependently typed adaption of the `Std.RBMap`
defined in `Std.Data.RBMap` module of the Lean core. Most of the code is
copied directly from there with only minor edits.
-/
@[specialize] def RBNode.dFind {α : Type u} {β : α → Type v}
(cmp : αα → Ordering) [h : EqOfCmpWrt α β cmp] : RBNode α β → (k : α) → Option (β k)
| leaf, _ => none
| node _ a ky vy b, x =>
match ho:cmp x ky with
| Ordering.lt => dFind cmp a x
| Ordering.gt => dFind cmp b x
| Ordering.eq => some <| cast (by rw [eq_of_cmp_wrt (f := β) ho]) vy
/-- A Dependently typed `RBMap`. -/
def DRBMap (α : Type u) (β : α → Type v) (cmp : αα → Ordering) : Type (max u v) :=
{t : RBNode α β // t.WellFormed cmp }
@[inline] def mkDRBMap (α : Type u) (β : α → Type v) (cmp : αα → Ordering) : DRBMap α β cmp :=
⟨leaf, WellFormed.leafWff⟩
@[inline] def DRBMap.empty {α : Type u} {β : α → Type v} {cmp : αα → Ordering} : DRBMap α β cmp :=
mkDRBMap ..
instance (α : Type u) (β : α → Type v) (cmp : αα → Ordering) : EmptyCollection (DRBMap α β cmp) :=
⟨DRBMap.empty⟩
namespace DRBMap
variable {α : Type u} {β : α → Type v} {σ : Type w} {cmp : αα → Ordering}
def depth (f : Nat → Nat → Nat) (t : DRBMap α β cmp) : Nat :=
t.val.depth f
@[inline] def fold (f : σ → (k : α) → β k → σ) : (init : σ) → DRBMap α β cmp → σ
| b, ⟨t, _⟩ => t.fold f b
@[inline] def revFold (f : σ → (k : α) → β k → σ) : (init : σ) → DRBMap α β cmp → σ
| b, ⟨t, _⟩ => t.revFold f b
@[inline] def foldM [Monad m] (f : σ → (k : α) → β k → m σ) : (init : σ) → DRBMap α β cmp → m σ
| b, ⟨t, _⟩ => t.foldM f b
@[inline] def forM [Monad m] (f : (k : α) → β k → m PUnit) (t : DRBMap α β cmp) : m PUnit :=
t.foldM (fun _ k v => f k v) ⟨⟩
@[inline] protected def forIn [Monad m] (t : DRBMap α β cmp) (init : σ) (f : ((k : α) × β k) → σ → m (ForInStep σ)) : m σ :=
t.val.forIn init (fun a b acc => f ⟨a, b⟩ acc)
instance : ForIn m (DRBMap α β cmp) ((k : α) × β k) where
forIn := DRBMap.forIn
@[inline] def isEmpty : DRBMap α β cmp → Bool
| ⟨leaf, _⟩ => true
| _ => false
@[specialize] def toList : DRBMap α β cmp → List ((k : α) × β k)
| ⟨t, _⟩ => t.revFold (fun ps k v => ⟨k, v⟩::ps) []
@[inline] protected def min : DRBMap α β cmp → Option ((k : α) × β k)
| ⟨t, _⟩ =>
match t.min with
| some ⟨k, v⟩ => some ⟨k, v⟩
| none => none
@[inline] protected def max : DRBMap α β cmp → Option ((k : α) × β k)
| ⟨t, _⟩ =>
match t.max with
| some ⟨k, v⟩ => some ⟨k, v⟩
| none => none
instance [Repr ((k : α) × β k)] : Repr (DRBMap α β cmp) where
reprPrec m prec := Repr.addAppParen ("Lake.drbmapOf " ++ repr m.toList) prec
@[inline] def insert : DRBMap α β cmp → (k : α) → β k → DRBMap α β cmp
| ⟨t, w⟩, k, v => ⟨t.insert cmp k v, WellFormed.insertWff w rfl⟩
@[inline] def erase : DRBMap α β cmp → α → DRBMap α β cmp
| ⟨t, w⟩, k => ⟨t.erase cmp k, WellFormed.eraseWff w rfl⟩
@[specialize] def ofList : List ((k : α) × β k) → DRBMap α β cmp
| [] => mkDRBMap ..
| ⟨k,v⟩::xs => (ofList xs).insert k v
@[inline] def findCore? : DRBMap α β cmp → α → Option ((k : α) × β k)
| ⟨t, _⟩, x => t.findCore cmp x
@[inline] def find? [EqOfCmpWrt α β cmp] : DRBMap α β cmp → (k : α) → Option (β k)
| ⟨t, _⟩, x => RBNode.dFind cmp t x
@[inline] def findD [EqOfCmpWrt α β cmp] (t : DRBMap α β cmp) (k : α) (v₀ : β k) : β k :=
(t.find? k).getD v₀
/-- (lowerBound k) retrieves the kv pair of the largest key smaller than or equal to `k`,
if it exists. -/
@[inline] def lowerBound : DRBMap α β cmp → α → Option ((k : α) × β k)
| ⟨t, _⟩, x => t.lowerBound cmp x none
@[inline] def contains [EqOfCmpWrt α β cmp] (t : DRBMap α β cmp) (k : α) : Bool :=
(t.find? k).isSome
@[inline] def fromList (l : List ((k : α) × β k)) (cmp : αα → Ordering) : DRBMap α β cmp :=
l.foldl (fun r p => r.insert p.1 p.2) (mkDRBMap α β cmp)
@[inline] def all : DRBMap α β cmp → ((k : α) → β k → Bool) → Bool
| ⟨t, _⟩, p => t.all p
@[inline] def any : DRBMap α β cmp → ((k : α) → β k → Bool) → Bool
| ⟨t, _⟩, p => t.any p
def size (m : DRBMap α β cmp) : Nat :=
m.fold (fun sz _ _ => sz+1) 0
def maxDepth (t : DRBMap α β cmp) : Nat :=
t.val.depth Nat.max
@[inline] def min! [Inhabited ((k : α) × β k)] (t : DRBMap α β cmp) : (k : α) × β k :=
match t.min with
| some p => p
| none => panic! "map is empty"
@[inline] def max! [Inhabited ((k : α) × β k)] (t : DRBMap α β cmp) : (k : α) × β k :=
match t.max with
| some p => p
| none => panic! "map is empty"
@[inline] def find! [EqOfCmpWrt α β cmp] (t : DRBMap α β cmp) (k : α) [Inhabited (β k)] : β k :=
match t.find? k with
| some b => b
| none => panic! "key is not in the map"
end DRBMap
def drbmapOf {α : Type u} {β : α → Type v} (l : List ((k : α) × (β k))) (cmp : αα → Ordering) : DRBMap α β cmp :=
DRBMap.fromList l cmp

22
Lake/Util/EStateT.lean Normal file
View file

@ -0,0 +1,22 @@
/-
Copyright (c) 2022 Mac Malone. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mac Malone
-/
namespace Lake
/-- An exception plus state monad transformer (ι.e., `ExceptT` + `StateT`). -/
abbrev EStateT.{u,v} (ε : Type u) (σ : Type u) (m : Type u → Type v) :=
ExceptT ε <| StateT σ m
namespace EStateT
variable {ε : Type u} {σ : Type u} {m : Type u → Type v}
@[inline] def run (init : σ) (self : EStateT ε σ m ω) : m (Except ε ω × σ) :=
ExceptT.run self |>.run init
@[inline] def run' [Functor m] (init : σ) (self : EStateT ε σ m ω) : m (Except ε ω) :=
ExceptT.run self |>.run' init
end EStateT

253
Lake/Util/Name.lean Normal file
View file

@ -0,0 +1,253 @@
/-
Copyright (c) 2022 Mac Malone. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mac Malone
-/
import Lean.Data.Name
import Lake.Util.Compare
open Lean
namespace Lake
-- # Name Helpers
namespace Name
@[simp] theorem beq_rfl (n : Name) : (n == n) = true := by
simp only [BEq.beq]; induction n <;> simp [Name.beq, *]
@[simp] theorem isPrefixOf_self {n : Name} : n.isPrefixOf n = true := by
cases n <;> simp [Name.isPrefixOf]
@[simp] theorem isPrefixOf_append {n m : Name} : n.isPrefixOf (n ++ m) = true := by
simp only [HAppend.hAppend, Append.append]
induction m <;> simp [Name.isPrefixOf, Name.append, *]
/--
The propositional condition of a `Name` being well-formed.
A well-formed name has its has hash computable in the standard manner
(i.e., via the internals of `mkStr` and `mkNum`).
-/
inductive WellFormed : Name → Prop
| anonymousWff : WellFormed Name.anonymous
| strWff {n p s} : WellFormed p → n = Name.mkStr p s → WellFormed n
| numWff {n p v} : WellFormed p → n = Name.mkNum p v → WellFormed n
def WellFormed.elimStr : WellFormed (Name.str p s h) → WellFormed p
| strWff w rfl => w
def WellFormed.elimNum : WellFormed (Name.num p v h) → WellFormed p
| numWff w rfl => w
theorem eq_of_wf_quickCmpAux
(n : Name) (w : Name.WellFormed n) (n' : Name) (w' : Name.WellFormed n')
: Name.quickCmpAux n n' = Ordering.eq → n = n' := by
revert n'
induction w with
| anonymousWff =>
intro n' w'; cases w' <;> simp [Name.quickCmpAux, *]
| @strWff n p s _ h ih =>
intro n' w'
cases w' with
| anonymousWff =>
simp [h, Name.quickCmpAux]
| @strWff n' p' s' w' h' =>
simp only [h, h', Name.quickCmpAux]
intro h_cmp
split at h_cmp
next h_cmp_s =>
let p_eq := ih p' w' h_cmp
let s_eq := String.eq_of_compare h_cmp_s
rw [s_eq, p_eq]
next =>
contradiction
| @numWff n' p' v' w' h' =>
simp [h, h', Name.quickCmpAux]
| @numWff m p v _ h ih =>
intro n' w'
cases w' with
| anonymousWff =>
simp [h, Name.quickCmpAux]
| @strWff n' p' s' w' h' =>
simp [h, h', Name.quickCmpAux]
| @numWff n' p' v' w' h' =>
simp only [h, h', Name.quickCmpAux]
intro h_cmp
split at h_cmp
next h_cmp_v =>
let p_eq := ih p' w' h_cmp
let v_eq := Nat.eq_of_compare h_cmp_v
rw [v_eq, p_eq]
next =>
contradiction
end Name
-- # Subtype Helpers
namespace Subtype
theorem val_eq_of_eq {a b : Subtype p} (h : a = b) : a.val = b.val :=
h ▸ rfl
theorem eq_of_val_eq : ∀ {a b : Subtype p}, a.val = b.val → a = b
| ⟨_, _⟩, ⟨_, _⟩, rfl => rfl
theorem eq_iff_val_eq {a b : Subtype p} : a = b ↔ a.val = b.val :=
Iff.intro val_eq_of_eq eq_of_val_eq
theorem ne_of_val_ne {a b : Subtype p} (h : a.val ≠ b.val) : a ≠ b :=
fun h' => absurd (val_eq_of_eq h') h
theorem val_ne_of_ne {a b : Subtype p} (h : a ≠ b) : a.val ≠ b.val :=
fun h' => absurd (eq_of_val_eq h') h
theorem ne_iff_val_ne {a b : Subtype p} : a ≠ b ↔ a.val ≠ b.val :=
Iff.intro val_ne_of_ne ne_of_val_ne
end Subtype
-- # Well-formed Names
/--
A `WellFormed` `Name`.
Such a name has its hash provably computed in the standard manner.
This allows us to prove that the `beq` and `quickCmp` functions' equality
corresponds to propositional equality for this subtype.
-/
abbrev WfName :=
{n : Name // Name.WellFormed n}
namespace WfName
def anonymous : WfName :=
⟨Name.anonymous, Name.WellFormed.anonymousWff⟩
instance : Inhabited WfName := ⟨anonymous⟩
@[inline] def mkStr : WfName → String → WfName
| ⟨p, h⟩, s => ⟨Name.mkStr p s, Name.WellFormed.strWff h rfl⟩
@[inline] def mkNum : WfName → Nat → WfName
| ⟨p, h⟩, v => ⟨Name.mkNum p v, Name.WellFormed.numWff h rfl⟩
def ofName : Name → WfName
| .anonymous => anonymous
| .str p s _ => mkStr (ofName p) s
| .num p v _ => mkNum (ofName p) v
protected def hash : WfName → UInt64
| ⟨n, _⟩ => n.hash
instance : Hashable WfName := ⟨WfName.hash⟩
protected def beq : WfName → WfName → Bool
| ⟨n, _⟩, ⟨n', _⟩ => n.beq n'
instance : BEq WfName := ⟨WfName.beq⟩
theorem eq_of_beq_true : {n n' : WfName} → (n == n') = true → n = n' := by
intro ⟨n, w⟩
simp only [BEq.beq, WfName.beq, Subtype.eq_iff_val_eq]
induction w with
| anonymousWff =>
intro ⟨n', w'⟩; cases w' <;> simp [Name.beq, *]
| @strWff n p s _ h ih =>
intro ⟨n', w'⟩
simp only [Subtype.eq_iff_val_eq]
cases w' with
| anonymousWff =>
simp [Name.mkStr, Name.beq, h]
| @strWff n' p' s' w' h' =>
simp only [Name.mkStr, Name.beq, h, h']
simp only [BEq.beq, Bool.and_eq_true, decide_eq_true_eq]
intro ⟨s_eq, p_beq⟩
simp [s_eq, @ih ⟨p', w'⟩ p_beq]
| @numWff n' p' v' w' h' =>
simp only [Name.mkNum, Name.beq, h, h']
exact False.elim
| @numWff n p v _ h ih =>
intro ⟨n', w'⟩
simp only [Subtype.eq_iff_val_eq]
cases w' with
| anonymousWff =>
simp [Name.mkNum, Name.beq, h]
| @strWff n' p' s' w' h' =>
simp only [Name.mkNum, Name.beq, h, h']
exact False.elim
| @numWff n' p' v' w' h' =>
simp only [Name.mkNum, Name.beq, h, h']
simp only [BEq.beq, Bool.and_eq_true, decide_eq_true_eq]
intro ⟨n_beq, p_beq⟩
simp [Nat.eq_of_beq_eq_true n_beq, @ih ⟨p', w'⟩ p_beq]
instance : LawfulBEq WfName where
eq_of_beq := WfName.eq_of_beq_true
rfl {n} := Name.beq_rfl n
theorem ne_of_beq_false {n n' : WfName} : (n == n') = false → n ≠ n' :=
_root_.ne_of_beq_false
instance : DecidableEq WfName :=
fun n n' => match h:WfName.beq n n' with
| true => isTrue (eq_of_beq_true h)
| false => isFalse (ne_of_beq_false h)
def quickCmp : WfName → WfName → Ordering
| ⟨n, _⟩, ⟨n', _⟩ => n.quickCmp n'
theorem eq_of_quickCmp :
{n n' : WfName} → quickCmp n n' = Ordering.eq → n = n' := by
intro ⟨n, w⟩ ⟨n', w'⟩
simp only [quickCmp, Name.quickCmp, Subtype.eq_iff_val_eq]
intro h_cmp; split at h_cmp
next => exact Name.eq_of_wf_quickCmpAux n w n' w' h_cmp
next => contradiction
instance : EqOfCmp WfName WfName.quickCmp where
eq_of_cmp h := WfName.eq_of_quickCmp h
open Syntax in
protected def quoteFrom (ref : Syntax) : WfName → Syntax
| ⟨n, w⟩ => match n with
| .anonymous => mkCIdentFrom ref ``anonymous
| .str p s _ => mkApp (mkCIdentFrom ref ``mkStr)
#[WfName.quoteFrom ref ⟨p, w.elimStr⟩, quote s]
| .num p v _ => mkApp (mkCIdentFrom ref ``mkNum)
#[WfName.quoteFrom ref ⟨p, w.elimNum⟩, quote v]
instance : Quote WfName := ⟨WfName.quoteFrom Syntax.missing⟩
end WfName
-- ## Notation
/--
A proven well-formed, unchecked name literal.
Lake augments name literals to produce well-formed names (`WfName`)
instead of their plain counterparts. Well-formed names have additional
properties that help ensure certain features of Lake work as intended.
-/
scoped macro:max (name := wfNameLit) "&" noWs stx:name : term =>
if let some nm := stx.isNameLit? then
return WfName.quoteFrom stx <| WfName.ofName nm
else
Macro.throwErrorAt stx "ill-formed name literal"
scoped notation "&`✝" => WfName.anonymous
@[scoped appUnexpander WfName.mkStr]
def unexpandWfNameMkStr : PrettyPrinter.Unexpander
| `($(_) &`✝ $s) => do
let some s := s.isStrLit? | throw ()
let qn := quote <| Name.mkStr Name.anonymous s
`(&$(qn[0]):name)
| `($(_) &$n:name $s) => do
let some s := s.isStrLit? | throw ()
let some n := n.isNameLit? | throw ()
let qn := quote <| Name.mkStr n s
`(&$(qn[0]):name)
| _ => throw ()

View file

@ -15,7 +15,7 @@ test-ci: test-tests test-examples
test-tests: test-49 test-50 test-62 test-75
test-examples: test-init test-hello test-io test-deps\
test-git test-ffi test-targets test-scripts
test-git test-ffi test-targets test-precompile test-scripts
test-bootstrapped: test-boostrapped-hello
@ -92,6 +92,12 @@ test-targets:
clean-targets:
cd examples/targets && ./clean.sh
test-precompile:
cd examples/precompile && ./test.sh
clean-targets:
cd examples/precompile && ./clean.sh
test-scripts:
cd examples/scripts && ./test.sh

View file

@ -5,6 +5,8 @@ With Lake, the package's configuration is written in Lean inside a dedicated `la
Each `lakefile.lean` includes a `package` declaration (akin to `main`) which defines the package's basic configuration. It also typically includes build configurations for different targets (e.g., Lean libraries and binary executables) and Lean scripts to run on the command line (via `lake script run`).
***This README provides information about Lake relative to the current commit. If you are looking for documentation for the Lake version shipped with a given Lean nightly, you should look at the README of that version.***
## Table of Contents
* [Getting Lake](#getting-lake)
@ -113,6 +115,7 @@ Workspace options are shared across a package and its dependencies.
* `libDir`: The build subdirectory to which Lake should output the package's libraries. Defaults to `lib`.
* `binDir`: The build subdirectory to which Lake should output the package's binary executables. Defaults to `bin`.
* `extraDepTarget`: An extra `OpaqueTarget` that should be built before the package. `Target.collectOpaqueList/collectOpaqueArray` can be used combine multiple extra targets into a single `extraDepTarget`.
* `precompileModules`: Whether to compile each module into a native shared library that is loaded whenever the module is imported. This speeds up evaluation of metaprograms and enables the interpreter to run functions marked `@[extern]`. Defaults to `false`.
* `moreServerArgs`: Additional arguments to pass to the Lean language server (i.e., `lean --server`) launched by `lake serve`.
* `moreLeanArgs`: An `Array` of additional arguments to pass to `lean` while compiling Lean source files.
* `moreLeancArgs`: An `Array` of additional arguments to pass to `leanc` while compiling the C source files generated by `lean`. Lake already passes `-O3` and `-DNDEBUG` automatically, but you can change this by, for example, adding `-O0` and `-UNDEBUG`.

1
examples/precompile/.gitignore vendored Normal file
View file

@ -0,0 +1 @@
/build

View file

@ -0,0 +1,3 @@
import Precompile.Hello
#eval IO.println s!"Hello, {hello}"

View file

@ -0,0 +1,7 @@
@[export hello]
def helloImpl (_ : Unit) := "precompiled world"
@[extern "hello"]
opaque getHello : Unit → String
def hello := getHello ()

1
examples/precompile/clean.sh Executable file
View file

@ -0,0 +1 @@
rm -rf build

View file

@ -0,0 +1,9 @@
import Lake
open Lake DSL
package precompile {
precompileModules := true
}
@[defaultTarget]
lean_lib Precompile

4
examples/precompile/test.sh Executable file
View file

@ -0,0 +1,4 @@
set -ex
./clean.sh
${LAKE:-../../build/bin/lake} build

View file

@ -1,4 +1,4 @@
import Lake
import Lake.DSL
open System Lake DSL
package lake