Skip to content
This repository was archived by the owner on Oct 25, 2023. It is now read-only.

Commit 5b502ec

Browse files
committed
refactor: move recurse arg into the monad stack
1 parent cc23002 commit 5b502ec

File tree

5 files changed

+118
-24
lines changed

5 files changed

+118
-24
lines changed

Diff for: Lake/Build/Info.lean

+9-7
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,7 @@ Authors: Mac Malone
55
-/
66
import Lake.Build.Data
77
import Lake.Config.Module
8+
import Lake.Util.EquipT
89

910
namespace Lake
1011

@@ -29,20 +30,21 @@ def BuildInfo.key : (self : BuildInfo) → BuildKey
2930
| package p f => ⟨p.name, none, f⟩
3031
| target p t f => ⟨p.name, t, f⟩
3132

32-
/-- A build function for a single element of the Lake build index. -/
33+
/-- A build function for any element of the Lake build index. -/
3334
abbrev IndexBuildFn (m : TypeType v) :=
3435
-- `DBuildFn BuildInfo (BuildData ·.key) m` with less imports
3536
(info : BuildInfo) → m (BuildData info.key)
3637

37-
@[inline] def Module.recBuildFacet {m : TypeType v}
38-
(mod : Module) (facet : WfName) [DynamicType ModuleData facet α]
39-
(build : (info : BuildInfo) → m (BuildData info.key)) : m α :=
38+
/-- A transformer to equip a monad with a build function for the Lake index. -/
39+
abbrev IndexT (m : TypeType v) := EquipT (IndexBuildFn m) m
40+
41+
@[inline] def Module.recBuildFacet (mod : Module) (facet : WfName)
42+
[DynamicType ModuleData facet α] : IndexT m α := fun build =>
4043
let to_data := by unfold BuildData, BuildInfo.key; simp [eq_dynamic_type]
4144
cast to_data <| build <| BuildInfo.module mod facet
4245

43-
@[inline] def Package.recBuildFacet {m : TypeType v}
44-
(pkg : Package) (facet : WfName) [DynamicType PackageData facet α]
45-
(build : (info : BuildInfo) → m (BuildData info.key)) : m α :=
46+
@[inline] def Package.recBuildFacet (pkg : Package) (facet : WfName)
47+
[DynamicType PackageData facet α] : IndexT m α := fun build =>
4648
let to_data := by unfold BuildData, BuildInfo.key; simp [eq_dynamic_type]
4749
cast to_data <| build <| BuildInfo.package pkg facet
4850

Diff for: Lake/Build/Module1.lean

+15-15
Original file line numberDiff line numberDiff line change
@@ -59,11 +59,11 @@ section
5959
variable [Monad m] [MonadLiftT BuildM m] [MonadBuildStore m]
6060

6161
/-- Build the dynlibs of the imports that want precompilation. -/
62-
def recBuildPrecompileDynlibs (imports : Array Module)
63-
(recurse : IndexBuildFn m) : m (Array ActiveFileTarget) := do
62+
@[specialize] def recBuildPrecompileDynlibs (imports : Array Module)
63+
: IndexT m (Array ActiveFileTarget) := do
6464
imports.filterMapM fun imp => do
6565
if imp.shouldPrecompile then
66-
return some <| ← imp.recBuildFacet &`lean.dynlib recurse
66+
return some <| ← imp.recBuildFacet &`lean.dynlib
6767
else
6868
return none
6969

