diff --git a/src/lake/Lake/Build/Data.lean b/src/lake/Lake/Build/Data.lean
index 77f4d4276c..0a53f4b43b 100644
--- a/src/lake/Lake/Build/Data.lean
+++ b/src/lake/Lake/Build/Data.lean
@@ -15,59 +15,134 @@ namespace Lake
--------------------------------------------------------------------------------
/--
-The open type family which maps a module facet's name to its build data
-in the Lake build store. For example, a transitive × direct import pair
-for the `lean.imports` facet or an active build target for `lean.c`.
+The open type family which maps a Lake data kind to its associated type.
+For example, `LeanLib.facetKind` maps to `LeanLib`.
+
+It is an open type, meaning additional mappings can be add lazily
+as needed (via `data_type`).
+-/
+opaque DataType (kind : Name) : Type u
+
+/-- A `Name` descriptor of a data type. -/
+class DataKind (α : Type u) where
+ /-- The name which describes `α`. -/
+ name : Name
+ /-- Proof that `α` is the data type described by `name`. -/
+ wf : α = DataType name
+
+/--
+Tries to synthesize a `Name` descriptor of a data type.
+Otherwise uses `Name.anonymous` to indicate none was found.
+-/
+class OptDataKind (α : Type u) where
+ /-- The name which describes `α` (or `Name.anonymous` if none). -/
+ name : Name
+ /-- Proof that `α` is the data type described by `name` (if valid). -/
+ wf (h : ¬ name.isAnonymous) : α = DataType name
+
+@[instance low]
+def OptDataKind.anonymous : OptDataKind α where
+ name := .anonymous
+ wf h := by simp [Name.isAnonymous] at h
+
+@[inline] def OptDataKind.isAnonymous (self : OptDataKind α) : Bool :=
+ self.name.isAnonymous
+
+theorem OptDataKind.eq_data_type
+ {self : OptDataKind α} (h : ¬ self.isAnonymous) : α = DataType self.name
+:= self.wf h
+
+instance [DataKind α] : OptDataKind α where
+ name := DataKind.name α
+ wf _ := DataKind.wf
+
+instance : CoeOut (OptDataKind α) Lean.Name := ⟨(·.name)⟩
+instance : ToString (OptDataKind α) := ⟨(·.name.toString)⟩
+
+@[deprecated DataType (since := "2025-03-26")] abbrev TargetData := DataType
+
+/--
+The open type family which maps a Lake facet to its output type.
+For example, a `FilePath` for the `module.olean` facet.
+
+It is an open type, meaning additional mappings can be add lazily
+as needed (via `facet_data`).
+-/
+opaque FacetOut (facet : Name) : Type
+
+/--
+The open type family which maps a Lake facet kind and name to its output type.
+For example, a `FilePath` for the `module` `olean` facet.
+
+It is an open type, meaning additional mappings can be add lazily
+as needed (via `facet_data`).
+-/
+abbrev FacetData (kind facet : Name) := FacetOut (kind ++ facet)
+
+instance [h : FamilyDef FacetOut (kind ++ facet) α] : FamilyDef (FacetData kind) facet α :=
+ ⟨h.fam_eq⟩
+
+instance [h : FamilyDef (FacetData kind) facet α] : FamilyDef FacetOut (kind ++ facet) α :=
+ ⟨h.fam_eq⟩
+
+/--
+The open type family which maps a module facet's name to its output type.
+For example, a `FilePath` for the module `olean` facet.
It is an open type, meaning additional mappings can be add lazily
as needed (via `module_data`).
-/
-opaque ModuleData (facet : Name) : Type
+abbrev ModuleData := FacetData Module.facetKind
/--
-The open type family which maps a package facet's name to its build data
-in the Lake build store. For example, a transitive dependencies of the package
-for the facet `deps`.
+The open type family which maps a package facet's name to output type.
+For example, an `Arrry Package` of direct dependencies for the `deps` facet.
It is an open type, meaning additional mappings can be add lazily
as needed (via `package_data`).
-/
-opaque PackageData (facet : Name) : Type
+abbrev PackageData := FacetData Package.facetKind
+
+/-- The kind identifier for facets of a Lean library. -/
+@[match_pattern] abbrev LeanLib.facetKind : Name := `lean_lib
/--
-The open type family which maps a (builtin) Lake target's (e.g., `extern_lib`)
-facet to its associated build data. For example, an active build target for
-the `externLib.static` facet.
-
-It is an open type, meaning additional mappings can be add lazily
-as needed (via `target_data`).
--/
-opaque TargetData (facet : Name) : Type
-
-/-
-The open type family which maps a library facet's name to its build data
-in the Lake build store. For example, an active build target for the `static`
-facet.
+The open type family which maps a Lean library facet's name to its output type.
+For example, the `FilePath` pf the generated static library for the `static` facet.
It is an open type, meaning additional mappings can be add lazily
as needed (via `library_data`).
-/
-abbrev LibraryData (facet : Name) := TargetData (`leanLib ++ facet)
+abbrev LibraryData := FacetData LeanLib.facetKind
-instance [h : FamilyOut LibraryData facet α] : FamilyDef TargetData (`leanLib ++ facet) α :=
- ⟨by simp [h.family_key_eq_type]⟩
+@[inherit_doc LibraryData]
+abbrev LeanLibData := LibraryData
-instance [h : FamilyOut TargetData (`leanLib ++ facet) α] : FamilyDef LibraryData facet α :=
- ⟨h.family_key_eq_type⟩
+/-- The kind identifier for facets of a Lean executable. -/
+@[match_pattern] abbrev LeanExe.facetKind : Name := `lean_exe
+
+/-- The kind identifier for facets of an external library. -/
+@[match_pattern] abbrev ExternLib.facetKind : Name := `extern_lib
/--
-The open type family which maps a custom target (package × target name) to
-its build data in the Lake build store.
+The open type family which maps a custom package target
+(package × target name) to its output type.
It is an open type, meaning additional mappings can be add lazily
as needed (via `custom_data`).
-/
-opaque CustomData (target : Name × Name) : Type
+opaque CustomOut (target : Name × Name) : Type
+
+/--
+The open type family which maps a custom package targetto its output type.
+
+It is an open type, meaning additional mappings can be add lazily
+as needed (via `custom_data`).
+-/
+abbrev CustomData (package target : Name) := CustomOut (package, target)
+
+instance [h : FamilyDef CustomOut (p, t) α] : FamilyDef (CustomData p) t α :=
+ ⟨h.fam_eq⟩
--------------------------------------------------------------------------------
/-! ## Build Data -/
@@ -79,55 +154,119 @@ It is a simple type function composed of the separate open type families for
modules facets, package facets, Lake target facets, and custom targets.
-/
abbrev BuildData : BuildKey → Type
-| .moduleFacet _ f => ModuleData f
-| .packageFacet _ f => PackageData f
-| .targetFacet _ _ f => TargetData f
-| .customTarget p t => CustomData (p, t)
+| .module _ => DataType Module.facetKind
+| .package _ => DataType Package.facetKind
+| .packageTarget p t => CustomData p t
+| .facet _ f => FacetOut f
-instance (priority := low) : FamilyDef BuildData k (BuildData k) := ⟨rfl⟩
-instance (priority := low) : FamilyDef BuildData (.moduleFacet m f) (ModuleData f) := ⟨rfl⟩
-instance (priority := low) : FamilyDef BuildData (.packageFacet p f) (PackageData f) := ⟨rfl⟩
-instance (priority := low) : FamilyDef BuildData (.targetFacet p t f) (TargetData f) := ⟨rfl⟩
-instance (priority := low) : FamilyDef BuildData (.customTarget p t) (CustomData (p,t)) := ⟨rfl⟩
+instance (priority := low) : FamilyDef BuildData (.packageTarget p t) (CustomData p t) := ⟨rfl⟩
+instance (priority := low) : FamilyDef BuildData (.facet t f) (FacetOut f) := ⟨rfl⟩
+
+instance [FamilyOut (CustomData p) t α]
+: FamilyDef BuildData (.packageTarget p t) α where
+ fam_eq := by unfold BuildData; simp
+
+instance [FamilyOut DataType Module.facetKind α]
+: FamilyDef BuildData (.module k) α where
+ fam_eq := by unfold BuildData; simp
+
+instance [FamilyOut DataType Package.facetKind α]
+: FamilyDef BuildData (.package k) α where
+ fam_eq := by unfold BuildData; simp
--------------------------------------------------------------------------------
/-! ## Macros for Declaring Build Data -/
--------------------------------------------------------------------------------
+open Parser Command
+
+/-- Macro for declaring new `DatayType`. -/
+scoped macro (name := dataTypeDecl)
+ doc?:optional(docComment) "data_type " kind:ident " : " ty:term
+: command => do
+ let fam := mkCIdentFrom (← getRef) ``DataType
+ let kindName := Name.quoteFrom kind kind.getId
+ let id := mkIdentFrom kind (canonical := true) <|
+ kind.getId.modifyBase (kind.getId ++ ·)
+ `($[$doc?]? family_def $id : $fam $kindName := $ty
+ instance : DataKind $ty := ⟨$kindName, by simp⟩)
+
+/-- Internal macro for declaring new facet within Lake. -/
+scoped macro (name := builtinFacetCommand)
+ doc?:optional(docComment) tk:"builtin_facet "
+ id?:optional(atomic(group(ident " @ "))) name:ident " : " ns:ident " => " ty:term
+: command => withRef tk do
+ let fam := mkCIdentFrom tk ``FacetOut
+ let kindName ← match ns.getId with
+ | `Package => pure Package.facetKind
+ | `Module => pure Module.facetKind
+ | `LeanLib => pure LeanLib.facetKind
+ | `LeanExe => pure LeanExe.facetKind
+ | `ExternLib => pure ExternLib.facetKind
+ | _ => Macro.throwErrorAt ns "unknown facet kind"
+ let nameLit := Name.quoteFrom name name.getId (canonical := id?.isSome)
+ let kindLit := Name.quoteFrom ns kindName (canonical := true)
+ let facet := kindName ++ name.getId
+ let facetId := mkIdentFrom tk facet (canonical := true)
+ let facetLit := Name.quoteFrom tk facet
+ let id ←
+ if let some id := id? then
+ let id := id.raw[0]
+ pure <| mkIdentFrom id (ns.getId ++ id.getId) (canonical := true)
+ else
+ match name.getId with
+ | .str .anonymous n => pure <| mkIdentFrom name (ns.getId.str s!"{n}Facet") (canonical := true)
+ | _ => Macro.throwErrorAt name "cannot generate facet declaration name from facet name"
+ `(
+ $[$doc?]? abbrev $id := $facetLit
+ family_def $facetId : $fam $facetLit := $ty
+ instance : FamilyDef FacetOut ($kindLit ++ $nameLit) $ty :=
+ inferInstanceAs (FamilyDef FacetOut $facetLit $ty)
+ )
+
+/-- Macro for declaring new `FacetData`. -/
+scoped macro (name := facetDataDecl)
+ doc?:optional(docComment) tk:"facet_data " kind:ident name:ident " : " ty:term
+: command => withRef tk do
+ let fam := mkCIdentFrom tk ``FacetOut
+ let kindLit := Name.quoteFrom kind kind.getId
+ let nameLit := Name.quoteFrom name name.getId
+ let facet := kind.getId ++ name.getId
+ let facetLit := Name.quoteFrom tk facet
+ let id := mkIdentFrom tk facet (canonical := true)
+ `($[$doc?]? family_def $id : $fam $facetLit := $ty
+ instance : FamilyDef FacetOut ($kindLit ++ $nameLit) $ty :=
+ inferInstanceAs (FamilyDef FacetOut $facetLit $ty))
+
/-- Macro for declaring new `PackageData`. -/
-scoped macro (name := packageDataDecl) doc?:optional(Parser.Command.docComment)
-"package_data " id:ident " : " ty:term : command => do
- let dty := mkCIdentFrom (← getRef) ``PackageData
- let key := Name.quoteFrom id id.getId
- `($[$doc?]? family_def $id : $dty $key := $ty)
+scoped macro (name := packageDataDecl)
+ doc?:optional(docComment) tk:"package_data " facet:ident " : " ty:term
+: command => `($[$doc?]? facet_data%$tk $(mkIdentFrom tk Package.facetKind) $facet : $ty)
/-- Macro for declaring new `ModuleData`. -/
-scoped macro (name := moduleDataDecl) doc?:optional(Parser.Command.docComment)
-"module_data " id:ident " : " ty:term : command => do
- let dty := mkCIdentFrom (← getRef) ``ModuleData
- let key := Name.quoteFrom id id.getId
- `($[$doc?]? family_def $id : $dty $key := $ty)
+scoped macro (name := moduleDataDecl)
+ doc?:optional(docComment) tk:"module_data " facet:ident " : " ty:term
+: command => `($[$doc?]? facet_data%$tk $(mkIdentFrom tk Module.facetKind) $facet : $ty)
-/-- Macro for declaring new `TargetData` for libraries. -/
-scoped macro (name := libraryDataDecl) doc?:optional(Parser.Command.docComment)
-"library_data " id:ident " : " ty:term : command => do
- let dty := mkCIdentFrom (← getRef) ``TargetData
- let key := Name.quoteFrom id id.getId
- let id := mkIdentFrom id (canonical := true) <| id.getId.modifyBase (`leanLib ++ ·)
- `($[$doc?]? family_def $id : $dty (`leanLib ++ $key) := $ty)
+/-- Macro for declaring new `LibraryData`. -/
+scoped macro (name := libraryDataDecl)
+ doc?:optional(docComment) tk:"library_data " facet:ident " : " ty:term
+: command => `($[$doc?]? facet_data%$tk $(mkIdentFrom tk LeanLib.facetKind) $facet : $ty)
/-- Macro for declaring new `TargetData`. -/
-scoped macro (name := targetDataDecl) doc?:optional(Parser.Command.docComment)
-"target_data " id:ident " : " ty:term : command => do
- let dty := mkCIdentFrom (← getRef) ``TargetData
- let key := Name.quoteFrom id id.getId
- `($[$doc?]? family_def $id : $dty $key := $ty)
+scoped macro (name := targetDataDecl)
+ doc?:optional(docComment) tk:"target_data " id:ident " : " ty:term
+: command => withRef tk do
+ let fam := mkCIdentFrom (← getRef) ``TargetData
+ let idx := Name.quoteFrom id id.getId
+ `($[$doc?]? family_def $id : $fam $idx := $ty)
/-- Macro for declaring new `CustomData`. -/
-scoped macro (name := customDataDecl) doc?:optional(Parser.Command.docComment)
-"custom_data " pkg:ident tgt:ident " : " ty:term : command => do
- let dty := mkCIdentFrom (← getRef) ``CustomData
+scoped macro (name := customDataDecl)
+ doc?:optional(docComment) tk:"custom_data " pkg:ident tgt:ident " : " ty:term
+: command => withRef tk do
+ let fam := mkCIdentFrom (← getRef) ``CustomOut
let id := mkIdentFrom tgt (pkg.getId ++ tgt.getId)
let pkg := Name.quoteFrom pkg pkg.getId
let tgt := Name.quoteFrom pkg tgt.getId
- `($[$doc?]? family_def $id : $dty ($pkg, $tgt) := $ty)
+ `($[$doc?]? family_def $id : $fam ($pkg, $tgt) := $ty)
diff --git a/src/lake/Lake/Build/Executable.lean b/src/lake/Lake/Build/Executable.lean
index 9a278ff343..1a773e6c6c 100644
--- a/src/lake/Lake/Build/Executable.lean
+++ b/src/lake/Lake/Build/Executable.lean
@@ -22,12 +22,32 @@ def LeanExe.recBuildExe (self : LeanExe) : FetchM (Job FilePath) :=
-/
let mut linkJobs := #[]
for facet in self.root.nativeFacets self.supportInterpreter do
- linkJobs := linkJobs.push <| ← fetch <| self.root.facet facet.name
+ linkJobs := linkJobs.push <| ← facet.fetch self.root
let imports ← (← self.root.transImports.fetch).await
for mod in imports do
for facet in mod.nativeFacets self.supportInterpreter do
- linkJobs := linkJobs.push <| ← fetch <| mod.facet facet.name
+ linkJobs := linkJobs.push <| ← facet.fetch mod
let deps := (← (← self.pkg.transDeps.fetch).await).push self.pkg
for dep in deps do for lib in dep.externLibs do
linkJobs := linkJobs.push <| ← lib.static.fetch
buildLeanExe self.file linkJobs self.weakLinkArgs self.linkArgs self.sharedLean
+
+/-- The facet configuration for the builtin `LeanExe.exeFacet`. -/
+def LeanExe.exeFacetConfig : LeanExeFacetConfig exeFacet :=
+ mkFacetJobConfig recBuildExe
+
+def LeanExe.recBuildDefault (lib : LeanExe) : FetchM (Job FilePath) :=
+ lib.exe.fetch
+
+/-- The facet configuration for the builtin `ExternLib.dynlibFacet`. -/
+def LeanExe.defaultFacetConfig : LeanExeFacetConfig defaultFacet :=
+ mkFacetJobConfig recBuildDefault
+
+/--
+A name-configuration map for the initial set of
+Lean executable facets (e.g., `exe`).
+-/
+def LeanExe.initFacetConfigs : DNameMap LeanExeFacetConfig :=
+ DNameMap.empty
+ |>.insert defaultFacet defaultFacetConfig
+ |>.insert exeFacet exeFacetConfig
diff --git a/src/lake/Lake/Build/ExternLib.lean b/src/lake/Lake/Build/ExternLib.lean
new file mode 100644
index 0000000000..77b48d820d
--- /dev/null
+++ b/src/lake/Lake/Build/ExternLib.lean
@@ -0,0 +1,57 @@
+/-
+Copyright (c) 2025 Mac Malone. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Mac Malone
+-/
+prelude
+import Lake.Build.Common
+
+/-! # External Library Build
+Build function definitions for external libraries.
+-/
+
+open System (FilePath)
+
+namespace Lake
+
+def ExternLib.recBuildStatic (lib : ExternLib) : FetchM (Job FilePath) :=
+ withRegisterJob s!"{lib.staticTargetName.toString}:static" do
+ lib.config.getPath <$> fetch (lib.pkg.target lib.staticTargetName)
+
+/-- The facet configuration for the builtin `ExternLib.staticFacet`. -/
+def ExternLib.staticFacetConfig : ExternLibFacetConfig staticFacet :=
+ mkFacetJobConfig recBuildStatic
+
+def ExternLib.recBuildShared (lib : ExternLib) : FetchM (Job FilePath) :=
+ withRegisterJob s!"{lib.staticTargetName.toString}:shared" do
+ buildLeanSharedLibOfStatic (← lib.static.fetch) lib.linkArgs
+
+/-- The facet configuration for the builtin `ExternLib.sharedFacet`. -/
+def ExternLib.sharedFacetConfig : ExternLibFacetConfig sharedFacet :=
+ mkFacetJobConfig recBuildShared
+
+def ExternLib.recComputeDynlib (lib : ExternLib) : FetchM (Job Dynlib) := do
+ withRegisterJob s!"{lib.staticTargetName.toString}:dynlib" do
+ computeDynlibOfShared (← lib.shared.fetch)
+
+/-- The facet configuration for the builtin `ExternLib.dynlibFacet`. -/
+def ExternLib.dynlibFacetConfig : ExternLibFacetConfig dynlibFacet :=
+ mkFacetJobConfig recComputeDynlib
+
+def ExternLib.recBuildDefault (lib : ExternLib) : FetchM (Job FilePath) :=
+ lib.static.fetch
+
+/-- The facet configuration for the builtin `ExternLib.dynlibFacet`. -/
+def ExternLib.defaultFacetConfig : ExternLibFacetConfig defaultFacet :=
+ mkFacetJobConfig recBuildDefault
+
+/--
+A name-configuration map for the initial set of
+external library facets (e.g., `static`, `shared`).
+-/
+def ExternLib.initFacetConfigs : DNameMap ExternLibFacetConfig :=
+ DNameMap.empty
+ |>.insert defaultFacet defaultFacetConfig
+ |>.insert staticFacet staticFacetConfig
+ |>.insert sharedFacet sharedFacetConfig
+ |>.insert dynlibFacet dynlibFacetConfig
diff --git a/src/lake/Lake/Build/Facets.lean b/src/lake/Lake/Build/Facets.lean
index b084c5ff5e..2c9f2f76c2 100644
--- a/src/lake/Lake/Build/Facets.lean
+++ b/src/lake/Lake/Build/Facets.lean
@@ -34,22 +34,21 @@ structure ModuleFacet (α) where
/-- The name of the module facet. -/
name : Name
/-- Proof that module's facet build result is of type α. -/
- data_eq : ModuleData name = α
+ data_eq : FacetOut name = α
deriving Repr
-instance (facet : ModuleFacet α) : FamilyDef ModuleData facet.name α :=
+instance (facet : ModuleFacet α) : FamilyDef FacetOut facet.name α :=
⟨facet.data_eq⟩
-instance [FamilyOut ModuleData facet α] : CoeDep Name facet (ModuleFacet α) :=
- ⟨facet, FamilyOut.family_key_eq_type⟩
+instance [FamilyOut FacetOut facet α] : CoeDep Name facet (ModuleFacet α) :=
+ ⟨facet, FamilyOut.fam_eq⟩
/--
The facet which builds all of a module's dependencies
(i.e., transitive local imports and `--load-dynlib` shared libraries).
Returns the list of shared libraries to load along with their search path.
-/
-abbrev Module.depsFacet := `deps
-module_data deps : ModuleDeps
+builtin_facet deps : Module => ModuleDeps
/--
The core build facet of a Lean file.
@@ -57,59 +56,47 @@ Elaborates the Lean file via `lean` and produces all the Lean artifacts
of the module (i.e., `olean`, `ilean`, `c`).
Its trace just includes its dependencies.
-/
-abbrev Module.leanArtsFacet := `leanArts
-module_data leanArts : Unit
+builtin_facet leanArts : Module => Unit
/-- The `olean` file produced by `lean`. -/
-abbrev Module.oleanFacet := `olean
-module_data olean : FilePath
+builtin_facet olean : Module => FilePath
/-- The `ilean` file produced by `lean`. -/
-abbrev Module.ileanFacet := `ilean
-module_data ilean : FilePath
+builtin_facet ilean : Module => FilePath
/-- The C file built from the Lean file via `lean`. -/
-abbrev Module.cFacet := `c
-module_data c : FilePath
+builtin_facet c : Module => FilePath
/-- The LLVM BC file built from the Lean file via `lean`. -/
-abbrev Module.bcFacet := `bc
-module_data bc : FilePath
+builtin_facet bc : Module => FilePath
/--
The object file `.c.o` built from `c`.
On Windows, this is `c.o.noexport`, on other systems it is `c.o.export`).
-/
-abbrev Module.coFacet := `c.o
-module_data c.o : FilePath
+builtin_facet coFacet @ c.o : Module => FilePath
/-- The object file `.c.o.export` built from `c` (with `-DLEAN_EXPORTING`). -/
-abbrev Module.coExportFacet := `c.o.export
-module_data c.o.export : FilePath
+builtin_facet coExportFacet @ c.o.export : Module => FilePath
/-- The object file `.c.o.noexport` built from `c` (without `-DLEAN_EXPORTING`). -/
-abbrev Module.coNoExportFacet := `c.o.noexport
-module_data c.o.noexport : FilePath
+builtin_facet coNoExportFacet @ c.o.noexport : Module => FilePath
/-- The object file `.bc.o` built from `bc`. -/
-abbrev Module.bcoFacet := `bc.o
-module_data bc.o : FilePath
+builtin_facet bcoFacet @ bc.o : Module => FilePath
/--
The object file built from `c`/`bc`.
On Windows with the C backend, no Lean symbols are exported.
On every other configuration, symbols are exported.
-/
-abbrev Module.oFacet := `o
-module_data o : FilePath
+builtin_facet o : Module => FilePath
/-- The object file built from `c`/`bc` (with Lean symbols exported). -/
-abbrev Module.oExportFacet := `o.export
-module_data o.export : FilePath
+builtin_facet oExportFacet @ o.export : Module => FilePath
/-- The object file built from `c`/`bc` (without Lean symbols exported). -/
-abbrev Module.oNoExportFacet := `o.noexport
-module_data o.noexport : FilePath
+builtin_facet oNoExportFacet @ o.noexport : Module => FilePath
/-! ## Package Facets -/
@@ -118,36 +105,31 @@ module_data o.noexport : FilePath
A package's *optional* cached build archive (e.g., from Reservoir or GitHub).
Will NOT cause the whole build to fail if the archive cannot be fetched.
-/
-abbrev Package.optBuildCacheFacet := `optCache
-package_data optCache : Bool
+builtin_facet optBuildCacheFacet @ optCache : Package => Bool
/--
A package's cached build archive (e.g., from Reservoir or GitHub).
Will cause the whole build to fail if the archive cannot be fetched.
-/
-abbrev Package.buildCacheFacet := `cache
-package_data cache : Unit
+builtin_facet buildCacheFacet @ cache : Package => Unit
/--
A package's *optional* build archive from Reservoir.
Will NOT cause the whole build to fail if the barrel cannot be fetched.
-/
-abbrev Package.optReservoirBarrelFacet := `optBarrel
-package_data optBarrel : Bool
+builtin_facet optReservoirBarrelFacet @ optBarrel : Package => Bool
/--
A package's Reservoir build archive from Reservoir.
Will cause the whole build to fail if the barrel cannot be fetched.
-/
-abbrev Package.reservoirBarrelFacet := `barrel
-package_data barrel : Unit
+builtin_facet reservoirBarrelFacet @ barrel : Package => Unit
/--
A package's *optional* build archive from a GitHub release.
Will NOT cause the whole build to fail if the release cannot be fetched.
-/
-abbrev Package.optGitHubReleaseFacet := `optRelease
-package_data optRelease : Bool
+builtin_facet optGitHubReleaseFacet @ optRelease : Package => Bool
@[deprecated optGitHubReleaseFacet (since := "2024-09-27")]
abbrev Package.optReleaseFacet := optGitHubReleaseFacet
@@ -156,25 +138,24 @@ abbrev Package.optReleaseFacet := optGitHubReleaseFacet
A package's build archive from a GitHub release.
Will cause the whole build to fail if the release cannot be fetched.
-/
-abbrev Package.gitHubReleaseFacet := `release
-package_data release : Unit
+builtin_facet gitHubReleaseFacet @ release : Package => Unit
@[deprecated gitHubReleaseFacet (since := "2024-09-27")]
abbrev Package.releaseFacet := gitHubReleaseFacet
/-- A package's `extraDepTargets` mixed with its transitive dependencies'. -/
-abbrev Package.extraDepFacet := `extraDep
-package_data extraDep : Unit
+builtin_facet extraDep : Package => Unit
/-! ## Target Facets -/
+/-- The library's default facets (as specified by its `defaultFacets` configuration). . -/
+builtin_facet default : LeanLib => Unit
+
/-- A Lean library's Lean artifacts (i.e., `olean`, `ilean`, `c`). -/
-abbrev LeanLib.leanArtsFacet := `leanArts
-library_data leanArts : Unit
+builtin_facet leanArts : LeanLib => Unit
/-- A Lean library's static artifact. -/
-abbrev LeanLib.staticFacet := `static
-library_data static : FilePath
+builtin_facet static : LeanLib => FilePath
/--
A Lean library's static artifact (with exported symbols).
@@ -184,29 +165,28 @@ Such libraries are usually used as part of the local build process of some
shared artifact and not publicly distributed. Standard static libraries are
much better for distribution.
-/
-abbrev LeanLib.staticExportFacet := `static.export
-library_data static.export : FilePath
+builtin_facet staticExportFacet @ static.export : LeanLib => FilePath
/-- A Lean library's shared artifact. -/
-abbrev LeanLib.sharedFacet := `shared
-library_data shared : FilePath
+builtin_facet shared : LeanLib => FilePath
/-- A Lean library's `extraDepTargets` mixed with its package's. -/
-abbrev LeanLib.extraDepFacet := `extraDep
-library_data extraDep : Unit
+builtin_facet extraDep : LeanLib => Unit
+
+/-- The executable's default facet (i.e., an alias for `exe`) -/
+builtin_facet default : LeanExe => FilePath
/-- A Lean binary executable. -/
-abbrev LeanExe.exeFacet := `leanExe
-target_data leanExe : FilePath
+builtin_facet exe : LeanExe => FilePath
+
+/-- The external library's default facet (i.e., an alias for `static`) -/
+builtin_facet default : ExternLib => FilePath
/-- A external library's static binary. -/
-abbrev ExternLib.staticFacet := `externLib.static
-target_data externLib.static : FilePath
+builtin_facet static : ExternLib => FilePath
/-- A external library's shared binary. -/
-abbrev ExternLib.sharedFacet := `externLib.shared
-target_data externLib.shared : FilePath
+builtin_facet shared : ExternLib => FilePath
/-- A external library's dynlib. -/
-abbrev ExternLib.dynlibFacet := `externLib.dynlib
-target_data externLib.dynlib : Dynlib
+builtin_facet dynlib : ExternLib => Dynlib
diff --git a/src/lake/Lake/Build/Fetch.lean b/src/lake/Lake/Build/Fetch.lean
index 4d9c3864c0..fd1f89231e 100644
--- a/src/lake/Lake/Build/Fetch.lean
+++ b/src/lake/Lake/Build/Fetch.lean
@@ -80,3 +80,7 @@ abbrev FetchM := FetchT LogIO
fun build => cast (by simp) <| build self
export BuildInfo (fetch)
+
+/-- Fetch the result of this facet of a module. -/
+protected def ModuleFacet.fetch (self : ModuleFacet α) (mod : Module) : FetchM (Job α) :=
+ fetch <| mod.facetCore self.name
diff --git a/src/lake/Lake/Build/Index.lean b/src/lake/Lake/Build/Index.lean
index e03c0acef4..669d8458ac 100644
--- a/src/lake/Lake/Build/Index.lean
+++ b/src/lake/Lake/Build/Index.lean
@@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mac Malone
-/
prelude
-import Lake.Build.Executable
+import Lake.Config.Monad
import Lake.Build.Topological
/-!
@@ -16,66 +16,32 @@ Lake build functions, which is used by Lake to build any Lake build info.
This module leverages the index to perform topologically-based recursive builds.
-/
-open Lean
-namespace Lake
+open Lean (Name)
open System (FilePath)
-/--
-Converts a conveniently-typed target facet build function into its
-dynamically-typed equivalent.
--/
-@[macro_inline] def mkTargetFacetBuild
- (facet : Name) (build : FetchM (Job α))
- [h : FamilyOut TargetData facet α]
-: FetchM (Job (TargetData facet)) :=
- cast (by rw [← h.family_key_eq_type]) build
-
-def ExternLib.recBuildStatic (lib : ExternLib) : FetchM (Job FilePath) :=
- withRegisterJob s!"{lib.staticTargetName.toString}:static" do
- lib.config.getPath <$> fetch (lib.pkg.target lib.staticTargetName)
-
-def ExternLib.recBuildShared (lib : ExternLib) : FetchM (Job FilePath) :=
- withRegisterJob s!"{lib.staticTargetName.toString}:shared" do
- buildLeanSharedLibOfStatic (← lib.static.fetch) lib.linkArgs
-
-def ExternLib.recComputeDynlib (lib : ExternLib) : FetchM (Job Dynlib) := do
- withRegisterJob s!"{lib.staticTargetName.toString}:dynlib" do
- computeDynlibOfShared (← lib.shared.fetch)
-
-/-!
-## Topologically-based Recursive Build Using the Index
--/
+namespace Lake
/-- Recursive build function for anything in the Lake build index. -/
-def recBuildWithIndex : (info : BuildInfo) → FetchM (Job (BuildData info.key))
-| .moduleFacet mod facet => do
- if let some config := (← getWorkspace).findModuleFacetConfig? facet then
- config.fetchFn mod
- else
- error s!"do not know how to fetch module facet `{facet}`"
-| .packageFacet pkg facet => do
- if let some config := (← getWorkspace).findPackageFacetConfig? facet then
- config.fetchFn pkg
- else
- error s!"do not know how to fetch package facet `{facet}`"
-| .target pkg target =>
- if let some config := pkg.findTargetConfig? target then
- config.fetchFn pkg
- else
- error s!"could not fetch `{target}` of `{pkg.name}` -- target not found"
-| .libraryFacet lib facet => do
- if let some config := (← getWorkspace).findLibraryFacetConfig? facet then
- config.fetchFn lib
- else
- error s!"do not know how to fetch library facet `{facet}`"
-| .leanExe exe =>
- mkTargetFacetBuild LeanExe.exeFacet exe.recBuildExe
-| .staticExternLib lib =>
- mkTargetFacetBuild ExternLib.staticFacet lib.recBuildStatic
-| .sharedExternLib lib =>
- mkTargetFacetBuild ExternLib.sharedFacet lib.recBuildShared
-| .dynlibExternLib lib =>
- mkTargetFacetBuild ExternLib.dynlibFacet lib.recComputeDynlib
+def recBuildWithIndex (info : BuildInfo) : FetchM (Job (BuildData info.key)) :=
+ match info with
+ | .target pkg target => do
+ if let some decl := pkg.findTargetDecl? target then
+ if h : decl.kind.isAnonymous then
+ (decl.targetConfig h).fetchFn pkg
+ else
+ let kind := ⟨decl.kind, by simp [decl.target_eq_type h]⟩
+ let job := Job.pure (kind := kind) <| decl.mkConfigTarget pkg
+ return cast (by simp [decl.data_eq_target h]) job
+ else
+ error s!"invalid target '{info}': target not found in package"
+ | .facet _ kind data facet => do
+ if let some config := (← getWorkspace).findFacetConfig? facet then
+ if h : config.kind = kind then
+ config.fetchFn <| cast (by simp [h]) data
+ else
+ error s!"invalid target '{info}': target is of kind '{kind}', but facet expects '{config.kind}'"
+ else
+ error s!"invalid target '{info}': unknown facet '{facet}'"
/-- Recursive build function with memoization. -/
def recFetchWithIndex : (info : BuildInfo) → RecBuildM (Job (BuildData info.key)) :=
diff --git a/src/lake/Lake/Build/Info.lean b/src/lake/Lake/Build/Info.lean
index 6c33fb2359..33ac477003 100644
--- a/src/lake/Lake/Build/Info.lean
+++ b/src/lake/Lake/Build/Info.lean
@@ -21,14 +21,8 @@ open Lean (Name)
/-- The type of Lake's build info. -/
inductive BuildInfo
-| moduleFacet (module : Module) (facet : Name)
-| packageFacet (package : Package) (facet : Name)
-| libraryFacet (lib : LeanLib) (facet : Name)
-| leanExe (exe : LeanExe)
-| staticExternLib (lib : ExternLib)
-| sharedExternLib (lib : ExternLib)
-| dynlibExternLib (lib : ExternLib)
| target (package : Package) (target : Name)
+| facet (target : BuildKey) (kind : Name) (data : DataType.{0} kind) (facet : Name)
--------------------------------------------------------------------------------
/-! ## Build Info & Keys -/
@@ -36,79 +30,74 @@ inductive BuildInfo
/-! ### Build Key Helper Constructors -/
+abbrev Module.buildKey (self : Module) : BuildKey :=
+ .module self.keyName
+
abbrev Module.facetBuildKey (facet : Name) (self : Module) : BuildKey :=
.moduleFacet self.keyName facet
+abbrev Package.buildKey (self : Package) : BuildKey :=
+ .package self.name
+
abbrev Package.facetBuildKey (facet : Name) (self : Package) : BuildKey :=
.packageFacet self.name facet
-abbrev Package.targetBuildKey (target : Name) (self : Package) : BuildKey :=
- .customTarget self.name target
+abbrev Package.targetBuildKey
+ (target : Name) (self : Package)
+: BuildKey := .packageTarget self.name target
+
+abbrev LeanLib.buildKey (self : LeanLib) : BuildKey :=
+ .packageTarget self.pkg.name self.name
abbrev LeanLib.facetBuildKey (self : LeanLib) (facet : Name) : BuildKey :=
- .targetFacet self.pkg.name self.name (`leanLib ++ facet)
+ .targetFacet self.pkg.name self.name facet
abbrev LeanExe.buildKey (self : LeanExe) : BuildKey :=
+ .packageTarget self.pkg.name self.name
+
+abbrev LeanExe.exeBuildKey (self : LeanExe) : BuildKey :=
.targetFacet self.pkg.name self.name exeFacet
+abbrev ExternLib.buildKey (self : ExternLib) : BuildKey :=
+ .packageTarget self.pkg.name self.name
+
+abbrev ExternLib.facetBuildKey (facet : Name) (self : ExternLib) : BuildKey :=
+ .targetFacet self.pkg.name self.name facet
+
abbrev ExternLib.staticBuildKey (self : ExternLib) : BuildKey :=
- .targetFacet self.pkg.name self.name staticFacet
+ self.facetBuildKey staticFacet
abbrev ExternLib.sharedBuildKey (self : ExternLib) : BuildKey :=
- .targetFacet self.pkg.name self.name sharedFacet
+ self.facetBuildKey sharedFacet
abbrev ExternLib.dynlibBuildKey (self : ExternLib) : BuildKey :=
- .targetFacet self.pkg.name self.name dynlibFacet
+ self.facetBuildKey dynlibFacet
/-! ### Build Info to Key -/
/-- The key that identifies the build in the Lake build store. -/
@[reducible] def BuildInfo.key : (self : BuildInfo) → BuildKey
-| moduleFacet m f => m.facetBuildKey f
-| packageFacet p f => p.facetBuildKey f
-| libraryFacet l f => l.facetBuildKey f
-| leanExe x => x.buildKey
-| staticExternLib l => l.staticBuildKey
-| sharedExternLib l => l.sharedBuildKey
-| dynlibExternLib l => l.dynlibBuildKey
| target p t => p.targetBuildKey t
+| facet (target := t) (facet := f) .. => .facet t f
+
+instance : ToString BuildInfo := ⟨(toString ·.key)⟩
/-! ### Instances for deducing data types of `BuildInfo` keys -/
-instance [FamilyOut ModuleData f α]
-: FamilyDef BuildData (BuildInfo.key (.moduleFacet m f)) α where
- family_key_eq_type := by unfold BuildData; simp
-
-instance [FamilyOut PackageData f α]
-: FamilyDef BuildData (BuildInfo.key (.packageFacet p f)) α where
- family_key_eq_type := by unfold BuildData; simp
-
instance (priority := low) {p : NPackage n} : FamilyDef BuildData
- (.customTarget p.toPackage.name t) (CustomData (n,t)) := ⟨by simp⟩
+ (.customTarget p.toPackage.name t) (CustomData n t) := ⟨by simp⟩
-instance {p : NPackage n} [FamilyOut CustomData (n, t) α]
+instance {p : NPackage n} [FamilyOut (CustomData n) t α]
: FamilyDef BuildData (BuildInfo.key (.target p.toPackage t)) α where
- family_key_eq_type := by unfold BuildData; simp
+ fam_eq := by unfold BuildData; simp
-instance [FamilyOut TargetData (`leanLib ++ f) α]
-: FamilyDef BuildData (BuildInfo.key (.libraryFacet l f)) α where
- family_key_eq_type := by unfold BuildData; simp
+instance {p : NPackage n} [FamilyOut BuildData (.packageTarget n t) α]
+: FamilyDef BuildData (BuildInfo.key (.target p.toPackage t)) α where
+ fam_eq := by unfold BuildInfo.key Package.targetBuildKey; simp
-instance [FamilyOut TargetData LeanExe.exeFacet α]
-: FamilyDef BuildData (BuildInfo.key (.leanExe x)) α where
- family_key_eq_type := by unfold BuildData; simp
-
-instance [FamilyOut TargetData ExternLib.staticFacet α]
-: FamilyDef BuildData (BuildInfo.key (.staticExternLib l)) α where
- family_key_eq_type := by unfold BuildData; simp
-
-instance [FamilyOut TargetData ExternLib.sharedFacet α]
-: FamilyDef BuildData (BuildInfo.key (.sharedExternLib l)) α where
- family_key_eq_type := by unfold BuildData; simp
-
-instance [FamilyOut TargetData ExternLib.dynlibFacet α]
-: FamilyDef BuildData (BuildInfo.key (.dynlibExternLib l)) α where
- family_key_eq_type := by unfold BuildData; simp
+instance [FamilyOut FacetOut f α]
+: FamilyDef BuildData (BuildInfo.key (.facet t k d f)) α where
+ fam_eq := by unfold BuildData; simp
--------------------------------------------------------------------------------
/-! ## Build Info & Facets -/
@@ -123,33 +112,32 @@ These are defined here because they need configuration definitions
definitions.
-/
+data_type module : Module
+data_type package : Package
+data_type lean_lib : LeanLib
+data_type lean_exe : LeanExe
+data_type extern_lib : ExternLib
+
/-- The direct local imports of the Lean module. -/
-abbrev Module.importsFacet := `imports
-module_data imports : Array Module
+builtin_facet imports : Module => Array Module
/-- The transitive local imports of the Lean module. -/
-abbrev Module.transImportsFacet := `transImports
-module_data transImports : Array Module
+builtin_facet transImports : Module => Array Module
/-- The transitive local imports of the Lean module. -/
-abbrev Module.precompileImportsFacet := `precompileImports
-module_data precompileImports : Array Module
+builtin_facet precompileImports : Module => Array Module
/-- Shared library for `--load-dynlib`. -/
-abbrev Module.dynlibFacet := `dynlib
-module_data dynlib : Dynlib
+builtin_facet dynlib : Module => Dynlib
/-- A Lean library's Lean modules. -/
-abbrev LeanLib.modulesFacet := `modules
-library_data modules : Array Module
+builtin_facet modules : LeanLib => Array Module
/-- The package's array of dependencies. -/
-abbrev Package.depsFacet := `deps
-package_data deps : Array Package
+builtin_facet deps : Package => Array Package
/-- The package's complete array of transitive dependencies. -/
-abbrev Package.transDepsFacet := `transDeps
-package_data transDeps : Array Package
+builtin_facet transDeps : Package => Array Package
/-!
### Facet Build Info Helper Constructors
@@ -158,155 +146,226 @@ Definitions to easily construct `BuildInfo` values for module, package,
and target facets.
-/
+/--
+Build info for applying the specified facet to the module.
+It is the user's obiligation to ensure the facet in question is a module facet.
+-/
+abbrev Module.facetCore (facet : Name) (self : Module) : BuildInfo :=
+ .facet self.buildKey facetKind (toFamily self) facet
+
+/-- Build info for a module facet. -/
+abbrev Module.facet (facet : Name) (self : Module) : BuildInfo :=
+ self.facetCore (Module.facetKind ++ facet)
+
+@[deprecated Module.facetCore (since := "2025-03-04")]
+abbrev BuildInfo.moduleFacet (module : Module) (facet : Name) : BuildInfo :=
+ module.facetCore facet
+
namespace Module
-/-- Build info for the module's specified facet. -/
-abbrev facet (facet : Name) (self : Module) : BuildInfo :=
- .moduleFacet self facet
-
@[inherit_doc importsFacet] abbrev imports (self : Module) :=
- self.facet importsFacet
+ self.facetCore importsFacet
@[inherit_doc transImportsFacet] abbrev transImports (self : Module) :=
- self.facet transImportsFacet
+ self.facetCore transImportsFacet
@[inherit_doc precompileImportsFacet] abbrev precompileImports (self : Module) :=
- self.facet precompileImportsFacet
+ self.facetCore precompileImportsFacet
@[inherit_doc depsFacet] abbrev deps (self : Module) :=
- self.facet depsFacet
+ self.facetCore depsFacet
@[inherit_doc leanArtsFacet] abbrev leanArts (self : Module) :=
- self.facet leanArtsFacet
+ self.facetCore leanArtsFacet
@[inherit_doc oleanFacet] abbrev olean (self : Module) :=
- self.facet oleanFacet
+ self.facetCore oleanFacet
@[inherit_doc ileanFacet] abbrev ilean (self : Module) :=
- self.facet ileanFacet
+ self.facetCore ileanFacet
@[inherit_doc cFacet] abbrev c (self : Module) :=
- self.facet cFacet
+ self.facetCore cFacet
@[inherit_doc cFacet] abbrev bc (self : Module) :=
- self.facet bcFacet
+ self.facetCore bcFacet
@[inherit_doc oFacet] abbrev o (self : Module) :=
- self.facet oFacet
+ self.facetCore oFacet
@[inherit_doc oExportFacet] abbrev oExport (self : Module) :=
- self.facet oExportFacet
+ self.facetCore oExportFacet
@[inherit_doc oNoExportFacet] abbrev oNoExport (self : Module) :=
- self.facet oNoExportFacet
+ self.facetCore oNoExportFacet
@[inherit_doc coFacet] abbrev co (self : Module) :=
- self.facet coFacet
+ self.facetCore coFacet
@[inherit_doc coExportFacet] abbrev coExport (self : Module) :=
- self.facet coExportFacet
+ self.facetCore coExportFacet
@[inherit_doc coNoExportFacet] abbrev coNoExport (self : Module) :=
- self.facet coNoExportFacet
+ self.facetCore coNoExportFacet
@[inherit_doc bcoFacet] abbrev bco (self : Module) :=
- self.facet bcoFacet
+ self.facetCore bcoFacet
@[inherit_doc dynlibFacet] abbrev dynlib (self : Module) :=
- self.facet dynlibFacet
+ self.facetCore dynlibFacet
end Module
-/-- Build info for the package's specified facet. -/
-abbrev Package.facet (facet : Name) (self : Package) : BuildInfo :=
- .packageFacet self facet
-
-@[inherit_doc buildCacheFacet]
-abbrev Package.buildCache (self : Package) : BuildInfo :=
- self.facet buildCacheFacet
-
-@[inherit_doc optBuildCacheFacet]
-abbrev Package.optBuildCache (self : Package) : BuildInfo :=
- self.facet optBuildCacheFacet
-
-@[inherit_doc reservoirBarrelFacet]
-abbrev Package.reservoirBarrel (self : Package) : BuildInfo :=
- self.facet reservoirBarrelFacet
-
-@[inherit_doc optReservoirBarrelFacet]
-abbrev Package.optReservoirBarrel (self : Package) : BuildInfo :=
- self.facet optReservoirBarrelFacet
-
-@[inherit_doc gitHubReleaseFacet]
-abbrev Package.gitHubRelease (self : Package) : BuildInfo :=
- self.facet gitHubReleaseFacet
-
-@[inherit_doc optGitHubReleaseFacet]
-abbrev Package.optGitHubRelease (self : Package) : BuildInfo :=
- self.facet optGitHubReleaseFacet
-
-@[deprecated gitHubRelease (since := "2024-09-27")]
-abbrev Package.release := @gitHubRelease
-
-@[deprecated optGitHubRelease (since := "2024-09-27")]
-abbrev Package.optRelease := @optGitHubRelease
-
-@[inherit_doc extraDepFacet]
-abbrev Package.extraDep (self : Package) : BuildInfo :=
- self.facet extraDepFacet
-
-@[inherit_doc depsFacet]
-abbrev Package.deps (self : Package) : BuildInfo :=
- self.facet depsFacet
-
-@[inherit_doc transDepsFacet]
-abbrev Package.transDeps (self : Package) : BuildInfo :=
- self.facet transDepsFacet
-
-/-- Build info for a custom package target. -/
+/-- Build info for a package target (e.g., a library, executable, or custom target). -/
abbrev Package.target (target : Name) (self : Package) : BuildInfo :=
.target self target
-/-- Build info of the Lean library's Lean binaries. -/
-abbrev LeanLib.facet (self : LeanLib) (facet : Name) : BuildInfo :=
- .libraryFacet self facet
+/-
+Build info for applying the specified facet to the package.
+It is the user's obiligation to ensure the facet in question is a package facet.
+-/
+abbrev Package.facetCore (facet : Name) (self : Package) : BuildInfo :=
+ .facet self.buildKey facetKind (toFamily self) facet
-@[inherit_doc modulesFacet]
-abbrev LeanLib.modules (self : LeanLib) : BuildInfo :=
- self.facet modulesFacet
+/-- Build info for a package facet. -/
+abbrev Package.facet (facet : Name) (self : Package) : BuildInfo :=
+ self.facetCore (Package.facetKind ++ facet)
-@[inherit_doc leanArtsFacet]
-abbrev LeanLib.leanArts (self : LeanLib) : BuildInfo :=
- self.facet leanArtsFacet
+@[deprecated Package.facetCore (since := "2025-03-04")]
+abbrev BuildInfo.packageFacet (package : Package) (facet : Name) : BuildInfo :=
+ package.facetCore facet
-@[inherit_doc staticFacet]
-abbrev LeanLib.static (self : LeanLib) : BuildInfo :=
- self.facet staticFacet
+namespace Package
-@[inherit_doc staticExportFacet]
-abbrev LeanLib.staticExport (self : LeanLib) : BuildInfo :=
- self.facet staticExportFacet
+@[inherit_doc buildCacheFacet]
+abbrev buildCache (self : Package) : BuildInfo :=
+ self.facetCore buildCacheFacet
-@[inherit_doc sharedFacet]
-abbrev LeanLib.shared (self : LeanLib) : BuildInfo :=
- self.facet sharedFacet
+@[inherit_doc optBuildCacheFacet]
+abbrev optBuildCache (self : Package) : BuildInfo :=
+ self.facetCore optBuildCacheFacet
+
+@[inherit_doc reservoirBarrelFacet]
+abbrev reservoirBarrel (self : Package) : BuildInfo :=
+ self.facetCore reservoirBarrelFacet
+
+@[inherit_doc optReservoirBarrelFacet]
+abbrev optReservoirBarrel (self : Package) : BuildInfo :=
+ self.facetCore optReservoirBarrelFacet
+
+@[inherit_doc gitHubReleaseFacet]
+abbrev gitHubRelease (self : Package) : BuildInfo :=
+ self.facetCore gitHubReleaseFacet
+
+@[inherit_doc optGitHubReleaseFacet]
+abbrev optGitHubRelease (self : Package) : BuildInfo :=
+ self.facetCore optGitHubReleaseFacet
+
+@[deprecated gitHubRelease (since := "2024-09-27")]
+abbrev release := @gitHubRelease
+
+@[deprecated optGitHubRelease (since := "2024-09-27")]
+abbrev optRelease := @optGitHubRelease
@[inherit_doc extraDepFacet]
-abbrev LeanLib.extraDep (self : LeanLib) : BuildInfo :=
- self.facet extraDepFacet
+abbrev extraDep (self : Package) : BuildInfo :=
+ self.facetCore extraDepFacet
+
+@[inherit_doc depsFacet]
+abbrev deps (self : Package) : BuildInfo :=
+ self.facetCore depsFacet
+
+@[inherit_doc transDepsFacet]
+abbrev transDeps (self : Package) : BuildInfo :=
+ self.facetCore transDepsFacet
+
+end Package
+
+/-
+Build info for applying the specified facet to the library.
+It is the user's obiligation to ensure the facet in question is a library facet.
+-/
+abbrev LeanLib.facetCore (facet : Name) (self : LeanLib) : BuildInfo :=
+ .facet self.buildKey facetKind (toFamily self) facet
+
+/-- Build info for a facet of a Lean library. -/
+abbrev LeanLib.facet (facet : Name) (self : LeanLib) : BuildInfo :=
+ self.facetCore (LeanLib.facetKind ++ facet)
+
+@[deprecated LeanLib.facetCore (since := "2025-03-04")]
+abbrev BuildInfo.libraryFacet (lib : LeanLib) (facet : Name) : BuildInfo :=
+ lib.facetCore facet
+
+namespace LeanLib
+
+@[inherit_doc modulesFacet]
+abbrev modules (self : LeanLib) : BuildInfo :=
+ self.facetCore modulesFacet
+
+@[inherit_doc leanArtsFacet]
+abbrev leanArts (self : LeanLib) : BuildInfo :=
+ self.facetCore leanArtsFacet
+
+@[inherit_doc staticFacet]
+abbrev static (self : LeanLib) : BuildInfo :=
+ self.facetCore staticFacet
+
+@[inherit_doc staticExportFacet]
+abbrev staticExport (self : LeanLib) : BuildInfo :=
+ self.facetCore staticExportFacet
+
+@[inherit_doc sharedFacet]
+abbrev shared (self : LeanLib) : BuildInfo :=
+ self.facetCore sharedFacet
+
+@[inherit_doc extraDepFacet]
+abbrev extraDep (self : LeanLib) : BuildInfo :=
+ self.facetCore extraDepFacet
+
+end LeanLib
+
+/-
+Build info for applying the specified facet to the executable.
+It is the user's obiligation to ensure the facet in question is the executable facet.
+-/
+abbrev LeanExe.facetCore (facet : Name) (self : LeanExe) : BuildInfo :=
+ .facet self.buildKey facetKind (toFamily self) facet
/-- Build info of the Lean executable. -/
abbrev LeanExe.exe (self : LeanExe) : BuildInfo :=
- .leanExe self
+ self.facetCore LeanExe.exeFacet
+
+@[deprecated LeanExe.exe (since := "2025-03-04")]
+abbrev BuildInfo.leanExe (exe : LeanExe) : BuildInfo :=
+ exe.exe
+
+/-
+Build info for applying the specified facet to the external library.
+It is the user's obiligation to ensure the facet in question is an external library facet.
+-/
+abbrev ExternLib.facetCore (facet : Name) (self : ExternLib) : BuildInfo :=
+ .facet self.buildKey facetKind (toFamily self) facet
/-- Build info of the external library's static binary. -/
abbrev ExternLib.static (self : ExternLib) : BuildInfo :=
- .staticExternLib self
+ self.facetCore ExternLib.staticFacet
+
+@[deprecated ExternLib.static (since := "2025-03-04")]
+abbrev BuildInfo.staticExternLib (lib : ExternLib) : BuildInfo :=
+ lib.facetCore ExternLib.staticFacet
/-- Build info of the external library's shared binary. -/
abbrev ExternLib.shared (self : ExternLib) : BuildInfo :=
- .sharedExternLib self
+ self.facetCore ExternLib.sharedFacet
+
+@[deprecated ExternLib.shared (since := "2025-03-04")]
+abbrev BuildInfo.sharedExternLib (lib : ExternLib) : BuildInfo :=
+ lib.facetCore ExternLib.sharedFacet
/-- Build info of the external library's dynlib. -/
abbrev ExternLib.dynlib (self : ExternLib) : BuildInfo :=
- .dynlibExternLib self
+ self.facetCore ExternLib.dynlibFacet
+
+@[deprecated ExternLib.dynlib (since := "2025-03-04")]
+abbrev BuildInfo.dynlibExternLib (lib : ExternLib) : BuildInfo :=
+ lib.facetCore ExternLib.dynlibFacet
diff --git a/src/lake/Lake/Build/InitFacets.lean b/src/lake/Lake/Build/InitFacets.lean
new file mode 100644
index 0000000000..8dbdd3d21b
--- /dev/null
+++ b/src/lake/Lake/Build/InitFacets.lean
@@ -0,0 +1,27 @@
+/-
+Copyright (c) 2025 Mac Malone. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Mac Malone
+-/
+prelude
+import Lake.Build.Module
+import Lake.Build.Package
+import Lake.Build.Library
+import Lake.Build.Executable
+import Lake.Build.ExternLib
+
+/-! # Initial Facets -/
+
+namespace Lake
+
+/-- The initial set of Lake facets. -/
+def initFacetConfigs : DNameMap FacetConfig :=
+ DNameMap.empty
+ |> insert Module.initFacetConfigs
+ |> insert Package.initFacetConfigs
+ |> insert LeanLib.initFacetConfigs
+ |> insert LeanExe.initFacetConfigs
+ |> insert ExternLib.initFacetConfigs
+where
+ insert {k} (group : DNameMap (KFacetConfig k)) map :=
+ group.fold (init := map) fun m k v => m.insert k v.toFacetConfig
diff --git a/src/lake/Lake/Build/Job/Basic.lean b/src/lake/Lake/Build/Job/Basic.lean
index 7f34072d39..d7d9b0bd13 100644
--- a/src/lake/Lake/Build/Job/Basic.lean
+++ b/src/lake/Lake/Build/Job/Basic.lean
@@ -8,6 +8,7 @@ import Lake.Util.Log
import Lake.Util.Task
import Lake.Util.Opaque
import Lake.Build.Trace
+import Lake.Build.Data
/-! # Job Primitives
@@ -16,7 +17,7 @@ it defines `OpaqueJob`, which is needed for `BuildContext`. More complex
utilities are defined in `Lake.Build.Job.Monad`, which depends on `BuildContext`.
-/
-open System
+open System Lean
namespace Lake
@@ -88,9 +89,11 @@ abbrev JobTask α := BaseIOTask (JobResult α)
/-! ## Job -/
/-- A Lake job. -/
-structure Job (α : Type u) where
+structure Job (α : Type u) where
/-- The Lean `Task` object for the job. -/
task : JobTask α
+ /-- The kind of data this job produces. -/
+ [kind : OptDataKind α]
/--
A caption for the job in Lake's build monitor.
Will be formatted like `✔ [3/5] Ran
`.
@@ -98,18 +101,28 @@ structure Job (α : Type u) where
caption : String
/-- Whether this job failing should cause the build to fail. -/
optional : Bool := false
- deriving Inhabited
+
+instance : Inhabited (Job α) := ⟨{task := default, caption := default, kind := .anonymous}⟩
namespace Job
-@[inline] def ofTask (task : JobTask α) (caption := "") : Job α :=
+protected def cast (self : Job α) (h : ¬ self.kind.isAnonymous) : Job (DataType self.kind) :=
+ let h := by
+ match kind_eq:self.kind with
+ | ⟨_, wf⟩ =>
+ simp only
+ simp only [OptDataKind.isAnonymous, kind_eq] at h
+ rw [wf h]
+ cast h self
+
+@[inline] def ofTask [OptDataKind α] (task : JobTask α) (caption := "") : Job α :=
{task, caption}
-@[inline] protected def error (log : Log := {}) (caption := "") : Job α :=
- {task := Task.pure (.error 0 {log}), caption}
+@[inline] protected def error [OptDataKind α] (log : Log := {}) (caption := "") : Job α :=
+ .ofTask (Task.pure (.error 0 {log})) caption
-@[inline] protected def pure (a : α) (log : Log := {}) (caption := "") : Job α :=
- {task := Task.pure (.ok a {log}), caption}
+@[inline] protected def pure [kind : OptDataKind α] (a : α) (log : Log := {}) (caption := "") : Job α :=
+ .ofTask (Task.pure (.ok a {log})) caption
instance : Pure Job := ⟨Job.pure⟩
@@ -128,12 +141,12 @@ instance : Pure Job := ⟨Job.pure⟩
if job.caption.isEmpty then {job with caption} else job
@[inline] def mapResult
- (f : JobResult α → JobResult β) (self : Job α)
+ [OptDataKind β] (f : JobResult α → JobResult β) (self : Job α)
(prio := Task.Priority.default) (sync := false)
-: Job β := {self with task := self.task.map f prio sync}
+: Job β := {self with task := self.task.map f prio sync, kind := inferInstance}
@[inline] def mapOk
- (f : α → JobState → JobResult β) (self : Job α)
+ [OptDataKind β] (f : α → JobState → JobResult β) (self : Job α)
(prio := Task.Priority.default) (sync := false)
: Job β :=
self.mapResult (prio := prio) (sync := sync) fun
@@ -141,7 +154,7 @@ instance : Pure Job := ⟨Job.pure⟩
| .error e s => .error e s
@[inline] protected def map
- (f : α → β) (self : Job α)
+ [OptDataKind β] (f : α → β) (self : Job α)
(prio := Task.Priority.default) (sync := false)
: Job β := self.mapResult (·.map f) prio sync
@@ -151,15 +164,24 @@ end Job
/-! ## OpaqueJob -/
+/-- A Lake job task with an opaque value in `Type`. -/
+abbrev OpaqueJobTask := JobTask Opaque
+
+@[inline] private unsafe def JobTask.toOpaqueImpl (self : JobTask α) : OpaqueJobTask :=
+ unsafeCast self
+
+/-- Forget the value of a job task. Implemented as a no-op cast. -/
+@[implemented_by toOpaqueImpl]
+def JobTask.toOpaque (self : JobTask α) : OpaqueJobTask :=
+ self.map (·.map Opaque.mk)
+
+instance : CoeOut (JobTask α) OpaqueJobTask := ⟨.toOpaque⟩
+
/-- A Lake job with an opaque value in `Type`. -/
abbrev OpaqueJob := Job Opaque
-@[inline] private unsafe def Job.toOpaqueImpl (job : Job α) : OpaqueJob :=
- unsafeCast job
-
-/-- Forget the value of a job. Implemented as a no-op cast. -/
-@[implemented_by toOpaqueImpl]
+/-- Forget the value of a job. Implemented as a no-op cast on the task. -/
def Job.toOpaque (job : Job α) : OpaqueJob :=
- {job with task := job.task.map (·.map Opaque.mk)}
+ {job with task := job.task.toOpaque, kind := .anonymous}
instance : CoeOut (Job α) OpaqueJob := ⟨.toOpaque⟩
diff --git a/src/lake/Lake/Build/Job/Monad.lean b/src/lake/Lake/Build/Job/Monad.lean
index bac2e2c748..d503fe76e2 100644
--- a/src/lake/Lake/Build/Job/Monad.lean
+++ b/src/lake/Lake/Build/Job/Monad.lean
@@ -101,13 +101,14 @@ example : MonadLiftT SpawnM FetchM := inferInstance
namespace Job
-@[inline] def bindTask [Monad m]
+@[inline] def bindTask
+ [Monad m] [OptDataKind β]
(f : JobTask α → m (JobTask β)) (self : Job α)
-: m (Job β) := return {self with task := ← f self.task}
+: m (Job β) := return {self with task := ← f self.task, kind := inferInstance}
/-- Spawn a job that asynchronously performs `act`. -/
@[inline] protected def async
- (act : JobM α) (prio := Task.Priority.default) (caption := "")
+ [OptDataKind α] (act : JobM α) (prio := Task.Priority.default) (caption := "")
: SpawnM (Job α) := fun fetch stack store ctx => .ofTask (caption := caption) <$> do
BaseIO.asTask (prio := prio) do (withLoggedIO act) fetch stack store ctx {}
@@ -133,7 +134,7 @@ Logs the job's log and throws if there was an error.
/-- Apply `f` asynchronously to the job's output. -/
protected def mapM
- (self : Job α) (f : α → JobM β)
+ [OptDataKind β] (self : Job α) (f : α → JobM β)
(prio := Task.Priority.default) (sync := false)
: SpawnM (Job β) :=
fun fetch stack store ctx trace => do
@@ -146,7 +147,7 @@ protected def mapM
@[deprecated Job.mapM (since := "2024-12-06")]
protected abbrev bindSync
- (self : Job α) (f : α → JobM β)
+ [OptDataKind β] (self : Job α) (f : α → JobM β)
(prio := Task.Priority.default) (sync := false)
: SpawnM (Job β) := self.mapM f prio sync
@@ -155,7 +156,7 @@ Apply `f` asynchronously to the job's output
and asynchronously await the resulting job.
-/
def bindM
- (self : Job α) (f : α → JobM (Job β))
+ [OptDataKind β] (self : Job α) (f : α → JobM (Job β))
(prio := Task.Priority.default) (sync := false)
: SpawnM (Job β) :=
fun fetch stack store ctx trace => do
@@ -173,7 +174,7 @@ def bindM
@[deprecated bindM (since := "2024-12-06")]
protected abbrev bindAsync
- (self : Job α) (f : α → SpawnM (Job β))
+ [OptDataKind β] (self : Job α) (f : α → SpawnM (Job β))
(prio := Task.Priority.default) (sync := false)
: SpawnM (Job β) := self.bindM (fun a => f a) prio sync
@@ -182,7 +183,7 @@ protected abbrev bindAsync
results of `a` and `b`. The job `c` errors if either `a` or `b` error.
-/
@[inline] def zipResultWith
- (f : JobResult α → JobResult β → JobResult γ) (self : Job α) (other : Job β)
+ [OptDataKind γ] (f : JobResult α → JobResult β → JobResult γ) (self : Job α) (other : Job β)
(prio := Task.Priority.default) (sync := true)
: Job γ := Job.ofTask $
self.task.bind (prio := prio) (sync := true) fun rx =>
@@ -194,7 +195,7 @@ results of `a` and `b`. The job `c` errors if either `a` or `b` error.
results of `a` and `b`. The job `c` errors if either `a` or `b` error.
-/
@[inline] def zipWith
- (f : α → β → γ) (self : Job α) (other : Job β)
+ [OptDataKind γ] (f : α → β → γ) (self : Job α) (other : Job β)
(prio := Task.Priority.default) (sync := true)
: Job γ :=
self.zipResultWith (other := other) (prio := prio) (sync := sync) fun
@@ -203,6 +204,7 @@ results of `a` and `b`. The job `c` errors if either `a` or `b` error.
/-- Merges this job with another, discarding its output and trace. -/
def add (self : Job α) (other : Job β) : Job α :=
+ have : OptDataKind α := self.kind
self.zipResultWith (other := other) fun
| .ok a sa, .ok _ sb => .ok a {sa.merge sb with trace := sa.trace}
| ra, rb => .error 0 {ra.state.merge rb.state with trace := ra.state.trace}
@@ -221,11 +223,11 @@ def mixArray (jobs : Array (Job α)) : Job Unit :=
/-- Merge a `List` of jobs into one, collecting their outputs into a `List`. -/
def collectList (jobs : List (Job α)) : Job (List α) :=
- jobs.foldr (zipWith List.cons) (pure [])
+ jobs.foldr (zipWith List.cons) (.pure [])
/-- Merge an `Array` of jobs into one, collecting their outputs into an `Array`. -/
def collectArray (jobs : Array (Job α)) : Job (Array α) :=
- jobs.foldl (zipWith Array.push) (pure (Array.mkEmpty jobs.size))
+ jobs.foldl (zipWith Array.push) (.pure (Array.mkEmpty jobs.size))
end Job
@@ -252,27 +254,27 @@ abbrev nil : BuildJob Unit :=
Job.pure ()
@[deprecated Job.map (since := "2024-12-06")]
-protected abbrev pure (a : α) : BuildJob α :=
+protected abbrev pure [OptDataKind α] (a : α) : BuildJob α :=
Job.pure a
instance : Pure BuildJob := ⟨Job.pure⟩
@[deprecated Job.map (since := "2024-12-06")]
-protected abbrev map (f : α → β) (self : BuildJob α) : BuildJob β :=
+protected abbrev map [OptDataKind β] (f : α → β) (self : BuildJob α) : BuildJob β :=
self.toJob.map f
instance : Functor BuildJob where
map := Job.map
@[inline, deprecated "Removed without replacement." (since := "2024-12-06")]
-def mapWithTrace (f : α → BuildTrace → β × BuildTrace) (self : BuildJob α) : BuildJob β :=
+def mapWithTrace [OptDataKind β] (f : α → BuildTrace → β × BuildTrace) (self : BuildJob α) : BuildJob β :=
self.toJob.mapOk fun a s =>
let (b, trace) := f a s.trace
.ok b {s with trace}
@[inline, deprecated Job.mapM (since := "2024-12-06")]
protected def bindSync
- (self : BuildJob α) (f : α → BuildTrace → JobM (β × BuildTrace))
+ [OptDataKind β] (self : BuildJob α) (f : α → BuildTrace → JobM (β × BuildTrace))
(prio : Task.Priority := .default) (sync := false)
: SpawnM (Job β) :=
self.toJob.mapM (prio := prio) (sync := sync) fun a => do
@@ -282,7 +284,7 @@ protected def bindSync
@[inline, deprecated Job.bindM (since := "2024-12-06")]
protected def bindAsync
- (self : BuildJob α) (f : α → BuildTrace → SpawnM (Job β))
+ [OptDataKind β] (self : BuildJob α) (f : α → BuildTrace → SpawnM (Job β))
(prio : Task.Priority := .default) (sync := false)
: SpawnM (Job β) :=
self.toJob.bindM (prio := prio) (sync := sync) fun a => do
@@ -310,7 +312,7 @@ abbrev mixArray (jobs : Array (BuildJob α)) : Id (BuildJob Unit) :=
@[deprecated Job.zipWith (since := "2024-12-06")]
abbrev zipWith
- (f : α → β → γ) (self : BuildJob α) (other : BuildJob β)
+ [OptDataKind γ] (f : α → β → γ) (self : BuildJob α) (other : BuildJob β)
: BuildJob γ :=
self.toJob.zipWith f other.toJob
diff --git a/src/lake/Lake/Build/Job/Register.lean b/src/lake/Lake/Build/Job/Register.lean
index 18102c87e9..a418994438 100644
--- a/src/lake/Lake/Build/Job/Register.lean
+++ b/src/lake/Lake/Build/Job/Register.lean
@@ -42,7 +42,7 @@ Registers the job for the top-level build monitor,
/-- Wraps stray I/O, logs, and errors in `x` into the produced job. -/
def ensureJob
- (x : FetchM (Job α))
+ [OptDataKind α] (x : FetchM (Job α))
: FetchM (Job α) := fun fetch stack store ctx log => do
let iniPos := log.endPos
match (← (withLoggedIO x) fetch stack store ctx log) with
@@ -64,7 +64,7 @@ Registers the produced job for the top-level build monitor
Stray I/O, logs, and errors produced by `x` will be wrapped into the job.
-/
def withRegisterJob
- (caption : String) (x : FetchM (Job α)) (optional := false)
+ [OptDataKind α] (caption : String) (x : FetchM (Job α)) (optional := false)
: FetchM (Job α) := do
let job ← ensureJob x
registerJob caption job optional
diff --git a/src/lake/Lake/Build/Key.lean b/src/lake/Lake/Build/Key.lean
index 97b6329fe8..7d8f4eec15 100644
--- a/src/lake/Lake/Build/Key.lean
+++ b/src/lake/Lake/Build/Key.lean
@@ -11,108 +11,106 @@ open Lean (Name)
/-- The type of keys in the Lake build store. -/
inductive BuildKey
-| moduleFacet (module : Name) (facet : Name)
-| packageFacet (package : Name) (facet : Name)
-| targetFacet (package : Name) (target : Name) (facet : Name)
-| customTarget (package : Name) (target : Name)
+| module (module : Name)
+| package (package : Name)
+| packageTarget (package target : Name)
+| facet (target : BuildKey) (facet : Name)
deriving Inhabited, Repr, DecidableEq, Hashable
+/-- The kind identifier for facets of a package. -/
+@[match_pattern] abbrev Package.facetKind : Name := `package
+
+/-- The kind identifier for facets of a (Lean) module. -/
+@[match_pattern] abbrev Module.facetKind : Name := `module
+
namespace BuildKey
+@[match_pattern] abbrev moduleFacet (module facet : Name) : BuildKey :=
+ .facet (.module module) facet
+
+@[match_pattern] abbrev packageFacet (package facet : Name) : BuildKey :=
+ .facet (.package package) facet
+
+@[match_pattern] abbrev targetFacet (package target facet : Name) : BuildKey :=
+ .facet (.packageTarget package target) facet
+
+@[match_pattern] abbrev customTarget (package target : Name) : BuildKey :=
+ .packageTarget package target
+
def toString : (self : BuildKey) → String
-| moduleFacet m f => s!"+{m}:{f}"
-| packageFacet p f => s!"@{p}:{f}"
-| targetFacet p t f => s!"{p}/{t}:{f}"
-| customTarget p t => s!"{p}/{t}"
+| module m => s!"+{m}"
+| package p => s!"@{p}"
+| packageTarget p t => s!"{p}/{t}"
+| facet t f => s!"{toString t}:{Name.eraseHead f}"
/-- Like the default `toString`, but without disambiguation markers. -/
def toSimpleString : (self : BuildKey) → String
-| moduleFacet m f => s!"{m}:{f}"
-| packageFacet p f => s!"{p}:{f}"
-| targetFacet p t f => s!"{p}/{t}:{eraseHead f}"
-| customTarget p t => s!"{p}/{t}"
-where
- eraseHead : Name → Name
- | .anonymous | .str .anonymous _ | .num .anonymous _ => .anonymous
- | .str p s => .str (eraseHead p) s
- | .num p s => .num (eraseHead p) s
+| module m => s!"{m}"
+| package p => s!"{p}"
+| packageTarget p t => s!"{p}/{t}"
+| facet t f => s!"{toSimpleString t}:{Name.eraseHead f}"
instance : ToString BuildKey := ⟨(·.toString)⟩
def quickCmp (k k' : BuildKey) : Ordering :=
match k with
- | moduleFacet m f =>
+ | module m =>
match k' with
- | moduleFacet m' f' =>
- match m.quickCmp m' with
- | .eq => f.quickCmp f'
- | ord => ord
+ | module m' => m.quickCmp m'
| _ => .lt
- | packageFacet p f =>
+ | package p =>
match k' with
- | moduleFacet .. => .gt
- | packageFacet p' f' =>
- match p.quickCmp p' with
- | .eq => f.quickCmp f'
- | ord => ord
+ | module .. => .gt
+ | package p' => p.quickCmp p'
| _ => .lt
- | targetFacet p t f =>
+ | packageTarget p t =>
match k' with
- | customTarget .. => .lt
- | targetFacet p' t' f' =>
- match p.quickCmp p' with
- | .eq =>
- match t.quickCmp t' with
- | .eq => f.quickCmp f'
- | ord => ord
- | ord => ord
- | _=> .gt
- | customTarget p t =>
- match k' with
- | customTarget p' t' =>
+ | facet .. => .lt
+ | packageTarget p' t' =>
match p.quickCmp p' with
| .eq => t.quickCmp t'
| ord => ord
+ | _=> .gt
+ | facet t f =>
+ match k' with
+ | facet t' f' =>
+ match t.quickCmp t' with
+ | .eq => f.quickCmp f'
+ | ord => ord
| _ => .gt
-theorem eq_of_quickCmp {k k' : BuildKey} :
-quickCmp k k' = Ordering.eq → k = k' := by
- unfold quickCmp
- cases k with
- | moduleFacet m f =>
- cases k'
- case moduleFacet m' f' =>
- dsimp only; split
- next m_eq => intro f_eq; rw [eq_of_cmp m_eq, eq_of_cmp f_eq]
- next => intro; contradiction
+theorem eq_of_quickCmp :
+ quickCmp k k' = Ordering.eq → k = k'
+:= by
+ revert k'
+ induction k with
+ | module m =>
+ unfold quickCmp
+ intro k'; cases k'
+ case module m' => simp
all_goals (intro; contradiction)
- | packageFacet p f =>
- cases k'
- case packageFacet p' f' =>
- dsimp only; split
- next p_eq => intro f_eq; rw [eq_of_cmp p_eq, eq_of_cmp f_eq]
- next => intro; contradiction
+ | package p =>
+ unfold quickCmp
+ intro k'; cases k'
+ case package p' => simp
all_goals (intro; contradiction)
- | targetFacet p t f =>
- cases k'
- case targetFacet p' t' f' =>
- dsimp only; split
- next p_eq =>
- split
- next t_eq =>
- intro f_eq
- rw [eq_of_cmp p_eq, eq_of_cmp t_eq, eq_of_cmp f_eq]
- next => intro; contradiction
- next => intro; contradiction
- all_goals (intro; contradiction)
- | customTarget p t =>
- cases k'
- case customTarget p' t' =>
+ | packageTarget p t =>
+ unfold quickCmp
+ intro k'; cases k'
+ case packageTarget p' t' =>
dsimp only; split
next p_eq => intro t_eq; rw [eq_of_cmp p_eq, eq_of_cmp t_eq]
next => intro; contradiction
all_goals (intro; contradiction)
+ | facet t f ih =>
+ unfold quickCmp
+ intro k'; cases k'
+ case facet t' f'' =>
+ dsimp only; split
+ next t_eq => intro f_eq; rw [ih t_eq, eq_of_cmp f_eq]
+ next => intro; contradiction
+ all_goals (intro; contradiction)
instance : LawfulCmpEq BuildKey quickCmp where
eq_of_cmp := eq_of_quickCmp
- cmp_rfl {k} := by cases k <;> simp [quickCmp]
+ cmp_rfl {k} := by induction k <;> simp_all [quickCmp]
diff --git a/src/lake/Lake/Build/Library.lean b/src/lake/Lake/Build/Library.lean
index 3d7c76887f..46dc47ed9a 100644
--- a/src/lake/Lake/Build/Library.lean
+++ b/src/lake/Lake/Build/Library.lean
@@ -63,7 +63,7 @@ def LeanLib.leanArtsFacetConfig : LibraryFacetConfig leanArtsFacet :=
withRegisterJob s!"{self.name}:static{suffix}" do
let mods ← (← self.modules.fetch).await
let oJobs ← mods.flatMapM fun mod =>
- mod.nativeFacets shouldExport |>.mapM fun facet => fetch <| mod.facet facet.name
+ mod.nativeFacets shouldExport |>.mapM (·.fetch mod)
let libFile := if shouldExport then self.staticExportLibFile else self.staticLibFile
/-
Static libraries with explicit exports are built as thin libraries.
@@ -80,7 +80,6 @@ def LeanLib.staticFacetConfig : LibraryFacetConfig staticFacet :=
def LeanLib.staticExportFacetConfig : LibraryFacetConfig staticExportFacet :=
mkFacetJobConfig (LeanLib.recBuildStatic · true)
-
/-! ## Build Shared Lib -/
protected def LeanLib.recBuildShared
@@ -88,7 +87,7 @@ protected def LeanLib.recBuildShared
withRegisterJob s!"{self.name}:shared" do
let mods ← (← self.modules.fetch).await
let oJobs ← mods.flatMapM fun mod =>
- mod.nativeFacets true |>.mapM fun facet => fetch <| mod.facet facet.name
+ mod.nativeFacets true |>.mapM (·.fetch mod)
let pkgs := mods.foldl (·.insert ·.pkg) OrdPackageSet.empty |>.toArray
let externJobs ← pkgs.flatMapM (·.externLibs.mapM (·.shared.fetch))
buildLeanSharedLib self.sharedLibFile (oJobs ++ externJobs) self.weakLinkArgs self.linkArgs
@@ -108,16 +107,30 @@ def LeanLib.recBuildExtraDepTargets (self : LeanLib) : FetchM (Job Unit) := do
def LeanLib.extraDepFacetConfig : LibraryFacetConfig extraDepFacet :=
mkFacetJobConfig LeanLib.recBuildExtraDepTargets
-open LeanLib in
+/-- Build the default facets for the library. -/
+def LeanLib.recBuildDefaultFacets (self : LeanLib) : FetchM (Job Unit) := do
+ Job.mixArray <$> self.defaultFacets.mapM fun facet => do
+ let job ← (self.facetCore facet).fetch
+ return job.toOpaque
+
+/-- The `LibraryFacetConfig` for the builtin `defaultFacet`. -/
+def LeanLib.defaultFacetConfig : LibraryFacetConfig defaultFacet :=
+ mkFacetJobConfig LeanLib.recBuildDefaultFacets
+
/--
-A library facet name to build function map that contains builders for
-the initial set of Lake library facets (e.g., `lean`, `static`, and `shared`).
+A name-configuration map for the initial set of
+Lean library facets (e.g., `lean`, `static`, `shared`).
-/
-def initLibraryFacetConfigs : DNameMap LibraryFacetConfig :=
+def LeanLib.initFacetConfigs : DNameMap LeanLibFacetConfig :=
DNameMap.empty
+ |>.insert defaultFacet defaultFacetConfig
|>.insert modulesFacet modulesFacetConfig
|>.insert leanArtsFacet leanArtsFacetConfig
|>.insert staticFacet staticFacetConfig
|>.insert staticExportFacet staticExportFacetConfig
|>.insert sharedFacet sharedFacetConfig
|>.insert extraDepFacet extraDepFacetConfig
+
+@[inherit_doc LeanLib.initFacetConfigs]
+abbrev initLibraryFacetConfigs : DNameMap LibraryFacetConfig :=
+ LeanLib.initFacetConfigs
diff --git a/src/lake/Lake/Build/Module.lean b/src/lake/Lake/Build/Module.lean
index 83b622750e..c7c0129bf1 100644
--- a/src/lake/Lake/Build/Module.lean
+++ b/src/lake/Lake/Build/Module.lean
@@ -315,7 +315,7 @@ def Module.recBuildDynlib (mod : Module) : FetchM (Job Dynlib) :=
withRegisterJob s!"{mod.name}:dynlib" do
-- Fetch object files
- let linkJobs ← mod.nativeFacets true |>.mapM (fetch <| mod.facet ·.name)
+ let linkJobs ← mod.nativeFacets true |>.mapM (·.fetch mod)
let linksJob := Job.collectArray linkJobs
-- Fetch dependencies' dynlibs
@@ -355,12 +355,11 @@ def Module.recBuildDynlib (mod : Module) : FetchM (Job Dynlib) :=
def Module.dynlibFacetConfig : ModuleFacetConfig dynlibFacet :=
mkFacetJobConfig Module.recBuildDynlib
-open Module in
/--
A name-configuration map for the initial set of
-Lake module facets (e.g., `lean.{imports, c, o, dynlib]`).
+Lake module facets (e.g., `imports`, `c`, `o`, `dynlib`).
-/
-def initModuleFacetConfigs : DNameMap ModuleFacetConfig :=
+def Module.initFacetConfigs : DNameMap ModuleFacetConfig :=
DNameMap.empty
|>.insert importsFacet importsFacetConfig
|>.insert transImportsFacet transImportsFacetConfig
@@ -379,3 +378,6 @@ def initModuleFacetConfigs : DNameMap ModuleFacetConfig :=
|>.insert oExportFacet oExportFacetConfig
|>.insert oNoExportFacet oNoExportFacetConfig
|>.insert dynlibFacet dynlibFacetConfig
+
+@[inherit_doc Module.initFacetConfigs]
+abbrev initModuleFacetConfigs := Module.initFacetConfigs
diff --git a/src/lake/Lake/Build/Package.lean b/src/lake/Lake/Build/Package.lean
index 95bb5628c3..96a9287678 100644
--- a/src/lake/Lake/Build/Package.lean
+++ b/src/lake/Lake/Build/Package.lean
@@ -37,7 +37,7 @@ def Package.recComputeTransDeps (self : Package) : FetchM (Job (Array Package))
let some dep ← findPackage? cfg.name
| error s!"{self.name}: package not found for dependency '{cfg.name}' \
(this is likely a bug in Lake)"
- let depDeps ← (← fetch <| dep.facet `transDeps).await
+ let depDeps ← (← fetch <| dep.transDeps).await
return depDeps.foldl (·.insert ·) deps |>.insert dep
/-- The `PackageFacetConfig` for the builtin `transDepsFacet`. -/
@@ -159,7 +159,7 @@ def Package.fetchBuildArchive
private def Package.mkOptBuildArchiveFacetConfig
{facet : Name} (archiveFile : Package → FilePath)
(getUrl : Package → JobM String) (headers : Array String := #[])
- [FamilyDef PackageData facet Bool]
+ [FamilyDef FacetOut facet Bool]
: PackageFacetConfig facet := mkFacetJobConfig fun pkg =>
withRegisterJob s!"{pkg.name}:{facet}" (optional := true) <| Job.async do
try
@@ -173,12 +173,12 @@ private def Package.mkOptBuildArchiveFacetConfig
@[inline]
private def Package.mkBuildArchiveFacetConfig
{facet : Name} (optFacet : Name) (what : String)
- [FamilyDef PackageData facet Unit]
- [FamilyDef PackageData optFacet Bool]
+ [FamilyDef FacetOut facet Unit]
+ [FamilyDef FacetOut optFacet Bool]
: PackageFacetConfig facet :=
mkFacetJobConfig fun pkg =>
- withRegisterJob s!"{pkg.name}:{facet}" do
- (← fetch <| pkg.facet optFacet).mapM fun success => do
+ withRegisterJob s!"{pkg.name}:{Name.eraseHead facet}" do
+ (← fetch <| pkg.facetCore optFacet).mapM fun success => do
unless success do
error s!"failed to fetch {what}{← pkg.optFacetDetails optFacet}"
@@ -238,12 +238,11 @@ def Package.afterBuildCacheSync (self : Package) (build : JobM α) : FetchM (Job
@[deprecated afterBuildCacheSync (since := "2024-09-27")]
def Package.afterReleaseSync := @afterBuildCacheSync
-open Package in
/--
-A package facet name to build function map that contains builders for
-the initial set of Lake package facets (e.g., `extraDep`).
+A name-configuration map for the initial set of
+Lake package facets (e.g., `extraDep`).
-/
-def initPackageFacetConfigs : DNameMap PackageFacetConfig :=
+def Package.initFacetConfigs : DNameMap PackageFacetConfig :=
DNameMap.empty
|>.insert depsFacet depsFacetConfig
|>.insert transDepsFacet transDepsFacetConfig
@@ -254,3 +253,6 @@ def initPackageFacetConfigs : DNameMap PackageFacetConfig :=
|>.insert reservoirBarrelFacet barrelFacetConfig
|>.insert optGitHubReleaseFacet optGitHubReleaseFacetConfig
|>.insert gitHubReleaseFacet gitHubReleaseFacetConfig
+
+@[inherit_doc Package.initFacetConfigs]
+abbrev initPackageFacetConfigs := Package.initFacetConfigs
diff --git a/src/lake/Lake/Build/Run.lean b/src/lake/Lake/Build/Run.lean
index b6c68b0c9b..c0c947d016 100644
--- a/src/lake/Lake/Build/Run.lean
+++ b/src/lake/Lake/Build/Run.lean
@@ -6,6 +6,7 @@ Authors: Mac Malone, Gabriel Ebner, Sebastian Ullrich
prelude
import Lake.Util.Lock
import Lake.Build.Index
+import Lake.Build.Job
/-! # Build Runner
@@ -105,7 +106,7 @@ def renderProgress (running unfinished : Array OpaqueJob) (h : 0 < unfinished.si
def reportJob (job : OpaqueJob) : MonitorM PUnit := do
let {jobNo, totalJobs, ..} ← get
let {failLv, outLv, showOptional, out, useAnsi, showProgress, minAction, ..} ← read
- let {task, caption, optional} := job
+ let {task, caption, optional, ..} := job
let {log, action, ..} := task.get.state
let maxLv := log.maxLv
let failed := log.hasEntries ∧ maxLv ≥ failLv
diff --git a/src/lake/Lake/Build/Store.lean b/src/lake/Lake/Build/Store.lean
index 7b53e46f31..e173527744 100644
--- a/src/lake/Lake/Build/Store.lean
+++ b/src/lake/Lake/Build/Store.lean
@@ -32,7 +32,7 @@ namespace BuildStore
/-- Derive an array of built module facets from the store. -/
def collectModuleFacetArray
- (self : BuildStore) (facet : Name) [FamilyOut ModuleData facet α]
+ (self : BuildStore) (facet : Name) [FamilyOut FacetOut facet α]
: Array (Job α) := Id.run do
let mut res : Array (Job α) := #[]
for ⟨k, v⟩ in self do
@@ -46,7 +46,7 @@ def collectModuleFacetArray
/-- Derive a map of module names to built facets from the store. -/
def collectModuleFacetMap
- (self : BuildStore) (facet : Name) [FamilyOut ModuleData facet α]
+ (self : BuildStore) (facet : Name) [FamilyOut FacetOut facet α]
: NameMap (Job α) := Id.run do
let mut res := Lean.mkNameMap (Job α)
for ⟨k, v⟩ in self do
@@ -60,12 +60,12 @@ def collectModuleFacetMap
/-- Derive an array of built package facets from the store. -/
def collectPackageFacetArray
- (self : BuildStore) (facet : Name) [FamilyOut PackageData facet α]
+ (self : BuildStore) (facet : Name) [FamilyOut FacetOut facet α]
: Array (Job α) := Id.run do
let mut res : Array (Job α) := #[]
for ⟨k, v⟩ in self do
match k with
- | .packageFacet _ f =>
+ | .packageFacet p f =>
if h : f = facet then
have of_data := by unfold BuildData; simp [h]
res := res.push <| cast of_data v
@@ -74,19 +74,19 @@ def collectPackageFacetArray
/-- Derive an array of built target facets from the store. -/
def collectTargetFacetArray
- (self : BuildStore) (facet : Name) [FamilyOut TargetData facet α]
+ (self : BuildStore) (facet : Name) [FamilyOut FacetOut facet α]
: Array (Job α) := Id.run do
let mut res : Array (Job α) := #[]
for ⟨k, v⟩ in self do
match k with
| .targetFacet _ _ f =>
- if h : f = facet then
- have of_data := by unfold BuildData; simp [h]
+ if hf : f = facet then
+ have of_data := by unfold BuildData; simp [hf]
res := res.push <| cast of_data v
| _ => pure ()
return res
/-- Derive an array of built external shared libraries from the store. -/
def collectSharedExternLibs
- (self : BuildStore) [FamilyOut TargetData `externLib.shared α]
+ (self : BuildStore) [FamilyOut FacetOut `externLib.shared α]
: Array (Job α) := self.collectTargetFacetArray `externLib.shared
diff --git a/src/lake/Lake/Build/Target/Fetch.lean b/src/lake/Lake/Build/Target/Fetch.lean
index 7af559acb3..23b6b7aff1 100644
--- a/src/lake/Lake/Build/Target/Fetch.lean
+++ b/src/lake/Lake/Build/Target/Fetch.lean
@@ -9,29 +9,31 @@ import Lake.Config.Monad
namespace Lake
-protected def BuildKey.fetch (self : BuildKey) [h : FamilyOut BuildData self α] : FetchM (Job α) := do
- match self_eq:self with
- | moduleFacet modName facetName =>
+private def BuildKey.fetchCore (self : BuildKey) : FetchM (Job (BuildData self)) := do
+ match self with
+ | module modName =>
let some mod ← findModule? modName
| error s!"invalid target '{self}': module '{modName}' not found in workspace"
- have : FamilyOut BuildData (mod.facet facetName).key α :=
- ⟨by simpa [self_eq] using h.family_key_eq_type⟩
- fetch <| mod.facet facetName
- | packageFacet pkgName facetName =>
+ return Job.pure <| toFamily mod
+ | package pkgName =>
let some pkg ← findPackage? pkgName
| error s!"invalid target '{self}': package '{pkgName}' not found in workspace"
- have : FamilyOut BuildData (pkg.facet facetName).key α :=
- ⟨by simpa [self_eq] using h.family_key_eq_type⟩
- fetch <| pkg.facet facetName
- | targetFacet pkgName targetName facetName =>
- -- TODO: Support this
- error s!"unsupported target {self}: fetching builtin targets by key is not currently supported"
- | customTarget pkgName targetName =>
+ return Job.pure <| toFamily pkg.toPackage
+ | packageTarget pkgName target =>
let some pkg ← findPackage? pkgName
| error s!"invalid target '{self}': package '{pkgName}' not found in workspace"
- have : FamilyOut BuildData (pkg.target targetName).key α :=
- ⟨by simpa [self_eq] using h.family_key_eq_type⟩
- fetch <| pkg.target targetName
+ fetch <| pkg.target target
+ | facet target facetName =>
+ let job ← target.fetchCore
+ let kind := job.kind
+ if h : kind.isAnonymous then
+ error s!"invalid target '{self}': targets of opaque data kinds do not support facets"
+ else
+ (job.cast h).bindM fun data => fetch (.facet target kind data facetName)
+
+@[inline] protected def BuildKey.fetch
+ (self : BuildKey) [FamilyOut BuildData self α] : FetchM (Job α)
+:= cast (by simp) self.fetchCore
@[inline] protected def Target.fetch (self : Target α) : FetchM (Job α) := do
have := self.data_def; self.key.fetch
diff --git a/src/lake/Lake/Build/Targets.lean b/src/lake/Lake/Build/Targets.lean
index 14b7e522a1..f690f477be 100644
--- a/src/lake/Lake/Build/Targets.lean
+++ b/src/lake/Lake/Build/Targets.lean
@@ -10,10 +10,11 @@ import Lake.Config.Monad
Utilities for fetching package, library, module, and executable targets and facets.
-/
-namespace Lake
open Lean (Name)
open System (FilePath)
+namespace Lake
+
/-! ## Package Facets & Targets -/
/-- Fetch the build job of the specified package target. -/
@@ -25,7 +26,7 @@ def Package.fetchTargetJob
/-- Fetch the build result of a target. -/
protected def TargetDecl.fetch
(self : TargetDecl)
- [FamilyOut CustomData (self.pkg, self.name) α]
+ [FamilyOut (CustomData self.pkg) self.name α]
: FetchM (Job α) := do
let some pkg ← findPackage? self.pkg
| error s!"package '{self.pkg}' of target '{self.name}' does not exist in workspace"
@@ -39,8 +40,8 @@ def TargetDecl.fetchJob (self : TargetDecl) : FetchM OpaqueJob := do
/-- Fetch the build result of a package facet. -/
@[inline] protected def PackageFacetDecl.fetch
- (pkg : Package) (self : PackageFacetDecl) [FamilyOut PackageData self.name α]
-: FetchM (Job α) := fetch <| pkg.facet self.name
+ (pkg : Package) (self : PackageFacetDecl) [FamilyOut FacetOut self.name α]
+: FetchM (Job α) := fetch <| pkg.facetCore self.name
/-- Fetch the build job of a package facet. -/
@[deprecated "Deprecated without replacement." (since := "2025-03-17")]
@@ -58,8 +59,8 @@ def Package.fetchFacetJob
/-- Fetch the build result of a module facet. -/
@[inline] protected def ModuleFacetDecl.fetch
- (mod : Module) (self : ModuleFacetDecl) [FamilyOut ModuleData self.name α]
-: FetchM (Job α) := fetch <| mod.facet self.name
+ (mod : Module) (self : ModuleFacetDecl) [FamilyOut FacetOut self.name α]
+: FetchM (Job α) := fetch <| mod.facetCore self.name
/-- Fetch the build job of a module facet. -/
@[deprecated "Deprecated without replacement." (since := "2025-03-17")]
@@ -83,8 +84,8 @@ def Module.fetchFacetJob (name : Name) (self : Module) : FetchM OpaqueJob :=
/-- Fetch the build result of a library facet. -/
@[inline] protected def LibraryFacetDecl.fetch
- (lib : LeanLib) (self : LibraryFacetDecl) [FamilyOut LibraryData self.name α]
-: FetchM (Job α) := fetch <| lib.facet self.name
+ (lib : LeanLib) (self : LibraryFacetDecl) [FamilyOut FacetOut self.name α]
+: FetchM (Job α) := fetch <| lib.facetCore self.name
/-- Fetch the build job of a library facet. -/
@[deprecated "Deprecated without replacement," (since := "2025-03-17")]
diff --git a/src/lake/Lake/CLI/Actions.lean b/src/lake/Lake/CLI/Actions.lean
index 732a0a5f42..7d7595f72e 100644
--- a/src/lake/Lake/CLI/Actions.lean
+++ b/src/lake/Lake/CLI/Actions.lean
@@ -6,6 +6,7 @@ Authors: Mac Malone
prelude
import Lake.Build.Run
import Lake.Build.Targets
+import Lake.Build.Common
import Lake.CLI.Build
namespace Lake
diff --git a/src/lake/Lake/CLI/Build.lean b/src/lake/Lake/CLI/Build.lean
index 84ae95263f..6f56e2c00f 100644
--- a/src/lake/Lake/CLI/Build.lean
+++ b/src/lake/Lake/CLI/Build.lean
@@ -24,11 +24,12 @@ structure BuildSpec where
: BuildSpec where
info
buildable := true
- format := h.family_key_eq_type ▸ formatQuery
+ format := h.fam_eq ▸ formatQuery
@[inline] def mkConfigBuildSpec
(info : BuildInfo)
- (config : FacetConfig Fam ι facet) (h : BuildData info.key = Fam facet)
+ (config : FacetConfig facet)
+ (h : BuildData info.key = FacetOut facet)
: BuildSpec where
info
buildable := config.buildable
@@ -65,11 +66,37 @@ def resolveModuleTarget
(ws : Workspace) (mod : Module) (facet : Name)
: Except CliError BuildSpec :=
if facet.isAnonymous then
- return mkBuildSpec (mod.facet leanArtsFacet)
- else if let some config := ws.findModuleFacetConfig? facet then do
- return mkConfigBuildSpec (mod.facet facet) config rfl
+ return mkBuildSpec mod.leanArts
else
- throw <| CliError.unknownFacet "module" facet
+ let facet := Module.facetKind ++ facet
+ if let some config := ws.findModuleFacetConfig? facet then do
+ return mkConfigBuildSpec (mod.facetCore config.name) config.toFacetConfig rfl
+ else
+ throw <| CliError.unknownFacet "module" facet
+
+def resolveCustomTarget
+ (pkg : Package) (name facet : Name) (config : TargetConfig pkg.name name)
+: Except CliError BuildSpec :=
+ if !facet.isAnonymous then
+ throw <| CliError.invalidFacet name facet
+ else do
+ return {info := pkg.target name, format := config.format}
+
+def resolveConfigDeclTarget
+ (ws : Workspace) (pkg : Package)
+ {target : Name} (decl : NConfigDecl pkg.name target) (facet : Name)
+: Except CliError (Array BuildSpec) := do
+ if h : decl.kind.isAnonymous then
+ Array.singleton <$> resolveCustomTarget pkg target facet (decl.targetConfig h)
+ else
+ let facet := if facet.isAnonymous then `default else facet
+ if let some config := ws.findFacetConfig? (decl.kind ++ facet) then
+ let tgt := decl.mkConfigTarget pkg
+ let tgt := cast (by simp [decl.target_eq_type h]) tgt
+ let info := BuildInfo.facet (.packageTarget pkg.name decl.name) decl.kind tgt config.name
+ return #[mkConfigBuildSpec info config rfl]
+ else
+ throw <| CliError.unknownFacet decl.kind.toString facet
def resolveLibTarget
(ws : Workspace) (lib : LeanLib) (facet : Name := .anonymous)
@@ -77,11 +104,11 @@ def resolveLibTarget
if facet.isAnonymous then
lib.defaultFacets.mapM (resolveFacet ·)
else
- Array.singleton <$> resolveFacet facet
+ Array.singleton <$> resolveFacet (LeanLib.facetKind ++ facet)
where
resolveFacet facet :=
if let some config := ws.findLibraryFacetConfig? facet then do
- return mkConfigBuildSpec (lib.facet facet) config rfl
+ return mkConfigBuildSpec (lib.facetCore config.name) config.toFacetConfig rfl
else
throw <| CliError.unknownFacet "library" facet
@@ -103,26 +130,11 @@ def resolveExternLibTarget
else
throw <| CliError.unknownFacet "external library" facet
-set_option linter.unusedVariables false in
-def resolveCustomTarget
- (pkg : Package) (name facet : Name) (config : TargetConfig pkg.name name)
-: Except CliError BuildSpec :=
- if !facet.isAnonymous then
- throw <| CliError.invalidFacet name facet
- else do
- return {info := pkg.target name, format := config.format}
-
def resolveTargetInPackage
(ws : Workspace) (pkg : Package) (target facet : Name)
-: Except CliError (Array BuildSpec) :=
- if let some config := pkg.findTargetConfig? target then
- Array.singleton <$> resolveCustomTarget pkg target facet config
- else if let some exe := pkg.findLeanExe? target then
- Array.singleton <$> resolveExeTarget exe facet
- else if let some lib := pkg.findExternLib? target then
- Array.singleton <$> resolveExternLibTarget lib facet
- else if let some lib := pkg.findLeanLib? target then
- resolveLibTarget ws lib facet
+: Except CliError (Array BuildSpec) := do
+ if let some decl := pkg.findTargetDecl? target then
+ resolveConfigDeclTarget ws pkg decl facet
else if let some mod := pkg.findTargetModule? target then
Array.singleton <$> resolveModuleTarget ws mod facet
else
@@ -138,22 +150,18 @@ def resolvePackageTarget
: Except CliError (Array BuildSpec) :=
if facet.isAnonymous then
resolveDefaultPackageTarget ws pkg
- else if let some config := ws.findPackageFacetConfig? facet then do
- return #[mkConfigBuildSpec (pkg.facet facet) config rfl]
else
- throw <| CliError.unknownFacet "package" facet
+ let facet := Package.facetKind ++ facet
+ if let some config := ws.findPackageFacetConfig? facet then do
+ return #[mkConfigBuildSpec (pkg.facetCore config.name) config.toFacetConfig rfl]
+ else
+ throw <| CliError.unknownFacet "package" facet
def resolveTargetInWorkspace
(ws : Workspace) (target : Name) (facet : Name)
: Except CliError (Array BuildSpec) :=
- if let some ⟨pkg, config⟩ := ws.findTargetConfig? target then
- Array.singleton <$> resolveCustomTarget pkg target facet config
- else if let some exe := ws.findLeanExe? target then
- Array.singleton <$> resolveExeTarget exe facet
- else if let some lib := ws.findExternLib? target then
- Array.singleton <$> resolveExternLibTarget lib facet
- else if let some lib := ws.findLeanLib? target then
- resolveLibTarget ws lib facet
+ if let some ⟨pkg, decl⟩ := ws.findTargetDecl? target then
+ resolveConfigDeclTarget ws pkg decl facet
else if let some pkg := ws.findPackage? target then
resolvePackageTarget ws pkg facet
else if let some mod := ws.findTargetModule? target then
diff --git a/src/lake/Lake/CLI/Translate/Lean.lean b/src/lake/Lake/CLI/Translate/Lean.lean
index 17116f5b0e..9abc2bd2c9 100644
--- a/src/lake/Lake/CLI/Translate/Lean.lean
+++ b/src/lake/Lake/CLI/Translate/Lean.lean
@@ -253,6 +253,6 @@ def Package.mkLeanConfig (pkg : Package) : TSyntax ``module := Unhygienic.run do
open $(mkIdent `System) $(mkIdent `Lake) $(mkIdent `DSL)
$(pkgConfig.mkCommand):command
$[$(pkg.depConfigs.map (·.mkRequire)):command]*
- $[$(pkg.mkTargetCommands defaultTargets `lean_lib LeanLibConfig.mkCommand):command]*
- $[$(pkg.mkTargetCommands defaultTargets `lean_exe LeanExeConfig.mkCommand):command]*
+ $[$(pkg.mkTargetCommands defaultTargets LeanLib.configKind LeanLibConfig.mkCommand):command]*
+ $[$(pkg.mkTargetCommands defaultTargets LeanExe.configKind LeanExeConfig.mkCommand):command]*
)
diff --git a/src/lake/Lake/CLI/Translate/Toml.lean b/src/lake/Lake/CLI/Translate/Toml.lean
index b149cdc7d8..ae2eba5993 100644
--- a/src/lake/Lake/CLI/Translate/Toml.lean
+++ b/src/lake/Lake/CLI/Translate/Toml.lean
@@ -20,6 +20,11 @@ open Lean System Toml
private local instance : BEq FilePath where
beq a b := a.normalize == b.normalize
+class EncodeField (σ : Type u) (name : Name) (α : Type u) where
+ encodeField : α → Value
+
+instance [ToToml α] : EncodeField σ name α := ⟨toToml⟩
+
class InsertField (σ : Type u) (name : Name) where
insertField : σ → Table → Table
@@ -30,8 +35,8 @@ abbrev Toml.Table.insertField
instance [SmartInsert α] [field : ConfigField σ name α] : InsertField σ name where
insertField cfg t := t.smartInsert name (field.get cfg)
-instance [ToToml α] [BEq α] [field : ConfigField σ name α] : InsertField σ name where
- insertField cfg t := t.insertD name (field.get cfg) (field.mkDefault cfg)
+instance [enc : EncodeField σ name α] [BEq α] [field : ConfigField σ name α] : InsertField σ name where
+ insertField cfg t := t.insertD name (field.get cfg) (field.mkDefault cfg) (enc := ⟨enc.encodeField⟩)
/-! ## Value Encoders -/
@@ -69,6 +74,11 @@ def smartInsertVerTags (pat : StrPat) (t : Table) : Table :=
instance : InsertField (PackageConfig n) `versionTags where
insertField cfg := smartInsertVerTags cfg.versionTags
+def encodeFacets (facets : Array Name) : Value :=
+ toToml <| facets.map (toToml <| Name.eraseHead ·)
+
+instance : EncodeField (LeanLibConfig n) `defaultFacets (Array Name) := ⟨encodeFacets⟩
+
/-! ## Dependency Configuration Encoders -/
protected def Dependency.toToml (dep : Dependency) (t : Table := {}) : Table :=
@@ -127,11 +137,11 @@ local macro "gen_toml_encoders%" : command => do
gen_toml_encoders%
-@[inline] def Toml.Table.insertTargets
+@[inline] def Package.mkTomlTargets
(pkg : Package) (kind : Name)
- (toToml : {n : Name} → ConfigType kind pkg.name n → Table) (t : Table)
-: Table :=
- t.smartInsert kind <| pkg.targetDecls.filterMap (·.config? kind |>.map toToml)
+ (toToml : {n : Name} → ConfigType kind pkg.name n → Table)
+: Array Table :=
+ pkg.targetDecls.filterMap (·.config? kind |>.map toToml)
/-! ## Root Encoder -/
@@ -142,5 +152,5 @@ def Package.mkTomlConfig (pkg : Package) (t : Table := {}) : Table :=
cfg.toToml t
|>.smartInsert `defaultTargets pkg.defaultTargets
|>.smartInsert `require pkg.depConfigs
- |>.insertTargets pkg `lean_lib LeanLibConfig.toToml
- |>.insertTargets pkg `lean_exe LeanExeConfig.toToml
+ |>.smartInsert LeanLib.keyword (pkg.mkTomlTargets LeanLib.configKind LeanLibConfig.toToml)
+ |>.smartInsert LeanExe.keyword (pkg.mkTomlTargets LeanExe.configKind LeanExeConfig.toToml)
diff --git a/src/lake/Lake/Config/ConfigDecl.lean b/src/lake/Lake/Config/ConfigDecl.lean
index e005939a76..5aad70c170 100644
--- a/src/lake/Lake/Config/ConfigDecl.lean
+++ b/src/lake/Lake/Config/ConfigDecl.lean
@@ -1,5 +1,5 @@
/-
-Copyright (c) 2022 Mac Malone. All rights reserved.
+Copyright (c) 2025 Mac Malone. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mac Malone
-/
@@ -13,78 +13,121 @@ open Lean (Name)
namespace Lake
+/-- The keyword for Lean library configurations. -/
+abbrev LeanLib.keyword : Name := `lean_lib
+
+/-- The type kind for Lean library configurations. -/
+@[match_pattern] abbrev LeanLib.configKind := facetKind
+
+/-- The keyword for Lean executable configurations. -/
+abbrev LeanExe.keyword : Name := `lean_exe
+
+/-- The type kind for Lean executable configurations. -/
+@[match_pattern] abbrev LeanExe.configKind := facetKind
+
+/-- The keyword for external library configurations. -/
+abbrev ExternLib.keyword : Name := `extern_lib
+
+/-- The type kind for external library configurations. -/
+@[match_pattern] abbrev ExternLib.configKind := facetKind
+
abbrev ConfigType (kind : Name) (pkgName name : Name) : Type :=
match kind with
- | `lean_lib => LeanLibConfig name
- | `lean_exe => LeanExeConfig name
- | `extern_lib => ExternLibConfig pkgName name
+ | LeanLib.configKind => LeanLibConfig name
+ | LeanExe.configKind => LeanExeConfig name
+ | ExternLib.configKind => ExternLibConfig pkgName name
| .anonymous => OpaqueTargetConfig pkgName name
| _ => Empty
+/-- Forward declared `ConfigTarget` to work around recursion issues (e.g., with `Package`). -/
+opaque OpaqueConfigTarget (kind : Name) : Type
+
structure ConfigDecl where
pkg : Name
name : Name
kind : Name
config : ConfigType kind pkg name
+ wf_data : ¬ kind.isAnonymous → CustomData pkg name = DataType kind ∧ DataType kind = OpaqueConfigTarget kind
deriving TypeName
structure PConfigDecl (p : Name) extends ConfigDecl where
- pkg_eq : toConfigDecl.pkg = p
+ pkg_eq : toConfigDecl.pkg = p := by rfl
structure NConfigDecl (p n : Name) extends PConfigDecl p where
- name_eq : toConfigDecl.name = n
+ name_eq : toConfigDecl.name = n := by rfl
structure KConfigDecl (k : Name) extends ConfigDecl where
- kind_eq : toConfigDecl.kind = k
+ kind_eq : toConfigDecl.kind = k := by rfl
+
+instance : Nonempty (NConfigDecl pkg name) :=
+ ⟨{pkg, name, kind := .anonymous, config := Classical.ofNonempty, wf_data := by simp [Name.isAnonymous]}⟩
+
+@[inline] def PConfigDecl.config' (self : PConfigDecl p) : ConfigType self.kind p self.name :=
+ cast (by rw [self.pkg_eq]) self.config
+
+@[inline] def NConfigDecl.config' (self : NConfigDecl p n) : ConfigType self.kind p n :=
+ cast (by rw [self.name_eq]) self.toPConfigDecl.config'
+
+theorem NConfigDecl.target_eq_type (self : NConfigDecl p n)
+ (h : ¬ self.kind.isAnonymous) : DataType self.kind = OpaqueConfigTarget self.kind
+:= self.wf_data h |>.2
+
+theorem NConfigDecl.data_eq_target (self : NConfigDecl p n)
+ (h : ¬ self.kind.isAnonymous) : CustomData p n = OpaqueConfigTarget self.kind
+:= by simpa [self.pkg_eq, self.name_eq, self.target_eq_type h] using (self.wf_data h).1
@[inline] def ConfigDecl.config? (kind : Name) (self : ConfigDecl) : Option (ConfigType kind self.pkg self.name) :=
if h : self.kind = kind then
- some <| cast (by simp [h]) self.config
+ some <| cast (by rw [h]) self.config
else
none
@[inline] def PConfigDecl.config? (kind : Name) (self : PConfigDecl p) : Option (ConfigType kind p self.name) :=
- cast (by simp [self.pkg_eq]) (self.toConfigDecl.config? kind)
+ cast (by rw [self.pkg_eq]) (self.toConfigDecl.config? kind)
@[inline] def NConfigDecl.config? (kind : Name) (self : NConfigDecl p n) : Option (ConfigType kind p n) :=
- cast (by simp [self.name_eq]) (self.toPConfigDecl.config? kind)
+ cast (by rw [self.name_eq]) (self.toPConfigDecl.config? kind)
@[inline] def ConfigDecl.leanLibConfig? (self : ConfigDecl) : Option (LeanLibConfig self.name) :=
- self.config? `lean_lib
+ self.config? LeanLib.configKind
@[inline] def NConfigDecl.leanLibConfig? (self : NConfigDecl p n) : Option (LeanLibConfig n) :=
- self.config? `lean_lib
+ self.config? LeanLib.configKind
/-- A Lean library declaration from a configuration written in Lean. -/
-abbrev LeanLibDecl := KConfigDecl `lean_lib
+abbrev LeanLibDecl := KConfigDecl LeanLib.configKind
@[inline] def ConfigDecl.leanExeConfig? (self : ConfigDecl) : Option (LeanExeConfig self.name) :=
- self.config? `lean_exe
+ self.config? LeanExe.configKind
@[inline] def NConfigDecl.leanExeConfig? (self : NConfigDecl p n) : Option (LeanExeConfig n) :=
- self.config? `lean_exe
+ self.config? LeanExe.configKind
/-- A Lean executable declaration from a configuration written in Lean. -/
-abbrev LeanExeDecl := KConfigDecl `lean_exe
+abbrev LeanExeDecl := KConfigDecl LeanExe.configKind
@[inline] def PConfigDecl.externLibConfig? (self : PConfigDecl p) : Option (ExternLibConfig p self.name) :=
- self.config? `extern_lib
+ self.config? ExternLib.configKind
@[inline] def NConfigDecl.externLibConfig? (self : NConfigDecl p n) : Option (ExternLibConfig p n) :=
- self.config? `extern_lib
+ self.config? ExternLib.configKind
/-- An external library declaration from a configuration written in Lean. -/
-abbrev ExternLibDecl := KConfigDecl `extern_lib
+abbrev ExternLibDecl := KConfigDecl ExternLib.configKind
+
+@[inline] def PConfigDecl.opaqueTargetConfig (self : PConfigDecl p) (h : self.kind.isAnonymous) : OpaqueTargetConfig p self.name :=
+ cast (by rw [self.pkg_eq, Name.eq_anonymous_of_isAnonymous h, ConfigType]) self.config
+
+@[inline] def NConfigDecl.opaqueTargetConfig (self : NConfigDecl p n) (h : self.kind.isAnonymous) : OpaqueTargetConfig p n :=
+ cast (by rw [self.name_eq]) (self.toPConfigDecl.opaqueTargetConfig h)
@[inline] def PConfigDecl.opaqueTargetConfig? (self : PConfigDecl p) : Option (OpaqueTargetConfig p self.name) :=
if h : self.kind.isAnonymous then
- have h : self.kind = .anonymous := by
- revert h; cases self.kind <;> simp [Name.isAnonymous]
- some <| cast (by simp [self.pkg_eq, h, ConfigType]) self.config
+ some <| self.opaqueTargetConfig h
else
none
@[inline] def NConfigDecl.opaqueTargetConfig? (self : NConfigDecl p n) : Option (OpaqueTargetConfig p n) :=
- cast (by simp [self.name_eq]) self.toPConfigDecl.opaqueTargetConfig?
+ cast (by rw [self.name_eq]) self.toPConfigDecl.opaqueTargetConfig?
deriving instance TypeName for LeanLibDecl, LeanExeDecl
diff --git a/src/lake/Lake/Config/ConfigTarget.lean b/src/lake/Lake/Config/ConfigTarget.lean
new file mode 100644
index 0000000000..7e7af93d14
--- /dev/null
+++ b/src/lake/Lake/Config/ConfigTarget.lean
@@ -0,0 +1,46 @@
+/-
+Copyright (c) 2025 Mac Malone. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Mac Malone
+-/
+prelude
+import Lake.Config.Package
+
+open Lean
+
+namespace Lake
+
+/--
+A user-configured target -- its package and its configuration.
+This is the general structure from which `LeanLib`, `LeanExe`, etc. are derived.
+-/
+structure ConfigTarget (kind : Name) where
+ /-- The package the target belongs to. -/
+ pkg : Package
+ /-- The target's name. -/
+ name : Name
+ /-- The target's user-defined configuration. -/
+ config : ConfigType kind pkg.name name
+
+@[simp] axiom OpaqueConfigTarget.def {k : Name} : OpaqueConfigTarget k = ConfigTarget k
+
+@[inline] def PConfigDecl.mkConfigTarget (pkg : Package) (self : PConfigDecl pkg.name) : ConfigTarget self.kind :=
+ ConfigTarget.mk pkg self.name self.config'
+
+/-- Returns the package targets of the specified kind (as an `Array`). -/
+@[inline] def Package.configTargets (kind : Name) (self : Package) : Array (ConfigTarget kind) :=
+ self.targetDecls.foldl (init := #[]) fun a t =>
+ let {name, kind := k, config, pkg_eq, ..} := t
+ if kind_eq : k = kind then
+ a.push ⟨self, name, kind_eq ▸ pkg_eq ▸ config⟩
+ else
+ a
+
+/-- Try to find a package target of the given name and kind. -/
+@[inline] def Package.findConfigTarget? (kind : Name) (name : Name) (self : Package) : Option (ConfigTarget kind) :=
+ self.findTargetDecl? name |>.bind fun t =>
+ let {name, kind := k, config, pkg_eq, ..} := t
+ if kind_eq : k = kind then
+ some ⟨self, name, kind_eq ▸ pkg_eq ▸ config⟩
+ else
+ none
diff --git a/src/lake/Lake/Config/ExternLib.lean b/src/lake/Lake/Config/ExternLib.lean
index 5355eeb4a3..58db6e8592 100644
--- a/src/lake/Lake/Config/ExternLib.lean
+++ b/src/lake/Lake/Config/ExternLib.lean
@@ -4,32 +4,28 @@ Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mac Malone
-/
prelude
-import Lake.Config.Package
+import Lake.Config.ConfigTarget
namespace Lake
open Lean (Name)
/-- An external library -- its package plus its configuration. -/
-structure ExternLib where
- /-- The package the library belongs to. -/
- pkg : Package
- /-- The external library's name. -/
- name : Name
- /-- The library's user-defined configuration. -/
- config : ExternLibConfig pkg.name name
+abbrev ExternLib := ConfigTarget ExternLib.configKind
/-- The external libraries of the package (as an Array). -/
@[inline] def Package.externLibs (self : Package) : Array ExternLib :=
- self.targetDecls.foldl (init := #[]) fun a t =>
- if let some cfg := t.externLibConfig? then a.push ⟨self, t.name, cfg⟩ else a
+ self.configTargets ExternLib.configKind
/-- Try to find a external library in the package with the given name. -/
@[inline] def Package.findExternLib? (name : Name) (self : Package) : Option ExternLib :=
- self.targetDeclMap.find? name |>.bind fun t => t.externLibConfig?.map fun cfg =>
- ⟨self, name, cfg⟩
+ self.findConfigTarget? ExternLib.configKind name
namespace ExternLib
+/-- The library's user-defined configuration. -/
+@[inline] nonrec def config (self : ExternLib) : ExternLibConfig self.pkg.name self.name :=
+ self.config
+
/--
The arguments to pass to `leanc` when linking the external library.
That is, the package's `moreLinkArgs`.
diff --git a/src/lake/Lake/Config/ExternLibConfig.lean b/src/lake/Lake/Config/ExternLibConfig.lean
index eb41317785..884f872602 100644
--- a/src/lake/Lake/Config/ExternLibConfig.lean
+++ b/src/lake/Lake/Config/ExternLibConfig.lean
@@ -13,5 +13,5 @@ open Lean System
/-- A external library's declarative configuration. -/
structure ExternLibConfig (pkgName name : Name) where
/-- The library's build data. -/
- getPath : Job (CustomData (pkgName, .str name "static")) → Job FilePath
+ getPath : Job (CustomData pkgName (.str name "static")) → Job FilePath
deriving Inhabited
diff --git a/src/lake/Lake/Config/FacetConfig.lean b/src/lake/Lake/Config/FacetConfig.lean
index c11fbd3812..b4349127f2 100644
--- a/src/lake/Lake/Config/FacetConfig.lean
+++ b/src/lake/Lake/Config/FacetConfig.lean
@@ -11,25 +11,51 @@ namespace Lake
open Lean (Name)
/-- A facet's declarative configuration. -/
-structure FacetConfig (DataFam : Name → Type) (ι : Type) (name : Name) : Type where
+structure FacetConfig (name : Name) : Type where
+ /-- The facet kind (i.e., the kind of targets that support this facet). -/
+ kind : Name
/-- The facet's fetch function. -/
- fetchFn : ι → FetchM (Job (DataFam name))
+ fetchFn : DataType kind → FetchM (Job (FacetOut name))
/-- Is this facet compatible with the `lake build` CLI? -/
buildable : Bool := true
/-- Format this facet's output (e.g., for `lake query`). -/
- format : OutFormat → DataFam name → String
+ format : OutFormat → FacetOut name → String
deriving Inhabited
-protected abbrev FacetConfig.name (_ : FacetConfig DataFam ι name) := name
+protected abbrev FacetConfig.name (_ : FacetConfig name) := name
+
+structure KFacetConfig (k : Name) (name : Name) extends FacetConfig name where
+ kind := k
+ kind_eq : toFacetConfig.kind = k := by rfl
+
+abbrev FacetConfig.toKind
+ {kind : Name} (self : FacetConfig name) (h : self.kind = kind)
+: KFacetConfig kind name := KFacetConfig.mk self h
+
+def FacetConfig.toKind? (kind : Name) (self : FacetConfig name) : Option (KFacetConfig kind name) :=
+ if h : self.kind = kind then
+ some (self.toKind h)
+ else
+ none
+
+/-- Run the facet configuration's fetch function. -/
+@[inline] def KFacetConfig.run
+ [FamilyOut DataType kind α]
+ [FamilyOut FacetOut facet β]
+ (self : KFacetConfig kind facet) (info : α)
+: FetchM (Job β) :=
+ cast (by simp) <| self.fetchFn <| cast (by simp [self.kind_eq]) info
/-- A smart constructor for facet configurations that generate jobs for the CLI. -/
@[inline] def mkFacetJobConfig
- [FormatQuery α] [h : FamilyOut Fam facet α]
- (build : ι → FetchM (Job α)) (buildable := true)
-: FacetConfig Fam ι facet where
+ [FormatQuery β]
+ [i : FamilyOut DataType kind α]
+ [o : FamilyOut FacetOut facet β]
+ (build : α → FetchM (Job β)) (buildable := true)
+: KFacetConfig kind facet where
buildable
- fetchFn := h.family_key_eq_type ▸ build
- format := h.family_key_eq_type ▸ formatQuery
+ fetchFn := i.fam_eq ▸ o.fam_eq ▸ build
+ format := o.fam_eq ▸ formatQuery
/-- A dependently typed configuration based on its registered name. -/
structure NamedConfigDecl (β : Name → Type u) where
@@ -37,22 +63,31 @@ structure NamedConfigDecl (β : Name → Type u) where
config : β name
/-- A module facet's declarative configuration. -/
-abbrev ModuleFacetConfig := FacetConfig ModuleData Module
+abbrev ModuleFacetConfig := KFacetConfig Module.facetKind
/-- A module facet declaration from a configuration file. -/
abbrev ModuleFacetDecl := NamedConfigDecl ModuleFacetConfig
/-- A package facet's declarative configuration. -/
-abbrev PackageFacetConfig := FacetConfig PackageData Package
+abbrev PackageFacetConfig := KFacetConfig Package.facetKind
/-- A package facet declaration from a configuration file. -/
abbrev PackageFacetDecl := NamedConfigDecl PackageFacetConfig
/-- A library facet's declarative configuration. -/
-abbrev LibraryFacetConfig := FacetConfig LibraryData LeanLib
+abbrev LibraryFacetConfig := KFacetConfig LeanLib.facetKind
/-- A library facet declaration from a configuration file. -/
abbrev LibraryFacetDecl := NamedConfigDecl LibraryFacetConfig
deriving instance TypeName for
ModuleFacetDecl, PackageFacetDecl, LibraryFacetDecl
+
+/-- A library facet's declarative configuration. -/
+abbrev LeanLibFacetConfig := LibraryFacetConfig
+
+/-- A Lean executable facet's declarative configuration. -/
+abbrev LeanExeFacetConfig := KFacetConfig LeanExe.facetKind
+
+/-- An external library facet's declarative configuration. -/
+abbrev ExternLibFacetConfig := KFacetConfig ExternLib.facetKind
diff --git a/src/lake/Lake/Config/LeanExe.lean b/src/lake/Lake/Config/LeanExe.lean
index 3bcad0b588..eece5a2e3b 100644
--- a/src/lake/Lake/Config/LeanExe.lean
+++ b/src/lake/Lake/Config/LeanExe.lean
@@ -10,23 +10,15 @@ namespace Lake
open Lean System
/-- A Lean executable -- its package plus its configuration. -/
-structure LeanExe where
- /-- The package the executable belongs to. -/
- pkg : Package
- /-- The executable's name. -/
- name : Name
- /-- The executable's user-defined configuration. -/
- config : LeanExeConfig name
+abbrev LeanExe := ConfigTarget LeanExe.configKind
/-- The Lean executables of the package (as an Array). -/
@[inline] def Package.leanExes (self : Package) : Array LeanExe :=
- self.targetDecls.foldl (init := #[]) fun a t =>
- if let some cfg := t.leanExeConfig? then a.push ⟨self, t.name, cfg⟩ else a
+ self.configTargets LeanExe.configKind
/-- Try to find a Lean executable in the package with the given name. -/
@[inline] def Package.findLeanExe? (name : Name) (self : Package) : Option LeanExe :=
- self.targetDeclMap.find? name |>.bind fun t => t.leanExeConfig?.map fun cfg =>
- ⟨self, name, cfg⟩
+ self.findConfigTarget? LeanExe.configKind name
/--
Converts the executable configuration into a library
@@ -42,6 +34,10 @@ def LeanExeConfig.toLeanLibConfig (self : LeanExeConfig n) : LeanLibConfig n whe
namespace LeanExe
+/-- The executable's user-defined configuration. -/
+@[inline] nonrec def config (self : LeanExe) : LeanExeConfig self.name :=
+ self.config
+
/-- Converts the executable into a library with a single module (the root). -/
@[inline] def toLeanLib (self : LeanExe) : LeanLib :=
⟨self.pkg, self.name, self.config.toLeanLibConfig⟩
diff --git a/src/lake/Lake/Config/LeanLib.lean b/src/lake/Lake/Config/LeanLib.lean
index 0794329c84..817e9d7934 100644
--- a/src/lake/Lake/Config/LeanLib.lean
+++ b/src/lake/Lake/Config/LeanLib.lean
@@ -4,32 +4,28 @@ Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mac Malone
-/
prelude
-import Lake.Config.Package
+import Lake.Config.ConfigTarget
namespace Lake
open Lean System
/-- A Lean library -- its package plus its configuration. -/
-structure LeanLib where
- /-- The package the library belongs to. -/
- pkg : Package
- /-- The library's name. -/
- name : Name
- /-- The library's user-defined configuration. -/
- config : LeanLibConfig name
+abbrev LeanLib := ConfigTarget LeanLib.configKind
/-- The Lean libraries of the package (as an Array). -/
@[inline] def Package.leanLibs (self : Package) : Array LeanLib :=
- self.targetDecls.foldl (init := #[]) fun a t =>
- if let some cfg := t.leanLibConfig? then a.push ⟨self, t.name, cfg⟩ else a
+ self.configTargets LeanLib.configKind
/-- Try to find a Lean library in the package with the given name. -/
@[inline] def Package.findLeanLib? (name : Name) (self : Package) : Option LeanLib :=
- self.targetDeclMap.find? name |>.bind fun t => t.leanLibConfig?.map fun cfg =>
- ⟨self, name, cfg⟩
+ self.findConfigTarget? LeanLib.configKind name
namespace LeanLib
+/-- The library's user-defined configuration. -/
+@[inline] nonrec def config (self : LeanLib) : LeanLibConfig self.name :=
+ self.config
+
/-- The package's `srcDir` joined with the library's `srcDir`. -/
@[inline] def srcDir (self : LeanLib) : FilePath :=
self.pkg.srcDir / self.config.srcDir
diff --git a/src/lake/Lake/Config/Package.lean b/src/lake/Lake/Config/Package.lean
index 3dbc1a344e..45e72e1d4a 100644
--- a/src/lake/Lake/Config/Package.lean
+++ b/src/lake/Lake/Config/Package.lean
@@ -636,6 +636,10 @@ namespace Package
@[inline] def irDir (self : Package) : FilePath :=
self.buildDir / self.config.irDir
+/-- Try to find a target configuration in the package with the given name. -/
+def findTargetDecl? (name : Name) (self : Package) : Option (NConfigDecl self.name name) :=
+ self.targetDeclMap.find? name
+
/-- Whether the given module is considered local to the package. -/
def isLocalModule (mod : Name) (self : Package) : Bool :=
self.targetDecls.any (·.leanLibConfig?.any (·.isLocalModule mod))
diff --git a/src/lake/Lake/Config/TargetConfig.lean b/src/lake/Lake/Config/TargetConfig.lean
index 514a49f9a2..681be75dbb 100644
--- a/src/lake/Lake/Config/TargetConfig.lean
+++ b/src/lake/Lake/Config/TargetConfig.lean
@@ -14,21 +14,24 @@ namespace Lake
/-- A custom target's declarative configuration. -/
structure TargetConfig (pkgName name : Name) : Type where
/-- The target's fetch function. -/
- fetchFn : (pkg : NPackage pkgName) → FetchM (Job (CustomData (pkgName, name)))
+ fetchFn : (pkg : NPackage pkgName) → FetchM (Job (CustomData pkgName name))
/-- Format the target's output (e.g., for `lake query`). -/
- format : OutFormat → CustomData (pkgName, name) → String
+ format : OutFormat → CustomData pkgName name → String
deriving Inhabited
/-- A smart constructor for target configurations that generate CLI targets. -/
@[inline] def mkTargetJobConfig
- [FormatQuery α] [h : FamilyOut CustomData (pkgName, name) α]
+ [FormatQuery α] [h : FamilyOut (CustomData pkgName) name α]
(fetch : (pkg : NPackage pkgName) → FetchM (Job α))
: TargetConfig pkgName name where
- fetchFn := h.family_key_eq_type ▸ fetch
- format := h.family_key_eq_type ▸ formatQuery
+ fetchFn := h.fam_eq ▸ fetch
+ format := h.fam_eq ▸ formatQuery
hydrate_opaque_type OpaqueTargetConfig TargetConfig pkgName name
+@[inline] def NConfigDecl.targetConfig (self : NConfigDecl p n) (h : self.kind.isAnonymous) : TargetConfig p n :=
+ self.opaqueTargetConfig h |>.get
+
@[inline] def NConfigDecl.targetConfig? (self : NConfigDecl p n) : Option (TargetConfig p n) :=
self.opaqueTargetConfig?.map (·.get)
diff --git a/src/lake/Lake/Config/Workspace.lean b/src/lake/Lake/Config/Workspace.lean
index 4d6dea3331..f8421a4a39 100644
--- a/src/lake/Lake/Config/Workspace.lean
+++ b/src/lake/Lake/Config/Workspace.lean
@@ -31,12 +31,8 @@ structure Workspace : Type where
packages : Array Package := {}
/-- Name-package map of packages within the workspace. -/
packageMap : DNameMap NPackage := {}
- /-- Name-configuration map of module facets defined in the workspace. -/
- moduleFacetConfigs : DNameMap ModuleFacetConfig
- /-- Name-configuration map of package facets defined in the workspace. -/
- packageFacetConfigs : DNameMap PackageFacetConfig
- /-- Name-configuration map of library facets defined in the workspace. -/
- libraryFacetConfigs : DNameMap LibraryFacetConfig
+ /-- Configuration map of facets defined in the workspace. -/
+ facetConfigs : DNameMap FacetConfig := {}
instance : Nonempty Workspace :=
have : Inhabited Package := Classical.inhabited_of_nonempty inferInstance
@@ -122,29 +118,41 @@ protected def findExternLib? (name : Name) (self : Workspace) : Option ExternLib
def findTargetConfig? (name : Name) (self : Workspace) : Option ((pkg : Package) × TargetConfig pkg.name name) :=
self.packages.findSome? fun pkg => pkg.findTargetConfig? name <&> (⟨pkg, ·⟩)
+/-- Try to find a target declaration in the workspace with the given name. -/
+def findTargetDecl? (name : Name) (self : Workspace) : Option ((pkg : Package) × NConfigDecl pkg.name name) :=
+ self.packages.findSome? fun pkg => pkg.findTargetDecl? name <&> (⟨pkg, ·⟩)
+
+/-- Add a facet to the workspace. -/
+def addFacetConfig {name} (cfg : FacetConfig name) (self : Workspace) : Workspace :=
+ {self with facetConfigs := self.facetConfigs.insert name cfg}
+
+/-- Try to find a facet configuration in the workspace with the given name. -/
+def findFacetConfig? (name : Name) (self : Workspace) : Option (FacetConfig name) :=
+ self.facetConfigs.find? name
+
/-- Add a module facet to the workspace. -/
def addModuleFacetConfig (cfg : ModuleFacetConfig name) (self : Workspace) : Workspace :=
- {self with moduleFacetConfigs := self.moduleFacetConfigs.insert name cfg}
+ self.addFacetConfig cfg.toFacetConfig
/-- Try to find a module facet configuration in the workspace with the given name. -/
def findModuleFacetConfig? (name : Name) (self : Workspace) : Option (ModuleFacetConfig name) :=
- self.moduleFacetConfigs.find? name
+ self.findFacetConfig? name |>.bind (·.toKind? Module.facetKind)
/-- Add a package facet to the workspace. -/
def addPackageFacetConfig (cfg : PackageFacetConfig name) (self : Workspace) : Workspace :=
- {self with packageFacetConfigs := self.packageFacetConfigs.insert name cfg}
+ self.addFacetConfig cfg.toFacetConfig
/-- Try to find a package facet configuration in the workspace with the given name. -/
def findPackageFacetConfig? (name : Name) (self : Workspace) : Option (PackageFacetConfig name) :=
- self.packageFacetConfigs.find? name
+ self.findFacetConfig? name |>.bind (·.toKind? Package.facetKind)
/-- Add a library facet to the workspace. -/
def addLibraryFacetConfig (cfg : LibraryFacetConfig name) (self : Workspace) : Workspace :=
- {self with libraryFacetConfigs := self.libraryFacetConfigs.insert cfg.name cfg}
+ self.addFacetConfig cfg.toFacetConfig
/-- Try to find a library facet configuration in the workspace with the given name. -/
def findLibraryFacetConfig? (name : Name) (self : Workspace) : Option (LibraryFacetConfig name) :=
- self.libraryFacetConfigs.find? name
+ self.findFacetConfig? name |>.bind (·.toKind? LeanLib.facetKind)
/-- The workspace's binary directories (which are added to `Path`). -/
def binPath (self : Workspace) : SearchPath :=
diff --git a/src/lake/Lake/DSL/Targets.lean b/src/lake/Lake/DSL/Targets.lean
index 7ba28917d9..58fbdb11f5 100644
--- a/src/lake/Lake/DSL/Targets.lean
+++ b/src/lake/Lake/DSL/Targets.lean
@@ -5,7 +5,9 @@ Authors: Mac Malone
-/
prelude
import Lake.DSL.DeclUtil
-import Lake.Build.Index
+import Lake.Config.FacetConfig
+import Lake.Config.TargetConfig
+import Lake.Build.Job
/-! # DSL for Targets & Facets
Macros for declaring Lake targets and facets.
@@ -25,9 +27,9 @@ syntax buildDeclSig :=
abbrev mkModuleFacetDecl
(α) (facet : Name)
- [FormatQuery α] [FamilyDef ModuleData facet α]
+ [OptDataKind α] [FormatQuery α] [FamilyDef ModuleData facet α]
(f : Module → FetchM (Job α))
-: ModuleFacetDecl := .mk facet <| mkFacetJobConfig fun mod => do
+: ModuleFacetDecl := .mk (Module.facetKind ++ facet) <| mkFacetJobConfig fun mod => do
withRegisterJob (mod.facet facet |>.key.toSimpleString)
(f mod)
@@ -64,9 +66,9 @@ def expandModuleFacetDecl : Macro := fun stx => do
abbrev mkPackageFacetDecl
(α) (facet : Name)
- [FormatQuery α] [FamilyDef PackageData facet α]
+ [OptDataKind α] [FormatQuery α] [FamilyDef PackageData facet α]
(f : Package → FetchM (Job α))
-: PackageFacetDecl := .mk facet <| mkFacetJobConfig fun pkg => do
+: PackageFacetDecl := .mk (Package.facetKind ++ facet) <| mkFacetJobConfig fun pkg => do
withRegisterJob (pkg.facet facet |>.key.toSimpleString)
(f pkg)
@@ -103,9 +105,9 @@ def expandPackageFacetDecl : Macro := fun stx => do
abbrev mkLibraryFacetDecl
(α) (facet : Name)
- [FormatQuery α] [FamilyDef LibraryData facet α]
+ [OptDataKind α] [FormatQuery α] [FamilyDef LibraryData facet α]
(f : LeanLib → FetchM (Job α))
-: LibraryFacetDecl := .mk facet <| mkFacetJobConfig fun lib => do
+: LibraryFacetDecl := .mk (LeanLib.facetKind ++ facet) <| mkFacetJobConfig fun lib => do
withRegisterJob (lib.facet facet |>.key.toSimpleString)
(f lib)
@@ -147,13 +149,13 @@ def expandLibraryFacetDecl : Macro := fun stx => do
abbrev mkTargetDecl
(α) (pkgName target : Name)
- [FormatQuery α] [FamilyDef CustomData (pkgName, target) α]
+ [OptDataKind α] [FormatQuery α] [FamilyDef (CustomData pkgName) target α]
(f : NPackage pkgName → FetchM (Job α))
: TargetDecl :=
let cfg := mkTargetJobConfig fun pkg => do
withRegisterJob (pkg.target target |>.key.toSimpleString)
(f pkg)
- .mk (.mk pkgName target .anonymous (.mk cfg)) rfl
+ .mk (.mk pkgName target .anonymous (.mk cfg) (by simp [Name.isAnonymous])) rfl
/--
Define a new custom target for the package. Has one form:
@@ -180,9 +182,9 @@ def expandTargetCommand : Macro := fun stx => do
let attr ← `(Term.attrInstance| «target»)
let attrs := #[attr] ++ expandAttrs attrs?
let name := Name.quoteFrom id id.getId
- let pkgName := mkIdentFrom id `_package.name
+ let pkgName := mkIdentFrom id (packageDeclName.str "name")
let pkg ← expandOptSimpleBinder pkg?
- `(family_def $id : CustomData ($pkgName, $name) := $ty
+ `(family_def $id : CustomOut ($pkgName, $name) := $ty
$[$doc?]? abbrev $id :=
Lake.DSL.mkTargetDecl $ty $pkgName $name (fun $pkg => $defn)
$[$wds?:whereDecls]?
@@ -192,8 +194,16 @@ def expandTargetCommand : Macro := fun stx => do
/-! ## Lean Library & Executable Target Declarations -/
--------------------------------------------------------------------------------
-def mkConfigDecl
- (tyName kind : Name)
+abbrev mkConfigDecl
+ (pkg name kind : Name)
+ (config : ConfigType kind pkg name)
+ [FamilyDef (CustomData pkg) name (ConfigTarget kind)]
+ [FamilyDef DataType kind (ConfigTarget kind)]
+: KConfigDecl kind :=
+ {pkg, name, kind, config, wf_data := fun _ => by simp, kind_eq := rfl}
+
+def mkConfigDeclDef
+ (tyName attr kind : Name)
[ConfigInfo tyName] [delTyName : TypeName (KConfigDecl kind)]
(doc? : Option DocComment) (attrs? : Option Attributes)
(nameStx? : Option IdentOrStr) (cfg : OptConfig)
@@ -203,18 +213,16 @@ def mkConfigDecl
let name := Name.quoteFrom id id.getId
let ty := Syntax.mkCApp tyName #[name]
elabConfig tyName configId ty cfg
- let kindId ← mkIdentFromRef kind
+ let attrId ← mkIdentFromRef attr
let targetAttr ← `(Term.attrInstance| «target»)
- let kindAttr ← `(Term.attrInstance| $kindId:ident)
+ let kindAttr ← `(Term.attrInstance| $attrId:ident)
let attrs := #[targetAttr, kindAttr] ++ expandAttrs attrs?
let pkg ← mkIdentFromRef (packageDeclName.str "name")
let declTy ← mkIdentFromRef delTyName.typeName
let kind := Name.quoteFrom (← getRef) kind
- `(
- $[$doc?]? abbrev $id : $declTy := {
- pkg := $pkg, name := $name, config := $configId
- kind := $kind, kind_eq := rfl
- }
+ `(family_def $id : CustomOut ($pkg, $name) := ConfigTarget $kind
+ $[$doc?]? abbrev $id : $declTy :=
+ Lake.DSL.mkConfigDecl $pkg $name $kind $configId
@[$attrs,*] def configDecl : ConfigDecl := $(id).toConfigDecl
)
@@ -237,7 +245,7 @@ def elabLeanLibCommand : CommandElab := fun stx => do
let `(leanLibCommand|$(doc?)? $(attrs?)? lean_lib%$kw $(nameStx?)? $cfg) := stx
| throwErrorAt stx "ill-formed lean_lib declaration"
withRef kw do
- let cmd ← mkConfigDecl ``LeanLibConfig `lean_lib doc? attrs? nameStx? cfg
+ let cmd ← mkConfigDeclDef ``LeanLibConfig LeanLib.keyword LeanLib.configKind doc? attrs? nameStx? cfg
withMacroExpansion stx cmd <| elabCommand cmd
@[inherit_doc leanLibCommand] abbrev LeanLibCommand := TSyntax ``leanLibCommand
@@ -264,7 +272,7 @@ def elabLeanExeCommand : CommandElab := fun stx => do
let `(leanExeCommand|$(doc?)? $(attrs?)? lean_exe%$kw $(nameStx?)? $cfg) := stx
| throwErrorAt stx "ill-formed lean_exe declaration"
withRef kw do
- let cmd ← mkConfigDecl ``LeanExeConfig `lean_exe doc? attrs? nameStx? cfg
+ let cmd ← mkConfigDeclDef ``LeanExeConfig LeanExe.keyword LeanExe.configKind doc? attrs? nameStx? cfg
withMacroExpansion stx cmd <| elabCommand cmd
@[inherit_doc leanExeCommand] abbrev LeanExeCommand := TSyntax ``leanExeCommand
@@ -278,9 +286,10 @@ instance : Coe LeanExeCommand Command where
abbrev mkExternLibDecl
(pkgName name : Name)
- [FamilyDef CustomData (pkgName, .str name "static") FilePath]
+ [FamilyDef (CustomData pkgName) (.str name "static") FilePath]
+ [FamilyDef (CustomData pkgName) name (ConfigTarget ExternLib.configKind)]
: ExternLibDecl :=
- .mk (.mk pkgName name `extern_lib {getPath := cast (by simp)}) rfl
+ mkConfigDecl pkgName name ExternLib.configKind {getPath := cast (by simp)}
syntax externLibDeclSpec :=
identOrStr (ppSpace simpleBinder)? declValSimple
@@ -316,7 +325,9 @@ def expandExternLibCommand : Macro := fun stx => do
let pkgName := mkIdentFrom kw (packageDeclName.str "name")
let targetId := mkIdentFrom id <| id.getId.modifyBase (· ++ `static)
let name := Name.quoteFrom id id.getId
+ let kind := Name.quoteFrom kw ExternLib.configKind
`(target $targetId:ident $[$pkg?]? : FilePath := $defn $[$wds?:whereDecls]?
+ family_def $id : CustomOut ($pkgName, $name) := ConfigTarget $kind
$[$doc?:docComment]? def $id : ExternLibDecl :=
Lake.DSL.mkExternLibDecl $pkgName $name
@[$attrs,*] def configDecl : ConfigDecl := $(id).toConfigDecl)
diff --git a/src/lake/Lake/Load/Toml.lean b/src/lake/Lake/Load/Toml.lean
index 9f8a4474da..c1a565c76b 100644
--- a/src/lake/Lake/Load/Toml.lean
+++ b/src/lake/Lake/Load/Toml.lean
@@ -219,6 +219,12 @@ instance : DecodeField (PackageConfig n) `versionTags where
-- for `platformIndependent`, `releaseRepo`, `buildArchive`, etc.
instance [DecodeToml α] : DecodeToml (Option α) := ⟨(some <$> decodeToml ·)⟩
+def decodeFacets (kind : Name) (val : Value) : EDecodeM (Array Name) := do
+ return (← val.decodeArray).map (kind ++ ·)
+
+instance : DecodeField (LeanLibConfig n) `defaultFacets where
+ decodeField := decodeFieldCore `defaultFacets (decodeFacets LeanLib.facetKind)
+
/-! ## Dependency Configuration Decoders -/
protected def DependencySrc.decodeToml (t : Table) (ref := Syntax.missing) : EDecodeM DependencySrc := do
@@ -303,15 +309,15 @@ local macro "gen_toml_decoders%" : command => do
gen_toml_decoders%
def decodeTargetDecls
- (p : Name) (t : Table)
-: DecodeM (Array (PConfigDecl p) × DNameMap (NConfigDecl p)) := do
+ (pkg : Name) (t : Table)
+: DecodeM (Array (PConfigDecl pkg) × DNameMap (NConfigDecl pkg)) := do
let r := (#[], {})
- let r ← go r `lean_lib LeanLibConfig.decodeToml
- let r ← go r `lean_exe LeanExeConfig.decodeToml
+ let r ← go r LeanLib.keyword LeanLib.configKind LeanLibConfig.decodeToml
+ let r ← go r LeanExe.keyword LeanExe.configKind LeanExeConfig.decodeToml
return r
where
- go r k (decode : {n : Name} → Table → DecodeM (ConfigType k p n)) := do
- let some tableArrayVal := t.find? k | return r
+ go r kw kind (decode : {n : Name} → Table → DecodeM (ConfigType kind pkg n)) := do
+ let some tableArrayVal := t.find? kw | return r
let some vals ← tryDecode? tableArrayVal.decodeValueArray | return r
vals.foldlM (init := r) fun r val => do
let some t ← tryDecode? val.decodeTable | return r
@@ -320,13 +326,15 @@ where
let (decls, map) := r
if let some orig := map.find? name then
modify fun es => es.push <| .mk val.ref s!"\
- {p}: target '{name}' was already defined as a '{orig.kind}', \
- but then redefined as a '{k}'"
+ {pkg}: target '{name}' was already defined as a '{orig.kind}', \
+ but then redefined as a '{kind}'"
return (decls, map)
else
- let cfg ← @decode name t
- let decl := .mk (.mk p name k cfg) rfl
- return (decls.push decl, map.insert name (.mk decl rfl))
+ let config ← @decode name t
+ let decl : NConfigDecl pkg name :=
+ -- Safety: By definition, config kind = facet kind for declarative configurations.
+ unsafe {pkg, name, kind, config, wf_data := lcProof}
+ return (decls.push decl.toPConfigDecl, map.insert name decl)
/-! ## Root Loader -/
diff --git a/src/lake/Lake/Load/Workspace.lean b/src/lake/Lake/Load/Workspace.lean
index 252e2cb608..4684012a4f 100644
--- a/src/lake/Lake/Load/Workspace.lean
+++ b/src/lake/Lake/Load/Workspace.lean
@@ -5,9 +5,7 @@ Authors: Mac Malone
-/
prelude
import Lake.Load.Resolve
-import Lake.Build.Module
-import Lake.Build.Package
-import Lake.Build.Library
+import Lake.Build.InitFacets
/-! # Workspace Loader
@@ -29,9 +27,7 @@ def loadWorkspaceRoot (config : LoadConfig) : LogIO Workspace := do
root
lakeEnv := config.lakeEnv
lakeArgs? := config.lakeArgs?
- moduleFacetConfigs := initModuleFacetConfigs
- packageFacetConfigs := initPackageFacetConfigs
- libraryFacetConfigs := initLibraryFacetConfigs
+ facetConfigs := initFacetConfigs
}
if let some env := env? then
IO.ofExcept <| ws.addFacetsFromEnv env config.leanOpts
diff --git a/src/lake/Lake/Toml/Encode.lean b/src/lake/Lake/Toml/Encode.lean
index e3e425df43..e874e79f74 100644
--- a/src/lake/Lake/Toml/Encode.lean
+++ b/src/lake/Lake/Toml/Encode.lean
@@ -32,6 +32,7 @@ instance : ToToml Nat := ⟨fun n => .integer .missing (.ofNat n)⟩
instance : ToToml Float := ⟨.float .missing⟩
instance : ToToml Bool := ⟨.boolean .missing⟩
instance [ToToml α] : ToToml (Array α) := ⟨(.array .missing <| ·.map toToml)⟩
+instance : ToToml (Array Value) := ⟨(.array .missing <| ·)⟩
instance : ToToml Table := ⟨.table .missing⟩
/-- Insert a value into a table unless it represents a nullish value. -/
diff --git a/src/lake/Lake/Util/Family.lean b/src/lake/Lake/Util/Family.lean
index f7dc01b6aa..34ac2adbb7 100644
--- a/src/lake/Lake/Util/Family.lean
+++ b/src/lake/Lake/Util/Family.lean
@@ -9,55 +9,61 @@ import Lean.Parser.Command
/-!
# Open Type Families in Lean
-This module contains utilities for defining **open type families** in Lean.
+This module contains utilities for defining **open families** in Lean.
-The concept of type families originated in Haskell with the paper
+The concept of families originated in Haskell with the paper
[*Type checking with open type functions*][1] by Schrijvers *et al.* and
is essentially just a fancy name for a function from an input *index* to an
-output type. However, it tends to imply some additional restrictions on syntax
-or functionality as opposed to a proper type function.The design here has some
-such limitations so the name was similarly adopted.
+output type. However, the concept implies some additional restrictions on
+the syntax and/or functionality versus a proper function. The design here has
+similar limitations, hence the adaption of the name.
-Type families come in two forms: open and closed.
-A *closed* type family is an ordinary total function.
-An *open* type family, on the other hand, is a partial function that allows
+Families come in two forms: open and closed.
+A *closed* family is an ordinary total function.
+An *open* family is a partial function that allows
additional input to output mappings to be defined as needed.
-Lean does not (currently) directly support open type families.
+Lean does not (currently) directly support open families.
However, it does support type class *functional dependencies* (via `outParam`),
-and simple open type families can be modeled through functional dependencies,
+and simple open families can be modeled through functional dependencies,
which is what we do here.
[1]: https://doi.org/10.1145/1411204.1411215
## Defining Families
-In this approach, to define an open type family, one first defines an `opaque`
-type function with a single argument that serves as the key:
+In this approach, to define an open family, one first defines an `opaque`
+function with a single argument that serves as the index:
```lean
-opaque FooFam (key : Name) : Type
+opaque FooFam (idx : Name) : Type
```
-Note that, unlike Haskell, the key need not be a type. Lean's dependent type
-theory does not have Haskell's strict separation of types and data and thus
-we can use data as an index as well.
+Note that, unlike Haskell, the index need not be a type. Lean's dependent type
+theory does not have Haskell's strict separation of types and data, enabling
+this generalization.
-Then, to add a mapping to this family, one defines an axioms:
+Similarly, the output of a family need not be a type. In such a case, though,
+the family must be marked `noncomputable`:
+
+```lean
+noncomputable opaque fooFam (idx : Name) : Name
+```
+
+To add a mapping to a family, one first defines an axiom:
```lean
axiom FooFam.bar : FooFam `bar = Nat
```
-To finish, one also defines an instance of the `FamilyDef` type class
-defined in this module using the axiom like so:
+Then defines an instance of the `FamilyDef` type class using the axiom:
```lean
instance : FamilyDef FooFam `bar Nat := ⟨FooFam.bar⟩
```
-This module provides a `family_def` macro to define both the axiom and the
-instance in one go like so:
+This module also provides a `family_def` macro to define both the axiom
+and the instance in one go:
```lean
family_def bar : FooFam `bar := Nat
@@ -71,12 +77,12 @@ The signature of the type class `FamilyDef` is
FamilyDef {α : Type u} (Fam : α → Type v) (a : α) (β : outParam $ Type v) : Prop
```
-The key part being that `β` is an `outParam` so Lean's type class synthesis will
-smartly infer the defined type `Nat` when given the key of `` `bar``. Thus, if
-we have a function define like so:
+The index part being that `β` is an `outParam` so Lean's type class synthesis
+will smartly infer the defined type `Nat` when given the index of `` `bar``.
+Thus, if we have a function define like so:
```
-def foo (key : α) [FamilyDef FooFam key β] : β := ...
+def foo (idx : α) [FamilyDef FooFam idx β] : β := ...
```
Lean will smartly infer that the type of ``foo `bar`` is `Nat`.
@@ -92,13 +98,13 @@ and `ofFamily : Fam a → β`, to help with this conversion.
Putting this all together, one can do something like the following:
```lean
-opaque FooFam (key : Name) : Type
+opaque FooFam (idx : Name) : Type
abbrev FooMap := DRBMap Name FooFam Name.quickCmp
-def FooMap.insert (self : FooMap) (key : Name) [FamilyDef FooFam key α] (a : α) : FooMap :=
- DRBMap.insert self key (toFamily a)
-def FooMap.find? (self : FooMap) (key : Name) [FamilyDef FooFam key α] : Option α :=
- ofFamily <$> DRBMap.find? self key
+def FooMap.insert (self : FooMap) (idx : Name) [FamilyOut FooFam idx α] (a : α) : FooMap :=
+ DRBMap.insert self idx (toFamily a)
+def FooMap.find? (self : FooMap) (idx : Name) [FamilyOut FooFam idx α] : Option α :=
+ ofFamily <$> DRBMap.find? self idx
family_def bar : FooFam `bar := Nat
family_def baz : FooFam `baz := String
@@ -115,55 +121,59 @@ def foo := Id.run do
In order to maintain type safety, `a = b → Fam a = Fam b` must actually hold.
That is, one must not define mappings to two different types with equivalent
-keys. Since mappings are defined through axioms, Lean WILL NOT catch violations
-of this rule itself, so extra care must be taken when defining mappings.
+indices. Since mappings are defined through axioms, Lean WILL NOT catch
+violations of this rule itself, so extra care must be taken when defining
+mappings.
In Lake, this is solved by having its open type families be indexed by a
`Lean.Name` and defining each mapping using a name literal `name` and the
declaration ``axiom Fam.name : Fam `name = α``. This causes a name clash
-if two keys overlap and thereby produces an error.
+if two indices overlap and thereby produces an error.
-/
-open Lean
-
namespace Lake
/-! ## API -/
/--
-Defines a single mapping of the **open type family** `Fam`, namely `Fam a = β`.
+Defines a single mapping of the **open family** `f`, namely `f a = b`.
See the module documentation of `Lake.Util.Family` for details on what an open
-type family is in Lake.
+family is in Lake.
-/
-class FamilyDef {α : Type u} (Fam : α → Type v) (a : α) (β : semiOutParam $ Type v) : Prop where
- family_key_eq_type : Fam a = β
+class FamilyDef {α : Type u} {β : Type v} (f : α → β) (a : α) (b : semiOutParam β) : Prop where
+ fam_eq : f a = b
-/-- Like `FamilyDef`, but `β` is an `outParam`. -/
-class FamilyOut {α : Type u} (Fam : α → Type v) (a : α) (β : outParam $ Type v) : Prop where
- family_key_eq_type : Fam a = β
+@[deprecated fam_eq (since := "2025-02-22")] abbrev FamilyDef.family_key_eq_type := @FamilyDef.fam_eq
+
+/-- Like `FamilyDef`, but `b` is an `outParam`. -/
+class FamilyOut {α : Type u} {β : Type v} (f : α → β) (a : α) (b : outParam β) : Prop where
+ fam_eq : f a = b
+
+@[deprecated fam_eq (since := "2025-02-22")] abbrev FamilyOut.family_key_eq_type := @FamilyOut.fam_eq
-- Simplifies proofs involving open type families
-attribute [simp] FamilyOut.family_key_eq_type
+attribute [simp] FamilyOut.fam_eq
-instance [FamilyDef Fam a β] : FamilyOut Fam a β where
- family_key_eq_type := FamilyDef.family_key_eq_type
+instance [FamilyDef f a b] : FamilyOut f a b where
+ fam_eq := FamilyDef.fam_eq
/-- The identity relation. -/
-@[default_instance 0] instance : FamilyDef Fam a (Fam a) where
- family_key_eq_type := rfl
+@[default_instance 0] instance (priority := 0) : FamilyDef f a (f a) where
+ fam_eq := rfl
/-- The constant type family. -/
-instance : FamilyDef (fun _ => β) a β where
- family_key_eq_type := rfl
+instance : FamilyDef (fun _ => b) a b where
+ fam_eq := rfl
-/-- Cast a datum from its individual type to its general family. -/
-@[macro_inline] def toFamily [FamilyOut Fam a β] (b : β) : Fam a :=
- cast FamilyOut.family_key_eq_type.symm b
+/-- Cast a datum from its specific type to a general type family. -/
+@[macro_inline] def toFamily [FamilyOut F a β] (b : β) : F a :=
+ cast FamilyOut.fam_eq.symm b
-/-- Cast a datum from its general family to its individual type. -/
-@[macro_inline] def ofFamily [FamilyOut Fam a β] (b : Fam a) : β :=
- cast FamilyOut.family_key_eq_type b
+/-- Cast a datum from a general type family to its specific type. -/
+@[macro_inline] def ofFamily [FamilyOut F a β] (b : F a) : β :=
+ cast FamilyOut.fam_eq b
+open Lean in
/--
The syntax:
@@ -171,17 +181,19 @@ The syntax:
family_def foo : Fam 0 := Nat
```
-Declares a new mapping for the open type family `Fam` type via the
-production of an axiom `Fam.foo : Data 0 = Nat` and an instance of `FamilyDef`
-that uses this axiom for key `0`.
+Declares a new mapping for the open family `Fam` via the production
+of an axiom `Fam.foo : Fam 0 = Nat` and an instance of `FamilyDef`
+that uses this axiom for the index `0`.
-/
-scoped macro (name := familyDef) doc?:optional(Parser.Command.docComment)
-"family_def " id:ident " : " fam:ident key:term " := " ty:term : command => do
+scoped macro (name := familyDef)
+ doc?:optional(Lean.Parser.Command.docComment)
+ "family_def " id:ident " : " fam:ident idx:term " := " val:term
+: command => do
let tid := extractMacroScopes fam.getId |>.name
if let (tid, _) :: _ ← Macro.resolveGlobalName tid then
- let app := Syntax.mkApp fam #[key]
+ let app := Syntax.mkApp fam #[idx]
let axm := mkIdentFrom id (canonical := true) <| `_root_ ++ tid ++ id.getId
- `($[$doc?]? @[simp] axiom $axm : $app = $ty
- instance : FamilyDef $fam $key $ty := ⟨$axm⟩)
+ `($[$doc?]? @[simp] axiom $axm : $app = $val
+ instance : FamilyDef $fam $idx $val := ⟨$axm⟩)
else
Macro.throwErrorAt fam s!"unknown family '{tid}'"
diff --git a/src/lake/Lake/Util/Name.lean b/src/lake/Lake/Util/Name.lean
index 4c4c5e198e..1dbf3c8b82 100644
--- a/src/lake/Lake/Util/Name.lean
+++ b/src/lake/Lake/Util/Name.lean
@@ -52,6 +52,14 @@ instance [FromJson α] : FromJson (NameMap α) where
namespace Name
open Lean.Name
+def eraseHead : Name → Name
+| .anonymous | .str .anonymous _ | .num .anonymous _ => .anonymous
+| .str p s => .str (eraseHead p) s
+| .num p s => .num (eraseHead p) s
+
+theorem eq_anonymous_of_isAnonymous {n : Name} : (h : n.isAnonymous) → n = .anonymous := by
+ cases n <;> simp [Name.isAnonymous]
+
@[simp] protected theorem beq_false (m n : Name) : (m == n) = false ↔ ¬ (m = n) := by
rw [← beq_iff_eq (a := m) (b := n)]; cases m == n <;> simp +decide
@@ -95,5 +103,7 @@ instance : LawfulCmpEq Name Name.quickCmp where
cmp_rfl := quickCmp_rfl
open Syntax in
-def quoteFrom (ref : Syntax) (n : Name) : Term :=
- ⟨copyHeadTailInfoFrom (quote n : Term) ref⟩
+def quoteFrom (ref : Syntax) (n : Name) (canonical := false) : Term :=
+ let ref := ref.setHeadInfo (SourceInfo.fromRef ref canonical)
+ let stx := copyHeadTailInfoFrom (quote n : Term) ref
+ ⟨stx⟩
diff --git a/src/lake/Lake/Util/StoreInsts.lean b/src/lake/Lake/Util/StoreInsts.lean
index 92ccfec75d..402f248125 100644
--- a/src/lake/Lake/Util/StoreInsts.lean
+++ b/src/lake/Lake/Util/StoreInsts.lean
@@ -46,5 +46,5 @@ instance [MonadLiftT (ST ω) m] [Monad m] : MonadStore Name α (StateRefT' ω (N
store k a := modify (·.insert k a)
@[inline] instance [MonadDStore κ β m] [t : FamilyOut β k α] : MonadStore1Of k α m where
- fetch? := cast (by rw [t.family_key_eq_type]) <| fetch? (m := m) k
- store a := store k <| cast t.family_key_eq_type.symm a
+ fetch? := cast (by rw [t.fam_eq]) <| fetch? (m := m) k
+ store a := store k <| cast t.fam_eq.symm a