Checkpoint; not sure where this code is, but I'm rethinking.

tests/math/GenerateTests.hs

@@ -1,5 +1,5 @@
 import Control.Monad
-import Data.Bits(shiftL,(.&.))
+import Data.Bits(Bits,shiftL,shiftR,(.&.))
 import Data.Map.Strict(Map)
 import qualified Data.Map.Strict as Map
 import GHC.Integer.GMP.Internals(powModInteger)
@@ -14,15 +14,20 @@ testTypes = [("addition", addTest),
              ("modadd", modaddTest),
              ("subtraction", subTest),
              ("multiplication", mulTest),
-             ("expandingmul", expmulTest),
              ("modmul", modmulTest),
              ("squaring", squareTest),
              ("modsq", modsqTest),
              ("modexp", modexpTest),
              ("bmodexp", bmodexpTest),
              ("division", divTest),
+             ("shift", shiftTest),
+             ("sigshr", signedShiftRightTest),
+             ("sigadd", signedAddition),
+             ("sigsub", signedSubtraction),
              ("barrett_gen", barrettGenTest),
-             ("barrett_reduce", barrettReduceTest)
+             ("barrett_reduce", barrettReduceTest),
+             ("barrett_mul", bmodmulTest),
+             ("egcd", egcdTest)
             ]
 
 bitSizes :: [Int]
@@ -40,8 +45,9 @@ splitMod bitsize xs = filtered ++ [m]
   xs'      = map (\x -> x .&. mask bitsize) xs
   m        = maximum xs'
   filtered = go xs'
-  go (x:xs) | x == m    = xs
-            | otherwise = x : go xs
+  go []                   = error "Didn't find case in splitMod"
+  go (x:rest) | x == m    = rest
+              | otherwise = x : go rest
 
 addTest :: Int -> StdGen -> (Map String String, StdGen)
 addTest bitsize gen0 = (res, gen2)
@@ -50,13 +56,13 @@ addTest bitsize gen0 = (res, gen2)
   (b, gen2) = random gen1
   a'        = a .&. mask bitsize
   b'        = b .&. mask bitsize
-  c         = (a' + b') .&. mask bitsize
+  c         = a' + b'
   res       = Map.fromList [("a", showHex a' ""),
                             ("b", showHex b' ""),
                             ("c", showHex c  "")]
 
 modaddTest :: Int -> StdGen -> (Map String String, StdGen)
-modaddTest bitsize gen0 = (res, gen2)
+modaddTest bitsize gen0 = (res, gen3)
  where
   (a, gen1)  = random gen0
   (b, gen2)  = random gen1
@@ -82,18 +88,6 @@ subTest bitsize gen0 = (res, gen2)
 
 mulTest :: Int -> StdGen -> (Map String String, StdGen)
 mulTest bitsize gen0 = (res, gen2)
- where
-  (a, gen1) = random gen0
-  (b, gen2) = random gen1
-  a'        = a .&. mask bitsize
-  b'        = b .&. mask bitsize
-  c         = (a' * b') .&. mask bitsize
-  res       = Map.fromList [("a", showHex a' ""),
-                            ("b", showHex b' ""),
-                            ("c", showHex c  "")]
-
-expmulTest :: Int -> StdGen -> (Map String String, StdGen)
-expmulTest bitsize gen0 = (res, gen2)
  where
   (a, gen1) = random gen0
   (b, gen2) = random gen1
@@ -105,7 +99,7 @@ expmulTest bitsize gen0 = (res, gen2)
                             ("c", showHex c  "")]
 
 modmulTest :: Int -> StdGen -> (Map String String, StdGen)
-modmulTest bitsize gen0 = (res, gen2)
+modmulTest bitsize gen0 = (res, gen3)
  where
   (a, gen1)  = random gen0
   (b, gen2)  = random gen1
@@ -127,27 +121,35 @@ squareTest bitsize gen0 = (res, gen1)
                             ("r", showHex r  "")]
 
 modsqTest :: Int -> StdGen -> (Map String String, StdGen)
-modsqTest bitsize gen0 = (res, gen1)
+modsqTest bitsize gen0 = (res, gen2)
  where
   (a, gen1) = random gen0
-  (m, gen3) = random gen1
+  (m, gen2) = random gen1
   [a',m']   = splitMod bitsize [a,m]
+  k          = computeK m'
+  u          = barrett m'
   r         = (a' * a') `mod` m'
   res       = Map.fromList [("a", showHex a' ""),
                             ("m", showHex m' ""),
+                            ("k", showHex k  ""),
+                            ("u", showHex u  ""),
                             ("r", showHex r  "")]
 
 modexpTest :: Int -> StdGen -> (Map String String, StdGen)
-modexpTest bitsize gen0 = (res, gen2)
+modexpTest bitsize gen0 = (res, gen3)
  where
   (b, gen1)  = random gen0
   (e, gen2)  = random gen1
   (m, gen3)  = random gen2
   [b',e',m'] = splitMod bitsize [b,e,m]
+  k          = computeK m'
+  u          = barrett m'
   r          = powModInteger b' e' m'
   res        = Map.fromList [("b", showHex b' ""),
                              ("e", showHex e' ""),
                              ("m", showHex m' ""),
+                             ("k", showHex k  ""),
+                             ("u", showHex u  ""),
                              ("r", showHex r  "")]
 
 
@@ -164,13 +166,77 @@ divTest bitsize gen0 = (res, gen2)
                             ("q", showHex q  ""),
                             ("r", showHex r  "")]
 
+shiftTest :: Int -> StdGen -> (Map String String, StdGen)
+shiftTest bitsize gen0 = (res, gen2)
+ where
+  (a, gen1) = random gen0
+  (b, gen2) = random gen1
+  a'        = a .&. mask bitsize
+  b'        = b .&. 0xFF
+  r         = a' `shiftR` b'
+  l         = (a' `shiftL` b') .&. mask bitsize
+  res       = Map.fromList [("a", showHex a' ""),
+                            ("b", showHex b' ""),
+                            ("r", showHex r  ""),
+                            ("l", showHex l  "")]
+
+signedMask :: (Ord a, Num a, Bits a) => a -> a -> a
+signedMask x y | x < 0     = -(abs x .&. y)
+               | otherwise = x .&. y
+
+signedShiftRightTest :: Int -> StdGen -> (Map String String, StdGen)
+signedShiftRightTest bitsize gen0 = (res, gen2)
+ where
+  (a, gen1) = random gen0
+  (b, gen2) = random gen1
+  a'        = signedMask a (mask bitsize)
+  b'        = b .&. 0xFF
+  x         = a' `shiftR` b'
+  prefixA   = if a' < 0 then "-" else ""
+  prefixX   = if x  < 0 then "-" else ""
+  res       = Map.fromList [("a", prefixA ++ showHex (abs a') ""),
+                            ("b", showHex b' ""),
+                            ("x", prefixX ++ showHex (abs x) "")]
+
+signedAddition :: Int -> StdGen -> (Map String String, StdGen)
+signedAddition bitsize gen0 = (res, gen2)
+ where
+  (a, gen1) = random gen0
+  (b, gen2) = random gen1
+  mymask    = mask (bitsize - 2)
+  a'        = signedMask a mymask
+  b'        = signedMask b mymask
+  x         = a' + b'
+  prefixA   = if a' < 0 then "-" else ""
+  prefixB   = if b' < 0 then "-" else ""
+  prefixX   = if x  < 0 then "-" else ""
+  res       = Map.fromList [("a", prefixA ++ showHex (abs a') ""),
+                            ("b", prefixB ++ showHex (abs b') ""),
+                            ("x", prefixX ++ showHex (abs x) "")]
+
+signedSubtraction :: Int -> StdGen -> (Map String String, StdGen)
+signedSubtraction bitsize gen0 = (res, gen2)
+ where
+  (a, gen1) = random gen0
+  (b, gen2) = random gen1
+  mymask    = mask (bitsize - 2)
+  a'        = signedMask a mymask
+  b'        = signedMask b mymask
+  x         = a' - b'
+  prefixA   = if a' < 0 then "-" else ""
+  prefixB   = if b' < 0 then "-" else ""
+  prefixX   = if x  < 0 then "-" else ""
+  res       = Map.fromList [("a", prefixA ++ showHex (abs a') ""),
+                            ("b", prefixB ++ showHex (abs b') ""),
+                            ("x", prefixX ++ showHex (abs x) "")]
+
 barrettGenTest :: Int -> StdGen -> (Map String String, StdGen)
 barrettGenTest bitsize gen0 = (res, gen1)
  where
   (m, gen1) = random gen0
   m'        = m .&. mask bitsize
   k         = computeK m'
-  u         = barrett bitsize m'
+  u         = barrett m'
   res       = Map.fromList [("m", showHex m' ""),
                             ("k", showHex k  ""),
                             ("u", showHex u  "")]
@@ -183,7 +249,7 @@ barrettReduceTest bitsize gen0 = (res, gen2)
   m'        = m .&. mask bitsize
   x'        = x .&. mask (min bitsize (2 * k * 64))
   k         = computeK m'
-  u         = barrett bitsize m'
+  u         = barrett m'
   r         = x' `mod` m'
   res       = Map.fromList [("m", showHex m' ""),
                             ("x", showHex x' ""),
@@ -191,15 +257,48 @@ barrettReduceTest bitsize gen0 = (res, gen2)
                             ("u", showHex u  ""),
                             ("r", showHex r  "")]
 
+bmodmulTest :: Int -> StdGen -> (Map String String, StdGen)
+bmodmulTest bitsize gen0 = (res, gen3)
+ where
+  (a, gen1)  = random gen0
+  (b, gen2)  = random gen1
+  (m, gen3)  = random gen2
+  [a',b',m'] = splitMod bitsize [a,b,m]
+  k          = computeK m'
+  u          = barrett m'
+  r          = (a' * b') `mod` m'
+  res        = Map.fromList [("a", showHex a' ""),
+                             ("b", showHex b' ""),
+                             ("m", showHex m' ""),
+                             ("k", showHex k  ""),
+                             ("u", showHex u  ""),
+                             ("r", showHex r  "")]
+
+egcdTest :: Int -> StdGen -> (Map String String, StdGen)
+egcdTest bitsize gen0 = (res, gen2)
+ where
+  (a, gen1)  = random gen0
+  (b, gen2)  = random gen1
+  a'         = a .&. mask bitsize
+  b'         = b .&. mask bitsize
+  g          = gcd a b
+  res        = Map.fromList [("a", showSignedHex a' ""),
+                             ("b", showSignedHex b' ""),
+                             ("g", showSignedHex g  "")]
+
+showSignedHex :: (Integral a, Num a, Show a) => a -> ShowS
+showSignedHex x str | x < 0     = "-" ++ showHex (abs x) str
+                    | otherwise = showHex x str
+
 bmodexpTest :: Int -> StdGen -> (Map String String, StdGen)
-bmodexpTest bitsize gen0 = (res, gen2)
+bmodexpTest bitsize gen0 = (res, gen3)
  where
   (b, gen1)  = random gen0
   (e, gen2)  = random gen1
   (m, gen3)  = random gen2
   [b',e',m'] = splitMod bitsize [b,e,m]
-  k         = computeK m'
-  u         = barrett bitsize m'
+  k          = computeK m'
+  u          = barrett m'
   r          = powModInteger b' e' m'
   res        = Map.fromList [("b", showHex b' ""),
                              ("e", showHex e' ""),
@@ -208,18 +307,19 @@ bmodexpTest bitsize gen0 = (res, gen2)
                              ("u", showHex u  ""),
                              ("r", showHex r  "")]
 
+base :: Integer
+base = 2 ^ (64 :: Integer)
 
-barrett :: Int -> Integer -> Integer
-barrett bitsize m = (b ^ (2 * k)) `div` m
+barrett :: Integer -> Integer
+barrett m = (base ^ (2 * k)) `div` m
  where
-  b = 2 ^ 64
   k = computeK m
 
 computeK :: Integer -> Int
 computeK v = go 0 1
  where
-  go k acc | v < acc   = k + 1
-           | otherwise = go (k + 1) (acc * (2 ^ 64))
+  go k acc | v <= acc  = k
+           | otherwise = go (k + 1) (acc * base)
 
 log :: String -> IO ()
 log str =