Bits.hs

{-  CAO Compiler
    Copyright (C) 2014 Cryptography and Information Security Group, HASLab - INESC TEC and Universidade do Minho

    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 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>. -}

{- |
Module      :  $Header$
Description :  Bit operations semantics.
Copyright   :  (C) 2014 Cryptography and Information Security Group, HASLab - INESC TEC and Universidade do Minho
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) ""