implemented calculation of check bits for Word16

src/Hamming.hs

@@ -24,6 +24,43 @@ License along with this program.  If not, see
 
 |-}
 
-module Hamming () where
+module Hamming (Hamming (..)) where
+
+import Data.Bits (Bits, complement, shiftR, (.&.), (.|.))
+import Data.Word (Word16)
+
+-- | An implementation of a Hamming code
+class Hamming h where
+  -- | Sets the check bits (overwriting previous values)
+  setCheckBits :: h -> h
+  -- | Determines whether or not the code is valid
+  isValid :: h -> Bool
+  -- | Attempts to correct a single bit error
+  correctErrors :: h -> Maybe h
+
+instance Hamming Word16 where
+  setCheckBits c = foldl setCheckBit c
+    [ ( 0x0002, 0xaaa8 )
+    , ( 0x0004, 0xccc8 )
+    , ( 0x0010, 0xf0e0 )
+    , ( 0x0100, 0xfe00 )
+    , ( 0x0001, 0xfffe )
+    ]
+
+  isValid = undefined
+  correctErrors = undefined
+
+setCheckBit :: (Num a, Bits a) => a -> (a, a) -> a
+setCheckBit a (pBit, chkMask) =
+  if oddParity (a .&. chkMask)
+    then a .|. pBit
+    else a .&. complement pBit
+
+oddParity :: (Bits a, Num a) => a -> Bool
+oddParity = f False where
+  f p x
+    | x == 0       = p
+    | x .&. 1 == 1 = f (not p) (shiftR x 1)
+    | otherwise    = f p (shiftR x 1)
 
 --jl