Skip to content

Instantly share code, notes, and snippets.

@bradparker bradparker/Byte.hs
Last active Jul 6, 2019

Embed
What would you like to do?
Bytes and Folds / Traversals
{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE RankNTypes #-}
module Byte where
import Data.Bool (bool)
import Data.Functor.Const (Const(Const, getConst))
import Data.Bits ((.&.), (.|.), xor)
import Prelude hiding (sum)
type Bit = Bool
data Byte
= Byte
Bit
Bit
Bit
Bit
Bit
Bit
Bit
Bit
deriving (Show, Eq)
type Fold s a = forall m. Monoid m => (a -> Const m a) -> s -> Const m s
toList :: Fold s a -> s -> [a]
toList fold = getConst . fold (\a -> Const [a])
bits :: Fold Byte Bit
bits f (Byte _1 _2 _3 _4 _5 _6 _7 _8) =
Byte <$> f _1 <*> f _2 <*> f _3 <*> f _4 <*> f _5 <*> f _6 <*> f _7 <*> f _8
toNum :: Num a => Byte -> a
toNum =
foldr (\bit n -> bool 0 1 bit + n * 2) 0 . toList bits
halfAdder :: Bit -> Bit -> (Bit, Bit)
halfAdder a b = (a .&. b, a `xor` b)
fullAdder :: Bit -> Bit -> Bit -> (Bit, Bit)
fullAdder carry a b =
let (carry' , sum ) = halfAdder a b
(carry'', sum') = halfAdder sum carry
in (carry' .|. carry'', sum')
addBytes :: Byte -> Byte -> Byte
addBytes (Byte _1 _2 _3 _4 _5 _6 _7 _8) (Byte _1' _2' _3' _4' _5' _6' _7' _8')
= let (c , _1'') = halfAdder _1 _1'
(c' , _2'') = fullAdder c _2 _2'
(c'' , _3'') = fullAdder c' _3 _3'
(c''' , _4'') = fullAdder c'' _4 _4'
(c'''' , _5'') = fullAdder c''' _5 _5'
(c''''' , _6'') = fullAdder c'''' _6 _6'
(c'''''', _7'') = fullAdder c''''' _7 _7'
(_ , _8'') = fullAdder c'''''' _8 _8'
in Byte _1'' _2'' _3'' _4'' _5'' _6'' _7'' _8''
byteFromIntegral :: (Integral a, Eq a) => a -> Byte
byteFromIntegral n =
let (n1, _1) = divMod n 2
(n2, _2) = divMod n1 2
(n3, _3) = divMod n2 2
(n4, _4) = divMod n3 2
(n5, _5) = divMod n4 2
(n6, _6) = divMod n5 2
(n7, _7) = divMod n6 2
(_ , _8) = divMod n7 2
in Byte (_1 /= 0)
(_2 /= 0)
(_3 /= 0)
(_4 /= 0)
(_5 /= 0)
(_6 /= 0)
(_7 /= 0)
(_8 /= 0)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.