root/hiersort/core/S.hs

-- | S.hs
--
-- This module contains core definitions used by the rest of system.
-- Here we have the famous infinite list (S a) and some primitives.
--
-- Copytight (C) 2007, 2008 Serguey Zefirov
--
-- This program is free software; you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation; either version 3, or (at your option)
-- any later version.
-- See file COPYING or visit http://www.gnu.org/licenses for details.

-- {-# INLINE #-} anything here didn't proved worthwhile.
--
-- I think that all parallelisation calls should be placed here.
-- And they are, indeed.

module S where

import Data.List
import Control.Parallel

-- The Infinite List, as it is. We call it stream for short.
data S a = S a (S a)

-- Usual conversion to list.
toList (S a s) = a:toList s

-- Safe instance of show - does not display too much information.
instance Show a => Show (S a) where
        show s = (++"...") $ tail $ init $ show $ take 20 $ toList s

-- Constant value stream.
constS c = let s = S c s in s

-- And delaying a stream with given value.
delayS x s = S x s

-- Make a stream from starting list and default value.
fromListS c [] = constS c
fromListS c (x:xs) = delayS x $ fromListS c xs

-- Make a series of delayS'.
prependS [] = id
prependS (x:xs) = delayS x . prependS xs

-- Cycle a list and make it a stream.
loopPrefixS l = let r = prependS l r in r

-- mapping.
mapS f ~(S x xs) = S (f x) $ mapS f xs

-- Unzipper. Used to fan out a bus (stream of tuples) into tuple of streams.
unzipS s = fi `pseq` (se `par` fi,se)
        where
                fi = mapS fst s
                se = mapS snd s

unzipS3 abcs = (mapS (\(a,b,c) -> a) abcs,mapS (\(a,b,c) -> b) abcs, mapS (\(a,b,c) -> c) abcs)

-- Usual zipper. An inverse for unzipS.
zipS ~(S a as) ~(S b bs) = S (a,b) $ zipS as bs

-- General zipper.
zipWithS f ~(S a as) ~(S b bs) = S (f a b) $ zipWithS f as bs

-- Thread state through state changer function (Mealy state machine).
loopS :: st -> (st -> i -> (st,o)) -> S i -> S o
loopS s0 f is = xs
        where
                (ss,xs) = unzipS $ mapS (uncurry f') $ zipS (delayS s0 ss) is
                f' st i = (st `par` (st `pseq` f st i))

-- Fairly esotheric.
-- Convert list of streams to stream of lists.
-- It ain't used here, but can be useful.
listSToSList :: [S a] -> S [a]
listSToSList listS =
          fromListS
                (error "listSToSList: cannot be!") -- default value for fromListS
        $ transpose
        $ map toList listS