implemented calculation of check bits for Word16

This commit is contained in:
Jonathan Lamothe 2024-06-30 08:57:13 -04:00
parent ee0cbe47b2
commit af26fcedd8
5 changed files with 141 additions and 2 deletions

View File

@ -51,6 +51,8 @@ test-suite hamming-test
type: exitcode-stdio-1.0 type: exitcode-stdio-1.0
main-is: Spec.hs main-is: Spec.hs
other-modules: other-modules:
Hamming.Word16Spec
HammingSpec
Paths_hamming Paths_hamming
autogen-modules: autogen-modules:
Paths_hamming Paths_hamming

View File

@ -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 --jl

View File

@ -0,0 +1,66 @@
{-
hamming
Copyright (C) Jonathan Lamothe <jonathan@jlamothe.net>
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.Word16Spec (spec) where
import Data.Word (Word16)
import Hamming
import Test.Hspec (Spec, context, describe, it, shouldBe)
spec :: Spec
spec = describe "Word16" $ do
setCheckBitsSpec
isValidSpec
correctErrorsSpec
setCheckBitsSpec :: Spec
setCheckBitsSpec = describe "setCheckBits" $ mapM_
( \(desc, code, expected) -> context desc $ let
actual = setCheckBits code
in it ("should be " ++ show expected) $
actual `shouldBe` expected
)
[ ( "all zeroes", 0, 0 )
, ( "all ones", 0xffff, 0xffff )
, ( "no check bits", noChkBits, withChkBits )
, ( "bad check bits", badChkBits, withChkBits )
]
isValidSpec :: Spec
isValidSpec = describe "isValid" $
return ()
correctErrorsSpec :: Spec
correctErrorsSpec = describe "correctErrors" $
return ()
noChkBits :: Word16
noChkBits = 0x34c0
withChkBits :: Word16
withChkBits = 0x35c5
badChkBits :: Word16
badChkBits = 0x34d2
--jl

32
test/HammingSpec.hs Normal file
View File

@ -0,0 +1,32 @@
{-
hamming
Copyright (C) Jonathan Lamothe <jonathan@jlamothe.net>
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 HammingSpec (spec) where
import Test.Hspec (Spec, describe)
import qualified Hamming.Word16Spec as Word16
spec :: Spec
spec = describe "Hamming"
Word16.spec
--jl

View File

@ -21,7 +21,9 @@ License along with this program. If not, see
import Test.Hspec (hspec) import Test.Hspec (hspec)
import qualified HammingSpec as Hamming
main :: IO () main :: IO ()
main = hspec $ return () main = hspec Hamming.spec
--jl --jl