lfsr.hs

-- | Linear feedback shift registers.
--
-- a good table of taps:
-- http://home1.gte.net/res0658s/electronics/LFSRtaps.html
--
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE DefaultSignatures    #-}
module Data.LFSR where
import Data.Bits
import Data.Int
import Data.List as L
import Data.Word
import Data.Word.Odd
import Numeric

type Tap = Int

class LFSR a where
  output :: a -> Bool
  default output :: Bits a => a -> Bool
  output r = testBit r 0

  -- | Input function
  input :: a -> [Tap] -> Bool
  default input :: Bits a => a -> [Tap] -> Bool
  input r = L.foldl (/=) (output r) . L.map (testBit r)

  next :: [Tap] -> a -> a
  default next :: (Bits a) => [Tap] -> a -> a
  next taps r = (r `shiftR` 1) .|. i
    where
      i = if input r taps
          then bit (bitSize r - 1)
          else bit (bitSize r) -- always zero

instance LFSR Word4
instance LFSR Word8
instance LFSR Word16
instance LFSR Word32
instance LFSR Word64
instance LFSR Word
instance LFSR Int8
instance LFSR Int16
instance LFSR Int32
instance LFSR Int64
instance LFSR Int

-- | Infinite list of output values for a given /seed/. Note that this
-- list is periodic.
stream :: LFSR a => [Tap] -> a -> [Bool]
stream taps seed = go seed
  where
    go reg = output reg : go (next taps reg)

states :: (LFSR a, Eq a) => [Tap] -> a -> [a]
states taps seed = go seed
  where
    go reg
      | n == seed = []
      | otherwise = reg : go n
      where
        n = next taps reg

dump :: Enum a => [a] -> IO ()
dump = mapM_ (putBitsLn . fromEnum)
  where
    putBitsLn x = putStrLn $ showIntAtBase 2 (head . show) x ""