@@ -72,19 +72,19 @@ Recursively build a module and its (transitive, local) imports,
7272
optionally outputting a `.c` file as well if `c` is set to `true`.
7373
-/
7474
@[specialize] def Module.recBuildLean (mod : Module) (c : Bool)
75-
(recurse : IndexBuildFn m) : m ActiveOpaqueTarget := do
75+
: IndexT m ActiveOpaqueTarget := do
7676
have : MonadLift BuildM m := ⟨liftM⟩
77-
let extraDepTarget ← mod.pkg.recBuildFacet &`extraDep recurse
78-
let (imports, transImports) ← mod.recBuildFacet &`lean.imports recurse
77+
let extraDepTarget ← mod.pkg.recBuildFacet &`extraDep
78+
let (imports, transImports) ← mod.recBuildFacet &`lean.imports
7979
let dynlibsTarget ← ActiveTarget.collectArray
80-
<| ← recBuildPrecompileDynlibs transImports recurse
80+
<| ← recBuildPrecompileDynlibs transImports
8181
let importTarget ←
8282
if c then
8383
ActiveTarget.collectOpaqueArray
84-
<| ← imports.mapM (·.recBuildFacet &`lean.c recurse)
84+
<| ← imports.mapM (·.recBuildFacet &`lean.c)
8585
else
8686
ActiveTarget.collectOpaqueArray
87-
<| ← imports.mapM (·.recBuildFacet &`lean recurse)
87+
<| ← imports.mapM (·.recBuildFacet &`lean)
8888
let depTarget := Target.active <| ← extraDepTarget.mixOpaqueAsync
8989
<| ← dynlibsTarget.mixOpaqueAsync importTarget
9090
let modTarget ← mod.soloTarget dynlibsTarget.info depTarget c |>.activate
@@ -103,7 +103,7 @@ Recursively parse the Lean files of a module and its imports
103103
building an `Array` product of its direct and transitive local imports.
104104
-/
105105
@[specialize] def Module.recParseImports (mod : Module)
106-
(recurse : IndexBuildFn m) : m (Array Module × Array Module) := do
106+
: IndexT m (Array Module × Array Module) := do
107107
have : MonadLift BuildM m := ⟨liftM⟩
108108
let contents ← IO.FS.readFile mod.leanFile
109109
let (imports, _, _) ← Elab.parseImports contents mod.leanFile.toString
@@ -112,7 +112,7 @@ building an `Array` product of its direct and transitive local imports.
112112
let mut imports := #[]
113113
let mut transImports := ModuleSet.empty
114114
for imp in importSet do
115-
let (_, impTransImports) ← imp.recBuildFacet &`lean.imports recurse
115+
let (_, impTransImports) ← imp.recBuildFacet &`lean.imports
116116
for imp in impTransImports do
117117
transImports := transImports.insert imp
118118
transImports := transImports.insert imp
@@ -123,11 +123,11 @@ building an `Array` product of its direct and transitive local imports.
123123
Recursively build the shared library of a module (e.g., for `--load-dynlib`).
124124
-/
125125
@[specialize] def Module.recBuildDynLib (mod : Module)
126-
(recurse : IndexBuildFn m) : m ActiveFileTarget := do
126+
: IndexT m ActiveFileTarget := do
127127
have : MonadLift BuildM m := ⟨liftM⟩
128-
let oTarget ← mod.recBuildFacet &`lean.o recurse
129-
let (_, transImports) ← mod.recBuildFacet &`lean.imports recurse
130-
let dynlibTargets ← recBuildPrecompileDynlibs transImports recurse
128+
let oTarget ← mod.recBuildFacet &`lean.o
129+
let (_, transImports) ← mod.recBuildFacet &`lean.imports
130+
let dynlibTargets ← recBuildPrecompileDynlibs transImports
131131
-- TODO: Link in external libraries
132132
-- let externLibTargets ← mod.pkg.externLibTargets.mapM (·.activate)
133133
-- let linkTargets := #[oTarget] ++ sharedLibTargets ++ externLibTargets |>.map Target.active

Diff for: Lake/Build/Store.lean

-1
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE.
44
Authors: Mac Malone
55
-/
66
import Lake.Build.Data
7-
import Lake.Build.Topological
87
import Lake.Util.StoreInsts
98

109
/-!

Diff for: Lake/Build/Topological.lean

+2-1
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
44
Authors: Mac Malone
55
-/
66
import Lake.Util.Store
7+
import Lake.Util.EquipT
78

89
/-!
910
# Topological / Suspending Recursive Builder
@@ -26,7 +27,7 @@ abbrev DBuildFn.{u,v,w} (ι : Type u) (β : ι → Type v) (m : Type v → Type
2627

2728
/-- A dependently typed recursive object builder. -/
2829
abbrev DRecBuildFn.{u,v,w} (ι : Type u) (β : ι → Type v) (m : Type v → Type w) :=
29-
(i : ι) → DBuildFn ι β m m (β i)
30+
(i : ι) → EquipT (DBuildFn ι β m) m (β i)
3031

3132
/-- A recursive object builder. -/
3233
abbrev RecBuildFn ι α m := DRecBuildFn ι (fun _ => α) m

Diff for: Lake/Util/EquipT.lean

+92
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,92 @@
1+
/-
2+
Copyright (c) 2022 Mac Malone. All rights reserved.
3+
Released under Apache 2.0 license as described in the file LICENSE.
4+
Authors: Mac Malone
5+
-/
6+
namespace Lake
7+
8+
/--
9+
A monad transformer that equips a monad with a value.
10+
This is a generalization of `ReaderT` where the value is not
11+
necessarily directly readable through the monad.
12+
-/
13+
def EquipT (ρ : Type u) (m : Type v → Type w) (α : Type v) :=
14+
ρ → m α
15+
16+
variable {ρ : Type u} {m : Type v → Type w}
17+
18+
instance {α : Type v} [Inhabited (m α)] : Inhabited (EquipT ρ m α) where
19+
default := fun _ => default
20+
21+
namespace EquipT
22+
23+
@[inline] protected
24+
def run {α : Type v} (self : EquipT ρ m α) (r : ρ) : m α :=
25+
self r
26+
27+
@[inline] protected
28+
def map [Functor m] {α β : Type v} (f : α → β) (self : EquipT ρ m α) : EquipT ρ m β :=
29+
fun fetch => Functor.map f (self fetch)
30+
31+
instance [Functor m] : Functor (EquipT ρ m) where
32+
map := EquipT.map
33+
34+
@[inline] protected
35+
def pure [Pure m] {α : Type v} (a : α) : EquipT ρ m α :=
36+
fun _ => pure a
37+
38+
instance [Pure m] : Pure (EquipT ρ m) where
39+
pure := EquipT.pure
40+
41+
@[inline] protected
42+
def compose {α₁ α₂ β : Type v} (f : m α₁ → (Unit → m α₂) → m β) (x₁ : EquipT ρ m α₁) (x₂ : Unit → EquipT ρ m α₂) : EquipT ρ m β :=
43+
fun fetch => f (x₁ fetch) (fun _ => x₂ () fetch)
44+
45+
@[inline] protected
46+
def seq [Seq m] {α β : Type v} : EquipT ρ m (α → β) → (Unit → EquipT ρ m α) → EquipT ρ m β :=
47+
EquipT.compose Seq.seq
48+
49+
instance [Seq m] : Seq (EquipT ρ m) where
50+
seq := EquipT.seq
51+
52+
instance [Applicative m] : Applicative (EquipT ρ m) := {}
53+
54+
@[inline] protected
55+
def bind [Bind m] {α β : Type v} (self : EquipT ρ m α) (f : α → EquipT ρ m β) : EquipT ρ m β :=
56+
fun fetch => bind (self fetch) fun a => f a fetch
57+
58+
instance [Bind m] : Bind (EquipT ρ m) where
59+
bind := EquipT.bind
60+
61+
instance [Monad m] : Monad (EquipT ρ m) := {}
62+
63+
@[inline] protected
64+
def lift {α : Type v} (t : m α) : EquipT ρ m α :=
65+
fun _ => t
66+
67+
instance : MonadLift m (EquipT ρ m) where
68+
monadLift := EquipT.lift
69+
70+
@[inline] protected
71+
def failure [Alternative m] {α : Type v} : EquipT ρ m α :=
72+
fun _ => failure
73+
74+
@[inline] protected
75+
def orElse [Alternative m] {α : Type v} : EquipT ρ m α → (Unit → EquipT ρ m α) → EquipT ρ m α :=
76+
EquipT.compose Alternative.orElse
77+
78+
instance [Alternative m] : Alternative (EquipT ρ m) where
79+
failure := EquipT.failure
80+
orElse := EquipT.orElse
81+
82+
@[inline] protected
83+
def throw {ε : Type v} [MonadExceptOf ε m] {α : Type v} (e : ε) : EquipT ρ m α :=
84+
fun _ => throw e
85+
86+
@[inline] protected
87+
def tryCatch {ε : Type v} [MonadExceptOf ε m] {α : Type v} (self : EquipT ρ m α) (c : ε → EquipT ρ m α) : EquipT ρ m α :=
88+
fun f => tryCatchThe ε (self f) fun e => (c e) f
89+
90+
instance (ε) [MonadExceptOf ε m] : MonadExceptOf ε (EquipT ρ m) where
91+
throw := EquipT.throw
92+
tryCatch := EquipT.tryCatch

0 commit comments

Comments
 (0)