Bits.hs

{- |
Module      :  $Header$
Description :  Bit operations semantics.
Copyright   :  (c) SMART Team / HASLab
License     :  GPL

Maintainer  :  Paulo Silva <paufil@di.uminho.pt>
Stability   :  experimental
Portability :  non-portable

Bit operations semantics.
-}

module Language.CAO.Semantics.Bits 
    ( bitsOr
    , bitsAnd
    , bitsXor
    , bitsNot
    , bitsConcat
    , bitsRotUp
    , bitsRotDown
    , bitsShiftUp
    , ubitsShiftDown
    , sbitsShiftDown
    , ubitsToInteger
    , sbitsToInteger
    , stringToBits
    , bitsToString
    ) where

import Data.List (foldl')

bitsOr, bitsAnd, bitsXor :: [Bool] -> [Bool] -> [Bool]
bitsOr  = zipWith (||)
bitsAnd = zipWith (&&)
bitsXor = zipWith (/=)

bitsNot :: [Bool] -> [Bool]
bitsNot = map not

bitsConcat :: [Bool] -> [Bool] -> [Bool]
bitsConcat = (++)

bitsRotUp :: [Bool] -> Integer -> [Bool]
bitsRotUp l 0 = l
bitsRotUp l n = bitsRotUp (last l : init l) (n-1)

bitsRotDown :: [Bool] -> Integer -> [Bool]
bitsRotDown l 0 = l
bitsRotDown l n = bitsRotDown (tail l ++ [head l]) (n-1)

bitsShiftUp :: [Bool] -> Integer -> [Bool]
bitsShiftUp l 0 = l
bitsShiftUp l n = bitsShiftUp (False : init l) (n-1)

ubitsShiftDown :: [Bool] -> Integer -> [Bool]
ubitsShiftDown l 0 = l
ubitsShiftDown l n = ubitsShiftDown (tail l ++ [False]) (n-1)

sbitsShiftDown :: [Bool] -> Integer -> [Bool]
sbitsShiftDown l 0 = l
sbitsShiftDown l n = sbitsShiftDown (tail l ++ [last l]) (n-1)

ubitsToInteger :: [Bool] -> Integer
ubitsToInteger = foldl' (\ r b -> if b then r * 2 + 1 else r * 2) 0 . reverse

sbitsToInteger :: [Bool] -> Integer
sbitsToInteger bs = if last bs
                       then -(ubitsToInteger $ bitsNot bs) - 1
                       else ubitsToInteger bs

stringToBits :: String -> [Bool]
stringToBits = foldl' (\ r -> (:r) . (== '1')) []

bitsToString :: [Bool] -> String
bitsToString = foldl' (\ r b -> (if b then '1' else '0') : r) ""