feat: basic precompiled modules + builtin module facets
closes leanprover/lake#47
This commit is contained in:
parent
aa4b82c53f
commit
f7451e025c
24 changed files with 1017 additions and 263 deletions
|
|
@ -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)]
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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⟩
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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`.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
52
Lake/Util/Compare.lean
Normal 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
146
Lake/Util/DRBMap.lean
Normal 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
22
Lake/Util/EStateT.lean
Normal 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
253
Lake/Util/Name.lean
Normal 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 ()
|
||||
8
Makefile
8
Makefile
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
1
examples/precompile/.gitignore
vendored
Normal file
|
|
@ -0,0 +1 @@
|
|||
/build
|
||||
3
examples/precompile/Precompile.lean
Normal file
3
examples/precompile/Precompile.lean
Normal file
|
|
@ -0,0 +1,3 @@
|
|||
import Precompile.Hello
|
||||
|
||||
#eval IO.println s!"Hello, {hello}"
|
||||
7
examples/precompile/Precompile/Hello.lean
Normal file
7
examples/precompile/Precompile/Hello.lean
Normal 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
1
examples/precompile/clean.sh
Executable file
|
|
@ -0,0 +1 @@
|
|||
rm -rf build
|
||||
9
examples/precompile/lakefile.lean
Normal file
9
examples/precompile/lakefile.lean
Normal 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
4
examples/precompile/test.sh
Executable file
|
|
@ -0,0 +1,4 @@
|
|||
set -ex
|
||||
|
||||
./clean.sh
|
||||
${LAKE:-../../build/bin/lake} build
|
||||
|
|
@ -1,4 +1,4 @@
|
|||
import Lake
|
||||
import Lake.DSL
|
||||
open System Lake DSL
|
||||
|
||||
package lake
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue