├── BSalC.rs
└── Readme.md


/BSalC.rs:
--------------------------------------------------------------------------------
  1 | // Disclaimers and warnings
  2 | // ========================
  3 | // Obviously, this file is no substitute for the paper itself:
  4 | // https://www.microsoft.com/en-us/research/uploads/prod/2018/03/build-systems.pdf
  5 | // There is also an awesome talk (as always :D) by SPJ on YouTube:
  6 | // https://www.youtube.com/watch?v=BQVT6wiwCxM
  7 | //
  8 | // Unlike the code in the paper, the code given below
  9 | // (a) Doesn't compile.
 10 | // (b) May never compile (ignoring syntax) without substantial changes
 11 | //     to the Rust type system.[FN1]
 12 | //
 13 | // Stuff marked with {Comment} is additional commentary provided by me.
 14 | // It is primarily written for stuff that may seem weird for non-Haskell folks.
 15 | // Don't worry though, there is no monad tutorial here. :)
 16 | //
 17 | // If you have trouble understanding something and/or concrete suggestions to
 18 | // improve the translation, please open an issue on the GitHub issue tracker!
 19 | //
 20 | // [FN1]: I'm not complaining here, please do not misinterpret it as such.
 21 | //
 22 | // For Haskellers:
 23 | // ---------------
 24 | // This translation is not term to term, and the types don't make sense
 25 | // sometimes (e.g. <$>, <*>, >>= and lifts are elided in places); don't kill me.
 26 | // I've tried to do my best here. Also, you're surely better off reading the
 27 | // paper directly; all the extra brackets here may make your head hurt.
 28 | //
 29 | // For Rustaceans:
 30 | // ---------------
 31 | // If you complain about not following Rust's casing/formatting conventions,
 32 | // I will almost surely send you a glitter bomb. I'm following Haskell
 33 | // conventions so there's less conflict when reading the two side-by-side.
 34 | //
 35 | // Differences from ordinary Rust
 36 | // ==============================
 37 | // 1. To reduce visual noise, fully uppercase identifiers are uniformly treated
 38 | //    as generic parameters (they are not introduced into scope explicitly unless
 39 | //    they have trait constraints).
 40 | //
 41 | //    e.g. fn foo<T, SU>(t: T) -> SU is shortened to fn foo(t: T) -> SU
 42 | //
 43 | // 2. I'm using JS-style lambda syntax (everywhere) + explicit returns (randomly).
 44 | //    e.g. (foo, bar) => { baz(foo); return qux(foo, bar); }
 45 | //
 46 | //    Such a function will have type Fn(Foo, Bar) -> Qux
 47 | //
 48 | // 3. Type parameters are curried Foo<T, S> = Foo<T><S>.
 49 | //    e.g. we can say that List (not List<T>) is a "mappable container".
 50 | 
 51 | 
 52 | // Before we begin, let's pause for a haiku -
 53 | //
 54 | // In this world
 55 | // We walk on the roof of hell
 56 | // Gazing at flowers
 57 | //
 58 | // - Kobayashi Issa
 59 | //
 60 | //------------------------------------------------------------------------------
 61 | 
 62 | // Fig 5. Code on 79:5
 63 | // "release.tar" %> \_ -> do
 64 | //     need ["release.txt"]
 65 | //     files <- lines <$> readFile "release.txt"
 66 | //     need files
 67 | //     system "tar" $ ["-cf", "release.tar"] ++ files
 68 | 
 69 | buildRuleFor(
 70 |     "release.tar",
 71 |     // The argument to the lambda is ignored (using JS-style lambda syntax).
 72 |     _ => {
 73 |         need(["release.txt"]);
 74 |         let files: List<String> = readFile("release.txt").splitLines();
 75 |         need(files);
 76 |         return system("tar", ["-cf", "release.tar"] + files);
 77 |     });
 78 | 
 79 | // Fig 5. Code on 79:7
 80 | // data Store i k v -- i = info, k = key, v = value
 81 | // initialise :: i -> (k -> v) -> Store i k v
 82 | // getInfo :: Store i k v -> i
 83 | // putInfo :: i -> Store i k v -> Store i k v
 84 | // getValue :: k -> Store i k v -> v
 85 | // putValue :: Eq k => k -> v -> Store i k v -> Store i k v
 86 | 
 87 | // I = Info, K = Key, V = Value
 88 | struct Store<I, K, V>; // Definition not provided.
 89 | 
 90 | fn initialize(info: I, mapping: Fn(K) -> V) -> Store<I, K, V>;
 91 | fn getInfo(mystore: Store<I, K, V>) -> I;
 92 | // Returns an updated store because values are immutable.
 93 | fn putInfo(newinfo: I, mystore: Store<I, K, V>) -> Store<I, K, V>;
 94 | fn getValue(searchKey: K, mystore: Store<I, K, V>) -> V;
 95 | fn putValue<K: Eq>(saveKey: K, saveVal: V, mystore: Store<I, K, V>) -> Store<I, K, V>;
 96 | 
 97 | // Fig 5. Code on 79:7 (contd.)
 98 | //
 99 | // data Hash v -- a compact summary of a value with a fast equality check
100 | // hash :: Hashable v => v -> Hash v
101 | // getHash :: Hashable v => k -> Store i k v -> Hash v
102 | 
103 | struct Hash<V>; // Definition not provided.
104 | fn hash<V: Hashable>(val: V) -> Hash<V>;
105 | fn getHash<V: Hashable>(searchKey: K, mystore: Store<I, K, V>) -> Hash<V>
106 | 
107 | // Fig 5. Code on 79:7 (contd.)
108 | //
109 | // -- Build tasks (see Section 3.2)
110 | // newtype Task c k v = Task { run :: forall f .  c f => (k -> f v) -> f v }
111 | // type Tasks c k v = k -> Maybe ( Task c k v)
112 | //
113 | // --------
114 | // {Comment} (Rust actually uses just "for" but I think "forall" is clearer.)
115 | //
116 | // C = Constraint, (and K = Key, V = Value as earlier)
117 | //
118 | // The parameter C should be thought of as some trait constraint describing what
119 | // kind of build system we're interested in.
120 | //
121 | // Since `run` works for all choices of F, we can pick F (by supplying the
122 | // argument to `run` which has type Fn(K) -> F<V>) depending on what kind
123 | // of build output we want. For example, there are choices for F which can:
124 | // 1. Be used to just list dependencies (no actual build).
125 | // 2. Be used to actually build things (doing IO).
126 | //
127 | // See Section 3.2-3.4 in the paper for more details on C and F.
128 | struct Task<C, K, V> {
129 |     run: forall<F> Fn<F: C>(Fn(K) -> F<V>) -> F<V>,
130 | };
131 | 
132 | // Input keys are associated with None (because there is nothing to build,
133 | // the thing is given as input), and non-input keys (for things that need to be
134 | // computed based off input keys) are associated with Some(task).
135 | // (Section 3.2)
136 | type Tasks<C, K, V> = Fn(K) -> Option<Task<C, K, V>>;
137 | 
138 | // Fig 5. Code on 79:7 (contd.)
139 | //
140 | // -- Build system (see Section 3.3)
141 | // type Build c i k v = Tasks c k v -> k -> Store i k v -> Store i k v
142 | // -- Build system components: a scheduler and a rebuilder (see Section 5)
143 | // type Scheduler c i ir k v = Rebuilder c ir k v -> Build c i k v
144 | // type Rebuilder c   ir k v = k -> v -> Task c k v -> Task (MonadState ir) k v
145 | 
146 | type Build<C, I, K, V> = Fn(Tasks<C, K, V>, K, Store<I, K, V>) -> Store<I, K, V>;
147 | 
148 | type Scheduler<C, I, IR, K, V> = Fn(Rebuilder<C, IR, K, V>) -> Build<C, I, K, V>;
149 | type Rebuilder<C,    IR, K, V> = Fn(K, V, Task<C, K, V>) -> Task<MonadState<IR>, K, V>;
150 | 
151 | // {Comment} MonadState is explained a bit later in this document.
152 | 
153 | // Fig 6. Code from 79:8
154 | //-- Applicative functors
155 | // pure :: Applicative f => a -> f a
156 | // (<$>) :: Functor f => (a -> b) -> f a -> f b -- Left-associative
157 | // (<*>) :: Applicative f => f (a -> b) -> f a -> f b -- Left-associative
158 | 
159 | trait Functor<F> {
160 |     // Named version of (<$>)
161 |     fn map(f: Fn(A) -> B, val: F<A>) -> F<B>;
162 | }
163 | trait Applicative<F> {
164 |     fn pure(val: A) -> F<A>;
165 |     // Notice that the function (first argument) is "inside F" here, unlike map.
166 |     // Named version of (<*>)
167 |     fn apply(f: F<Fn(A) -> B>, val: F<A>) -> F<B>;
168 | }
169 | 
170 | // Fig 6. Code from 79:8 (contd.)
171 | //
172 | // -- Standard State monad from Control.Monad.State
173 | // data State s a
174 | // instance Monad (State s)
175 | // get :: State s s
176 | // gets :: (s -> a) -> State s a
177 | // put :: s -> State s ()
178 | // modify :: (s -> s) -> State s ()
179 | // runState :: State s a -> s -> (a, s)
180 | // execState :: State s a -> s -> s
181 | 
182 | // {Comment} May be loosely thought of as a pair of values, one of type S ("mutable"
183 | // state) and another of type A (type of whatever value is captured).
184 | // You might be wondering why we have all these small functions to do simple
185 | // things instead of "just" working with a tuple. Well, the answer is that the
186 | // State is _not_ actually a pair (otherwise, runState and execState wouldn't make
187 | // much sense), but a function of type Fn(S) -> (S, A).
188 | struct State<S, A>; // Definition skipped.
189 | fn get() -> State<S, S>;
190 | fn gets(f: Fn(S) -> A) -> State<S, A>;
191 | fn put(astate: S) -> State<S, ()>;
192 | fn modify(statechange: Fn(S) -> S) -> State<S, ()>;
193 | fn  runState(val: State<S, A>, startState: S) -> (A, S);
194 | fn execState(val: State<S, A>, startState: S) ->     S;
195 | 
196 | // -- Standard types from Data.Functor.Identity and Data.Functor.Const
197 | // newtype Identity a = Identity { runIdentity :: a }
198 | // newtype Const m a = Const { getConst :: m }
199 | // instance Functor (Const m) where
200 | //    fmap _ (Const m) = Const m
201 | // instance Monoid m => Applicative (Const m) where
202 | //   pure _ = Const mempty
203 | // -- mempty is the identity of the monoid m
204 | // Const x <*> Const y = Const (x <> y) -- <> is the binary operation of the monoid m
205 | 
206 | // {Comment} This one may seem weird but it is needed as can't make a Functor out of
207 | // "nothing". Whereas now that we have a singleton container, Identity can
208 | // implement the Functor/Applicative/Monad traits (definitions elided).
209 | struct Identity<A> { runIdentity: A }
210 | 
211 | struct Const<M, A> { getConst: M }
212 | // This means that we can "map over" the A type parameter because Const<M, A> = Const<M><A>.
213 | impl Functor<Const<M>> {
214 |     // The function is ignored, we don't have anything to apply it to.
215 |     fn map(_: Fn(A) -> B, val: Const<M><A>) -> Const<M><B> {
216 |         return Const { getConst: val.getConst };
217 |     }
218 | }
219 | impl Applicative<Const<M: Monoid>> {
220 |     fn pure(_: A) -> Const<M, A> {
221 |         return Const { getConst: M::MONOID_ZERO };
222 |     }
223 |     fn apply(f: Const<M, Fn(A) -> B>, val: Const<M, A>) -> Const<M, B> {
224 |         return Const { getConst: M::monoid_combine(f.getConst, val.getConst) };
225 |     }
226 | }
227 | 
228 | // Repeated definitions from earlier.
229 | 
230 | struct Task<C, K, V> {
231 |     run: forall<F> Fn<F: C>(Fn(K) -> F<V>) -> F<V>,
232 | };
233 | type Tasks<C, K, V> = Fn(K) -> Option<Task<C, K, V>>;
234 | 
235 | // Spreadsheet example
236 | //  A1: 10  B1: A1 + A2
237 | //  A2: 20  B2: B1 * 2
238 | // sprsh1 :: Tasks Applicative String Integer
239 | // sprsh1 "B1" = Just $ Task $ \fetch -> ((+) <$> fetch "A1" <*> fetch "A2")
240 | // sprsh1 "B2" = Just $ Task $ \fetch -> ((*2) <$> fetch "B1")
241 | // sprsh1 _    = Nothing
242 | let spreadsheet1: Tasks<Applicative, String, Integer> =
243 |     cellname => {
244 |         match cellname {
245 |             "B1" => Some(Task { run: fetch => fetch("A1") + fetch("A2") }),
246 |             "B2" => Some(Task { run: fetch => fetch("B1") * 2 }),
247 |             _    => None,
248 |         }
249 |     };
250 | 
251 | // Code on 79:9
252 | type Build<C, I, K, V> = Fn(Tasks<C, K, V>, K, Store<I, K, V>) -> Store<I, K, V>;
253 | 
254 | // Code on 79:9 (contd.)
255 | //
256 | // From the paper -
257 | // The busy build system defines the callback `fetch` so that, when given a key,
258 | // it brings the key up to date in the store, and returns its value. The
259 | // function fetch runs in the standard Haskell State monad - see Fig. 6 -
260 | // initialised with the incoming store by execState. To bring a key up to date,
261 | // `fetch` asks the task description tasks how to compute the value of k.
262 | // If tasks returns Nothing the key is an input, so `fetch` simply reads the
263 | // result from the store. Otherwise `fetch` runs the obtained task to produce
264 | // a resulting value v, records the new key/value mapping in the store, and
265 | // returns v. Notice that `fetch` passes itself to task as an argument,
266 | // so that the latter can use fetch to recursively find the values of k’s
267 | // dependencies.
268 | //
269 | // busy :: Eq k => Build Applicative () k v
270 | // busy tasks key store = execState (fetch key) store
271 | //   where
272 | //     fetch :: k -> State (Store () k v) v
273 | //     fetch k = case tasks k of
274 | //       Nothing -> gets (getValue k)
275 | //       Just task -> do v <- run task fetch; modify (putValue k v); return v
276 | let busy: Build<Applicative, (), K: Eq, V> =
277 |     (tasks, key, store) => {
278 |         let fetch: Fn(K) -> State<Store<(), K, V>, V> =
279 |             k => match tasks(k) {
280 |                 None => {
281 |                     let valGetter: Fn(Store<(), K, V>) -> V =
282 |                         store => getValue(k, store);
283 |                     return gets(valGetter);
284 |                 },
285 |                 Some(task) => {
286 |                     let v: V = task.run(fetch); // <-- Recursive call
287 |                     modify(store => putValue(k, v, store));
288 |                     return v;
289 |                 }
290 |             };
291 |         return execState(fetch(key), store);
292 |     }
293 | // Spreadsheet example (same as earlier)
294 | //  A1: 10  B1: A1 + A2
295 | //  A2: 20  B2: B1 * 2
296 | //
297 | // REPL output on 79:9
298 | // λ> store = initialise () (\key -> if key == "A1" then 10 else 20)
299 | // λ> result = busy sprsh1 "B2" store
300 | // λ> getValue "B1" result
301 | // 30
302 | // λ> getValue "B2" result
303 | // 60
304 | //
305 | >>> store = initialise((), key => if key == "A1" then 10 else 20)
306 | >>> result = busy(spreadsheet1, "B2", store)
307 | >>> getValue("B1", result)
308 | 30
309 | >>> getValue("B2", result)
310 | 60
311 | 
312 | // Spreadsheet example (new)
313 | //
314 | // A1: 10   B1: IF(C1=1,B2,A2)   C1:1
315 | // A2: 20   B2: IF(C1=1,A1,B1)
316 | //
317 | // Code on 79:10
318 | // sprsh2 :: Tasks Monad String Integer
319 | // sprsh2 "B1" = Just $ Task $ \fetch -> do
320 | //     c1 <- fetch "C1"
321 | //     if c1 == 1 then fetch "B2" else fetch "A2"
322 | // sprsh2 "B2" = Just $ Task $ \fetch -> do
323 | //     c2 <- fetch "C1"
324 | //     if c1 == 1 then fetch "A1" else fetch "B1"
325 | // sprsh2 _ = Nothing
326 | let spreadsheet2: Tasks<Monad, String, Integer> =
327 |     cellname => match cellname {
328 |         "B1" => Some(Task {
329 |             run: fetch => {
330 |                 let c1 = fetch("C1");
331 |                 if c1 == 1 { return fetch("B2"); } else { return fetch("A2"); }
332 |             }
333 |         }),
334 |         "B2" => Some(Task {
335 |             run: fetch => {
336 |                 let c1 = fetch("C2");
337 |                 if c1 == 1 { return fetch("A1"); } else { return fetch("B1"); }
338 |             }
339 |         }),
340 |         _ => Nothing
341 |     };
342 | 
343 | // Code on 79:11
344 | // compute :: Task Monad k v -> Store i k v -> v
345 | // compute task store = runIdentity $ run task (\k -> Identity (getValue k store))
346 | fn compute(task: Task<Monad, K, V>, store: Store<I, K, V>) -> V {
347 |     // Recall task is a struct with a single field "run".
348 |     // Identity is a struct with a single field "runIdentity".
349 |     return task.run(k => Identity { runIdentity: getValue(k, store) }).runIdentity;
350 | }
351 | 
352 | // Code on 79:11
353 | //
354 | // Definition 3.1 (Correctness)
355 | //
356 | // build :: Build c i k v
357 | // tasks :: Tasks c k v
358 | // key :: k
359 | // store, result :: Store i k v
360 | // result = build tasks key store
361 | //
362 | // The build result is correct if the following two conditions hold:
363 | // • result and store agree on inputs, that is, for all input keys k ∈ I :
364 | //     getValue k result == getValue k store.
365 | //   In other words, no inputs were corrupted during the build.
366 | // • The result is consistent with the tasks, i.e. for all non-input keys k ∈ O, the result of
367 | //   recomputing the corresponding task matches the value stored in the result:
368 | //     getValue k result == compute task result.
369 | 
370 | let build: Build<C, I, K, V>;
371 | let tasks: Tasks<C, K, V>;
372 | let key: K;
373 | let store: Store<I, K, V>;
374 | let result: Store<I, K, V> = build(tasks, key, store);
375 | 
376 |       getValue(k, result) == getValue(k, store)
377 |       getValue(k, result) == compute(task, result)
378 | 
379 | // Code on 79:12
380 | //
381 | // dependencies :: Task Applicative k v -> [k]
382 | // dependencies task = getConst $ run task (\k -> Const [k])
383 | //
384 | // λ> dependencies $ fromJust $ sprsh1 "B1"
385 | // ["A1","A2"]
386 | // λ> dependencies $ fromJust $ sprsh1 "B2"
387 | // ["B1"]
388 | fn dependencies(task: Task<Applicative, K, V>) -> List<K> {
389 |     return task.run(k => Const { getConst: list![k] }).getConst;
390 | }
391 | // {Comment} unwrap() asserts that the value matches Some(x) and extracts x
392 | >>> dependencies(spreadsheet1("B1").unwrap())
393 | ["A1", "A2"]
394 | >>> dependencies(spreadsheet1("B2").unwrap())
395 | ["B1"]
396 | 
397 | // Code on 79:12
398 | // import Control.Monad.Writer
399 | // track :: Monad m => Task Monad k v -> (k -> m v) -> m (v, [(k, v)])
400 | // track task fetch = runWriterT $ run task trackingFetch
401 | //   where
402 | //     trackingFetch :: k -> WriterT [(k, v)] m v
403 | //     trackingFetch k = do v <- lift (fetch k); tell [(k, v)]; return v
404 | //
405 | use control::monad::writer::*;
406 | fn track<M: Monad>(task: Task<Monad, K, V>, fetch: Fn(K) -> M<V>) -> M<(V, List<(K, V)>)> {
407 |     // {Comment} "Writer" may be thought of as a logging mechanism, where "tell" records
408 |     // something in the log.
409 |     let trackingFetch: Fn(K) -> WriterT<List<(K, V)>, M, V> =
410 |         k => {
411 |             let v = fetch(k);
412 |             tell(list![(k, v)]);
413 |             return v;
414 |         };
415 |     let taskoutput: WriterT<List<(K, V)> M, V> = task.run(trackingFetch);
416 |     // {Comment} WriterT is a struct with a single field called runWriterT.
417 |     return taskoutput.runWriterT;
418 | }
419 | 
420 | // REPL output on 79:13
421 | // λ> fetchIO k = do putStr (k ++ ": "); read <$> getLine
422 | // λ> track (fromJust $ sprsh2 "B1") fetchIO
423 | // C1: 1
424 | // B2: 10
425 | // (10,[("C1",1),("B2",10)])
426 | // λ> track (fromJust $ sprsh2 "B1") fetchIO
427 | // C1: 2
428 | // A2: 20
429 | // (20,[("C1",2),("A2",20)])
430 | >>> let fetchIO = (k => {print(k + ": "); return readLine();});
431 | >>> track(spreadsheet2("B1").unwrap(), fetchIO)
432 | C1: 1
433 | B2: 10
434 | (10,[("C1",1),("B2",10)])
435 | >>> track(spreadsheet2("B2").unwrap(), fetchIO)
436 | C1: 2
437 | A2: 20
438 | (20,[("C1",2),("A2",20)])
439 | 
440 | // Code on 79:14
441 | //
442 | // recordVT :: k -> Hash v -> [(k, Hash v)] -> VT k v -> VT k v
443 | // verifyVT :: (Monad m, Eq k, Eq v) => k -> Hash v -> (k -> m (Hash v)) -> VT k v -> m Bool
444 | //
445 | // {Comment} Maybe the type signatures have been written all in 1 line due
446 | // to space restrictions in the paper; people usually don't format long
447 | // signatures like this.
448 | fn recordVT(key: K, hash: Hash<V>, trace: List<(K, Hash<V>)>, store: VT<K, V>)
449 |             -> VT<K, V>;
450 | 
451 | fn verifyVT(key: K, hash: Hash<V>, fetch: Fn(K) -> M<V>) -> M<Bool>
452 |   where M: Monad, K: Eq, V: Eq;
453 | 
454 | // Code on 79:15
455 | //
456 | // recordCT :: k -> v -> [(k, Hash v)] -> CT k v -> CT k v
457 | // constructCT :: (Monad m, Eq k, Eq v) => k -> (k -> m (Hash v)) -> CT k v -> m [v]
458 | 
459 | fn recordCT(key: K, val: V, trace: List<(K, Hash<V>)>, store: CT<K, V>) -> CT<K, V>;
460 | 
461 | fn constructCT(key: K, fetch_hash: Fn(K) -> M<Hash<V>>, store: CT<K, V>) -> M<List<V>>
462 |     where M: Monad, K: Eq, V: Eq;
463 | 
464 | // Code on 79:15
465 | //
466 | // data Trace k v r = Trace { key :: k, depends :: [(k, Hash v)], result :: r }
467 | //
468 | struct Trace<K, V, R> {
469 |     key: K,
470 |     depends: List<(K, Hash<V>)>,
471 |     result: R,
472 | }
473 | 
474 | // Code on 79:16
475 | // type Scheduler c i ir k v = Rebuilder c ir k v -> Build c i k v
476 | // type Rebuilder c   ir k v = k -> v -> Task c k v -> Task (MonadState ir) k v
477 | //
478 | // Repeated from earlier
479 | 
480 | type Scheduler<C, I, IR, K, V> = Fn(Rebuilder<C, IR, K, V>) -> Build<C, I, K, V>;
481 | type Rebuilder<C,    IR, K, V> = Fn(K, V, Task<C, K, V>) -> Task<MonadState<IR>, K, V>;
482 | 
483 | // Fig 7. Code on 79:17
484 | //
485 | // -- Make build system; stores current time and file modification times
486 | // type Time = Integer
487 | // type MakeInfo k = (Time, Map k Time)
488 | //
489 | // make :: Ord k => Build Applicative (MakeInfo k) k v
490 | // make = topological modTimeRebuilder
491 | //
492 | // -- A task rebuilder based on file modification times
493 | // modTimeRebuilder :: Ord k => Rebuilder Applicative (MakeInfo k) k v
494 | // modTimeRebuilder key value task = Task $ \fetch -> do
495 | //   (now, modTimes) <- get
496 | //   let dirty = case Map.lookup key modTimes of
497 | //           Nothing -> True
498 | //           time -> any (\d -> Map.lookup d modTimes > time) (dependencies task)
499 | //   if not dirty then return value else do
500 | //     put (now + 1, Map.insert key now modTimes)
501 | //     run task fetch
502 | 
503 | type Time = Integer;
504 | type MakeInfo<K> = (Time, Map<K, Time>);
505 | 
506 | let make: Build<Applicative, MakeInfo<K>, K: Ord, V> =
507 |     (tasks, key, store) => {
508 |         return topological(modTimeRebuilder, tasks, key, store);
509 |     };
510 | 
511 | let modTimeRebuilder: Rebuilder<Applicative, MakeInfo<K>, K: Ord, V> =
512 |     (key, value, task) => Task {
513 |         run: fetch => {
514 |             let (now: Time, modTimes: Map<K, Time>) = get();
515 |             let dirty = match modTimes.lookup(key) {
516 |                 None => True,
517 |                 time => dependencies(task).any(dep => modTimes.lookup(dep) > time)
518 |             }
519 |             if dirty {
520 |                 put((now + 1, modTimes.insert(key, now))); // Save updated state.
521 |                 return task.run(fetch);
522 |             } else {
523 |                 return value;
524 |             }
525 |         }
526 |     };
527 | 
528 | // Fig 7. Code on 79:17 (contd.)
529 | //
530 | //   -- A topological task scheduler
531 | // topological :: Ord k => Scheduler Applicative i i k v
532 | // topological rebuilder tasks target = execState $ mapM_ build order
533 | //   where
534 | //     build :: k -> State (Store i k v) ()
535 | //     build key = case tasks key of
536 | //       Nothing -> return ()
537 | //       Just task -> do
538 | //         store <- get
539 | //         let value = getValue key store
540 | //             newTask :: Task (MonadState i) k v
541 | //             newTask = rebuilder key value task
542 | //             fetch :: k -> State i v
543 | //             fetch k = return (getValue k store)
544 | //         newValue <- liftStore (run newTask fetch)
545 | //         modify $ putValue key newValue
546 | //     order = topSort (reachable dep target)
547 | //     dep k = case tasks k of { Nothing -> []; Just task -> dependencies task }
548 | //
549 | // {Comment} As Rust doesn't have currying-by-default, I've tried to make the
550 | // signatures match up with the Rust-y signatures, so the implementation looks
551 | // a bit weird.
552 | let topological: Scheduler<Applicative, I, I, K: Ord, V> =
553 |     rebuilder => {
554 |         return (tasks, target: K, startStore) => {
555 |             let build: Fn(K) -> State<Store<I, K, V>, ()> =
556 |                 key => match tasks(key) {
557 |                     None => { return (); },
558 |                     Some(task) => {
559 |                         store = get();
560 |                         let value = getValue(key, store);
561 |                         let newTask: Task<MonadState<I>, K, V> = rebuilder(key, value, task);
562 |                         let fetch: Fn(K) -> State<I, V> =
563 |                             k => { return getValue(k, store); };
564 |                     }
565 |                     let newValue = liftStore(newTask.run(fetch));
566 |                     modify(store => putValue(key, newValue, store));
567 |                 };
568 |             let order: List<K> = topSort(reachable(depsOf, target));
569 |             let depsOf: Fn(K) -> List<K> =
570 |                 key => match tasks(key) {
571 |                     None => List::Nil,
572 |                     Some(task) => dependencies(task),
573 |                 };
574 |             // {Comment} mapM is similar to map except that applying map will give
575 |             // List<State<S, A>> whereas applying mapM will give State<S, List<A>> by
576 |             // threading the state sequentially, which can then be executed with an
577 |             // initial store to give a final store.
578 |             return execState(order.mapM(build), startStore);
579 |         };
580 |     };
581 | 
582 | // Fig 7. Code on 79:17 (contd.)
583 | //
584 | // -- Standard graph algorithms (implementation omitted)
585 | // reachable :: Ord k => (k -> [k]) -> k -> Graph k
586 | // topSort :: Ord k => Graph k -> [k] -- Throws error on a cyclic graph
587 | //
588 | // -- Expand the scope of visibility of a stateful computation
589 | // liftStore :: State i a -> State (Store i k v) a
590 | // liftStore x = do
591 | //   (a, newInfo) <- gets (runState x . getInfo)
592 | //   modify (putInfo newInfo)
593 | //   return a
594 | fn reachable<K: Ord>(depsOf: Fn(K) -> List<K>, root: K) -> Graph<K>;
595 | fn topSort<K: Ord>(depGraph: Graph<K>) -> List<K>;
596 | 
597 | fn liftStore(x: State<I, A>) -> State<Store<I, K, V>, A> {
598 |     let (a, newInfo) = gets(state => runState(x, getInfo(state)));
599 |     modify(state => putInfo(newInfo, state));
600 |     return a;
601 | }
602 | 
603 | // Fig 8. Code on 79:19
604 | //
605 | // -- Excel build system; stores a dirty bit per key and calc chain
606 | // type Chain k = [k]
607 | // type ExcelInfo k = (k -> Bool, Chain k)
608 | //
609 | // excel :: Ord k => Build Monad (ExcelInfo k) k v
610 | // excel = restarting dirtyBitRebuilder
611 | //
612 | // -- A task rebuilder based on dirty bits
613 | // dirtyBitRebuilder :: Rebuilder Monad (k -> Bool) k v
614 | // dirtyBitRebuilder key value task = Task $ \fetch -> do
615 | //     isDirty <- get
616 | //     if isDirty key then run task fetch else return value
617 | 
618 | type Chain<K> = List<K>;
619 | type ExcelInfo<K> = (Fn(K) -> Bool, Chain<K>);
620 | 
621 | let excel: Build<Monad, ExcelInfo<K>, K, V> where K: Ord =
622 |     restarting(dirtyBitRebuilder);
623 | 
624 | let dirtyBitRebuilder: Rebuilder<Monad, Fn(K) -> Bool, K, V> =
625 |     (key, value, task) => Task {
626 |         run: fetch => {
627 |             let isDirty = get();
628 |             if isDirty(key) { return task.run(fetch); } else { return value; }
629 |         }
630 |     };
631 | 
632 | // Fig 8. Code on 79:19 (contd.)
633 | //
634 | // -- A restarting task scheduler
635 | // restarting :: Ord k => Scheduler Monad (ir, Chain k) ir k v
636 | // restarting rebuilder tasks target = execState $ do
637 | //     chain <- gets (snd . getInfo)
638 | //     newChain <- liftChain $ go Set.empty $ chain ++ [target | target `notElem` chain]
639 | //     modify $ mapInfo $ \(ir, _) -> (ir, newChain)
640 | //   where
641 | //     go :: Set k -> Chain k -> State (Store ir k v) (Chain k)
642 | //     go _    []         = return []
643 | //     go done (key:keys) = case tasks key of
644 | //       Nothing -> (key :) <$> go (Set.insert key done) keys
645 | //       Just task -> do
646 | //         store <- get
647 | //         let newTask :: Task (MonadState ir) k (Either k v)
648 | //             newTask = try $ rebuilder key (getValue key store) task
649 | //             fetch :: k -> State ir (Either k v)
650 | //             fetch k | k `Set.member` done = return $ Right (getValue k store)
651 | //                     | otherwise = return $ Left k
652 | //         result <- liftStore (run newTask fetch) -- liftStore is defined in Fig. 7
653 | //         case result of
654 | //           Left dep -> go done $ dep: filter (/= dep) keys ++ [key]
655 | //           Right newValue -> do modify $ putValue key newValue
656 | //                                (key :) <$> go (Set.insert key done) keys
657 | 
658 | let restarting: Scheduler<Monad, (IR, Chain<K>), IR, K, V> =
659 |     (rebuilder, tasks, target) => {
660 |         let go: Fn(Set<K>, Chain<K>) -> State<Store<IR, K, V>, Chain<K>> =
661 |             (done, allKeys) => match allKeys {
662 |                 List::Nil => { return List::Nil; }
663 |                 List::Cons(key, keys) => match tasks(key) {
664 |                     None => { return list![key] + go(set::insert(key, done), keys); },
665 |                     Some(task) => {
666 |                         let store = get();
667 |                         let newTask: Task<MonadState<IR>, K, Result<K, V>> =
668 |                             try(rebuilder(key, getValue(key, store), task));
669 |                         let fetch: Fn(K) -> State<IR, Result<K, V>> =
670 |                             k => if done.contains(k) {
671 |                                 return Ok(getValue(k, store));
672 |                             } else {
673 |                                 return Err(k);
674 |                             }
675 |                         let result = liftStore(newTask.run(fetch));
676 |                         match result {
677 |                             Err(dep) => {
678 |                                 // {Comment} Build the unbuilt dependency first
679 |                                 // by putting it at the front of the list.
680 |                                 let updatedKeys =
681 |                                     list![dep] + keys.filter(k => k != dep) + list![key];
682 |                                 return go(done, updatedKeys);
683 |                             },
684 |                             Ok(newValue) => {
685 |                                 modify(store => putValue(key, newValue, store));
686 |                                 return list![key] + go(set::insert(key, done), keys);
687 |                             }
688 |                         }
689 |                     }
690 |                 }
691 |             };
692 |         let mut chain = gets(state => getInfo(state).second);
693 |         if chain.doesNotContain(target) { chain.append(target); }
694 |         let newChain = go(set::empty, chain);
695 |         modify(state => mapInfo((ir, _) => (ir, newChain)));
696 |     };
697 | 
698 | // Fig 8. Code on 79:19 (contd.)
699 | //
700 | // -- Convert a total task into a task that accepts a partial fetch callback
701 | // try :: Task (MonadState i) k v -> Task (MonadState i) k (Either e v)
702 | // try task = Task $ \fetch -> runExceptT $ run task (ExceptT . fetch)
703 | //
704 | // -- Expand the scope of visibility of a stateful computation (implementation omitted)
705 | // liftChain :: State (Store ir k v) a -> State (Store (ir, Chain [k]) k v) a
706 | fn try(task: Task<MonadState<I>, K, V>) -> Task<MonadState<I>, K, Result<E, V>> {
707 |     return Task { run: fetch => runExceptT(task.run(k => ExceptT(fetch(k)))) };
708 | }
709 | 
710 | fn liftChain(action: State<Store<IR, K, V>, A>) ->
711 |     State<Store<(IR, Chain<List<K>>), K, V>, A>;
712 | 
713 | // Fig 9. Code on 79:20
714 | //
715 | // -- Shake build system; stores verifying traces
716 | // shake :: (Ord k, Hashable v) => Build Monad (VT k v) k v
717 | // shake = suspending vtRebuilder
718 | //
719 | // -- A task rebuilder based on verifying traces
720 | // vtRebuilder :: (Eq k, Hashable v) => Rebuilder Monad (VT k v) k v
721 | // vtRebuilder key value task = Task $ \fetch -> do
722 | //     upToDate <- verifyVT key (hash value) (fmap hash . fetch) =<< get
723 | //     if upToDate then return value else do
724 | //         (newValue, deps) <- track task fetch
725 | //         modify $ recordVT key (hash newValue) [ (k, hash v) | (k, v) <- deps ]
726 | //         return newValue
727 | let shake: Build<Monad, VT<K, V>, K: Ord, V: Hashable> = suspending(vtRebuilder);
728 | 
729 | let vtRebuilder: Rebuilder<Monad, VT<K, V>, K: Eq, V: Hashable> =
730 |     (key, value, task) => Task {
731 |         run: fetch => {
732 |             let upToDate = verifyVT(key, hash(value), k => fetch(k).map(hash), get());
733 |             if upToDate {
734 |                 return value;
735 |             } else {
736 |                 let (newValue, deps) = track(task, fetch);
737 |                 modify(state => recordVT(
738 |                     key,
739 |                     hash(newValue),
740 |                     deps.map((k, v) => (k, hash(v))),
741 |                     state)
742 |                 );
743 |                 return newValue;
744 |             }
745 |         }
746 |     };
747 | 
748 | // Fig 9. Code on 79:20 (contd.)
749 | // -- A suspending task scheduler
750 | // suspending :: Ord k => Scheduler Monad i i k v
751 | // suspending rebuilder tasks target store = fst $ execState (fetch target) (store, Set.empty)
752 | //   where
753 | //     fetch :: k -> State (Store i k v, Set k) v
754 | //     fetch key = do
755 | //         done <- gets snd
756 | //         case tasks key of
757 | //             Just task | key `Set.notMember` done -> do
758 | //                 value <- gets (getValue key . fst)
759 | //                 let newTask :: Task (MonadState i) k v
760 | //                     newTask = rebuilder key value task
761 | //                 newValue <- liftRun newTask fetch
762 | //                 modify $ \(s, d) -> (putValue key newValue s, Set.insert key d)
763 | //                 return newValue
764 | //             _ -> gets (getValue key . fst) -- fetch the existing value
765 | 
766 | let suspending: Scheduler<Monad, I, I, K: Ord, V> =
767 |     (rebuilder, tasks, target, store) => {
768 |         let fetch: Fn(K) -> State<(Store<I, K, V>, Set<K>), V> =
769 |             key => {
770 |                 // s.first gets the store, s.second gets the keys we've finished processing
771 |                 let done = gets(s => s.second);
772 |                 match tasks(key) {
773 |                     Some(task) if done.doesNotContain(key) => {
774 |                         let value = gets(s => getValue(key, s.first));
775 |                         let newTask: Task<MonadState<I>, K, V>
776 |                             = rebuilder(key, value, task);
777 |                         let newValue = liftRun(newTask, fetch);
778 |                         modify((s, d) => (putValue(key, newValue, s), Set.insert key d));
779 |                         return newValue;
780 |                     }
781 |                     _ => { return gets(s => getValue(key, s.first)); }
782 |                 }
783 |             };
784 |         return execState(fetch(target), (store, set::empty)).first;
785 |     };
786 | 
787 | // Fig 9. Code on 79:20 (contd.)
788 | //
789 | // -- Run a task using a callback that operates on a larger state (implementation omitted)
790 | // liftRun
791 | //   :: Task (MonadState i) k v
792 | //   -> (k -> State (Store i k v, Set k) v)
793 | //   -> State (Store i k v, Set k) v
794 | fn liftRun(
795 |     task: Task<MonadState<I>, K, V>,
796 |     fetch: Fn(K) -> State<(Store<I, K, V>, Set<K>), V>
797 |   ) -> State<(Store<I, K, V>, Set<K>), V>;
798 | 
799 | // Fig 10. Code on 79:22
800 | //
801 | // -- Bazel build system; stores constructive traces
802 | // bazel :: (Ord k, Hashable v) => Build Monad (CT k v) k v
803 | // bazel = restarting2 ctRebuilder -- implementation of ’restarting2’ is omitted (22 lines)
804 | //
805 | // -- A rebuilder based on constructive traces
806 | // ctRebuilder :: (Eq k, Hashable v) => Rebuilder Monad (CT k v) k v
807 | // ctRebuilder key value task = Task $ \fetch -> do
808 | //     cachedValues <- constructCT key (fmap hash . fetch) =<< get
809 | //     case cachedValues of
810 | //         _ | value `elem` cachedValues -> return value
811 | //         cachedValue:_ -> return cachedValue
812 | //         [] -> do (newValue, deps) <- track task fetch
813 | //                  modify $ recordCT key newValue [ (k, hash v) | (k, v) <- deps ]
814 | //                  return newValue
815 | 
816 | let bazel: Build<Monad, CT<K, V>, K: Ord, V: Hashable> =
817 |     restarting2(ctRebuilder);
818 | 
819 | let ctRebuilder: Rebuilder<Monad, CT<K, V>, K: Ord, V: Hashable> =
820 |     (key, value, task) => Task {
821 |         run: fetch => {
822 |             let cachedValues = constructCT(key, k => fetch(k).map(hash), get());
823 |             if cachedValues.contains(value) {
824 |                 return value;
825 |             }
826 |             match cachedValues {
827 |                 List::Cons(cachedValue, _) => { return cachedValue; }
828 |                 List::Nil => {
829 |                     let (newValue, deps) = track(task, fetch);
830 |                     modify(
831 |                         s => recordCT(key, newValue, deps.map((k, v) => (k, hash(v))), s)
832 |                     );
833 |                     return newValue;
834 |                 }
835 |             }
836 |         }
837 |     };
838 | 
839 | // Fig 10. Code on 79:22 (contd.)
840 | //
841 | // -- Cloud Shake build system, implementation of ’suspending’ is given in Fig. 9
842 | // cloudShake :: (Ord k, Hashable v) => Build Monad (CT k v) k v
843 | // cloudShake = suspending ctRebuilder
844 | //
845 | // -- CloudBuild build system, implementation of ’topological’ is given in Fig. 7
846 | // cloudBuild :: (Ord k, Hashable v) => Build Applicative (CT k v) k v
847 | // cloudBuild = topological (adaptRebuilder ctRebuilder)
848 | //
849 | // -- Convert a monadic rebuilder to the corresponding applicative one
850 | // adaptRebuilder :: Rebuilder Monad i k v -> Rebuilder Applicative i k v
851 | // adaptRebuilder rebuilder key value task = rebuilder key value $ Task $ run task
852 | //
853 | // -- Buck build system, implementation of ’topological’ is given in Fig. 7
854 | // buck :: (Ord k, Hashable v) => Build Applicative (DCT k v) k v
855 | // buck = topological (adaptRebuilder dctRebuilder)
856 | //
857 | // -- Rebuilder based on deep constructive traces, analogous to ’ctRebuilder’
858 | // dctRebuilder :: (Eq k, Hashable v) => Rebuilder Monad (DCT k v) k v
859 | //
860 | // -- Nix build system, implementation of ’suspending’ is given in Fig. 9
861 | // nix :: (Ord k, Hashable v) => Build Monad (DCT k v) k v
862 | // nix = suspending dctRebuilder
863 | 
864 | let cloudShake: Build<Monad, CT<K, V>, K, V>
865 |     = suspending(ctRebuilder);
866 | 
867 | let cloudBuild: Build<Applicative, CT<K, V>, K, V>
868 |     = topological(adaptRebuilder(ctRebuilder));
869 | 
870 | let adaptRebuilder: Fn(Rebuilder<Monad, I, K, V>) -> Rebuilder<Applicative, I, K, V> =
871 |     rebuilder => {
872 |         return (key, value, task) => rebuilder(key, value, Task { run: task.run });
873 |     };
874 | 
875 | let buck: Build<Applicative, DCT<K, V>, K, V>
876 |     = topological(adaptRebuilder(dctRebuilder));
877 | 
878 | let dctRebuilder: Rebuilder<Monad, DCT<K, V>, K: Eq, V: Hashable>;
879 | 
880 | let nix: Build<Monad, DCT<K, V>, K, V>
881 |     = suspending(dctRebuilder);
882 | 
883 | // Code on 79:24
884 | // sprsh3 :: Tasks MonadPlus String Integer
885 | // sprsh3 "B1" = Just $ Task $ \fetch -> (+) <$> fetch "A1" <*> (pure 1 <|> pure 2)
886 | // sprsh3 _ = Nothing
887 | let spreadsheet3: Tasks<MonadPlus, String, Integer> =
888 |     k => match k {
889 |         // No easy translation here without going into details of Alternative/MonadPlus :(
890 |         "B1" => Some(Task { run: fetch => fetch("A1") + eitherOr(1, 2) }),
891 |         _    => None
892 |     };
893 | 
894 | // Code on 79:25
895 | // sprsh4 "B1" = Just $ Task $ \fetch -> do
896 | //     formula <- fetch "B1-formula"
897 | //     evalFormula fetch formula
898 | let spreadsheet4: Tasks<Monad, String, Integer> =
899 |     k => match k {
900 |         "B1" => Some(Task {
901 |             run: fetch => {
902 |                 let formula = fetch("B1-formula");
903 |                 return evalFormula(fetch, formula);
904 |             }
905 |         })
906 |         ... // skipped
907 |     };
908 | 


--------------------------------------------------------------------------------
/Readme.md:
--------------------------------------------------------------------------------
 1 | # Build Systems à la Carte (Rust-like syntax)
 2 | 
 3 | I saw a tweet mention that Haskell's syntax made the code examples in
 4 | the paper hard to follow for those unfamiliar with it :frowning_face:.
 5 | I really liked the paper; it'd be awesome if more people could understand
 6 | what's going on better. Hence this translation to Rust-like syntax! :smile:
 7 | 
 8 | If you're having trouble understanding something, or have some suggestions
 9 | for improvement, or just have some Haskell-specific question related to the
10 | paper, please open an issue! Vaguely worded issues are perfectly okay too!
11 | 


--------------------------------------------------------------------------------