Last active
May 16, 2020 17:23
-
-
Save chowells79/996f2749b088d287937e3eff11055522 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
-- The ancient symbol consisting of a serpent or dragon devouring its | |
-- own tail. This is the central loop of a BFS implementation that | |
-- used laziness to share the list of enqueued elements for future | |
-- processing with the output list of visited elements. | |
-- | |
-- That implementation detail isn't that important for using it, | |
-- though. The first argument is a processing function that takes the | |
-- current element and state, and returns any number of new elements | |
-- to process along with a new state for processing the next | |
-- element. The second argument is an initial list of elements to | |
-- process. They are processed in order, observable by changes to the | |
-- current state when each is processed. The third argument is the | |
-- initial state value. The output is the list of elements processed, | |
-- in order. | |
ouroboros :: (a -> b -> ([a], b)) -> [a] -> b -> [a] | |
ouroboros f seeds initialState = result | |
where | |
-- Assign a name to the output, so that it can refer to itself. | |
-- The reference back to itself establishes the sharing between | |
-- the queue and the output. | |
result = countAppend seeds (go initialState result) 0 | |
-- Processes enqueued elements. The first argument is the current | |
-- state, the second is the unprocessed portion of the queue, and | |
-- the third is the number of elements remaining in the queue. The | |
-- output is all elements returned by processing those currently | |
-- in the queue and those added by further processing. | |
-- | |
-- This both produces and consumes the same data structure for the | |
-- queue, thanks to the self-referentiality in the definition of | |
-- result. A consequence of that is that the function's output is | |
-- an eventual tail of the input queue. This apparent causality | |
-- violation *usually* works out fine, thanks to laziness, but if | |
-- the current position in the queue ever catches up with the | |
-- output, a circular evaluation dependency arises. It needs to | |
-- examine the current element to determine what the current | |
-- element is. This is a logical paradox that laziness can't save | |
-- it from, which is why the remaining queue size is passed as an | |
-- additional parameter and checked before the queue contents are | |
-- inspected. If the remaining queue size is 0, processing is | |
-- complete. | |
-- | |
-- The third equation never matches in this implementation. It's | |
-- provided to satisfy the check for exhaustive pattern matching | |
-- and provide some slightly snarky hint where to look for | |
-- problems if a future refactoring breaks things. | |
go _ _ 0 = [] | |
go s (x:xs) n = case f x s of (ys, s') -> countAppend ys (go s' xs) (n - 1) | |
go _ [] _ = error "you rewrote ouroboros and got it wrong" | |
-- Fused list append and length passing. Exists only to make the | |
-- termination condition check in ouroboros work without an extra pass | |
-- over the enqueued elements to count them. Passing in an extra value | |
-- to add to the length is an additional aid to readability in | |
-- ouroboros. | |
-- | |
-- semantics: | |
-- countAppend xs next n == xs ++ next (length xs + n) | |
countAppend :: [a] -> (Int -> [a]) -> Int -> [a] | |
countAppend xs next = foldr (\x go i -> x : (go $! i + 1)) next xs |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment