Created
August 28, 2011 20:39
-
-
Save rampion/1177192 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
{-# LANGUAGE ExistentialQuantification #-} | |
module Computation where | |
-- model the steps of a computation | |
data Computation a = forall b. Step b (b -> Computation a) | Done a | |
instance Monad Computation where | |
(Step b g) >>= f = Step b $ (>>=f) . g | |
(Done b) >>= f = Step b f | |
return = Done | |
runComputation :: Computation a -> a | |
runComputation (Step b g) = runComputation (g b) | |
runComputation (Done a) = a | |
isDone :: Computation a -> Bool | |
isDone (Done _) = True | |
isDone _ = False | |
-- an order for a set of computations | |
data Schedule a = a :> Computation (Schedule a) | Last | |
toList :: Schedule a -> [a] | |
toList Last = [] | |
toList (a :> c) = a : (toList . runComputation) c | |
-- given a set of computations, find a schedule to generate all their results | |
type Strategy a = [Computation a] -> Computation (Schedule a) | |
-- schedule all the completed computations, and step the rest, | |
-- passing the remaining to the given function | |
scheduleOrStep :: (Queue (Computation a) -> Computation (Schedule a)) -> Strategy a | |
scheduleOrStep s cs = scheduleOrStep' id cs | |
where scheduleOrStep' q ((Done a):cs) = Done $ a :> scheduleOrStep' q cs | |
scheduleOrStep' q ((Step b g):cs) = scheduleOrStep' (q . (g b:)) cs | |
scheduleOrStep' q [] = s q | |
-- schedule all completed compuations, step all the rest once, and repeat | |
-- (may never complete for infinite lists) | |
-- checking each row of | |
-- [ [ c0s0, c1s0, c2s0, ... ] | |
-- , [ c0s1, c1s1, c2s1, ... ] | |
-- , [ c0s2, c1s2, c2s2, ... ] | |
-- ... | |
-- ] | |
-- (where cNsM is computation N stepped M times) | |
fair :: Strategy a | |
fair [] = Done Last | |
fair cs = scheduleOrStep (fair . ($[])) cs | |
-- schedule more steps for earlier computations rather than later computations | |
-- (works on infinite lists) | |
-- checking the sw-ne diagonals of | |
-- [ [ c0s0, c1s0, c2s0, ... ] | |
-- , [ c0s1, c1s1, c2s1, ... ] | |
-- , [ c0s2, c1s2, c2s2, ... ] | |
-- ... | |
-- ] | |
-- (where cNsM is computation N stepped M times) | |
diag :: Enqueue (Computation a)-> Strategy a | |
diag _ [] = Done Last | |
diag enq cs = diag' cs id | |
where diag' (c:cs) q = scheduleOrStep (diag' cs) (enq c q $ []) | |
diag' [] q = fair (q []) | |
-- diagonal downwards : | |
-- [ c0s0, | |
-- c1s0, c0s1, | |
-- c2s0, c1s1, c0s2, | |
-- ... | |
-- cNs0, c{N-1}s1, ..., c1s{N-1}, c0sN, | |
-- ... | |
-- ] | |
diagd :: Strategy a | |
diagd = diag prepend | |
-- diagonal upwards : | |
-- [ c0s0, | |
-- c0s1, c1s0, | |
-- c0s2, c1s1, c2s0, | |
-- ... | |
-- c0sN, c1s{N-1}, ..., c{s1N-1}, cNs0, | |
-- ... | |
-- ] | |
diagu :: Strategy a | |
diagu = diag append | |
-- a queue type | |
type Queue a = [a] -> [a] | |
type Enqueue a = a -> Queue a -> Queue a | |
append :: Enqueue a | |
append x q = q . (x:) | |
prepend :: Enqueue a | |
prepend x q = (x:) . q |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment