67 lines
1.9 KiB
Haskell
67 lines
1.9 KiB
Haskell
{-|
|
|
|
|
Module : Hamming
|
|
Description : Utilities for working with Hamming codes
|
|
Copyright : (C) Jonathan Lamothe
|
|
License : AGPL-3.0-or-later
|
|
Maintainer : jonathan@jlamothe.net
|
|
Stability : experimental
|
|
Portability : POSIX
|
|
|
|
This program is free software: you can redistribute it and/or modify
|
|
it under the terms of the GNU Affero 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
|
|
Affero General Public License for more details.
|
|
|
|
You should have received a copy of the GNU Affero General Public
|
|
License along with this program. If not, see
|
|
<https://www.gnu.org/licenses/>.
|
|
|
|
|-}
|
|
|
|
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
|