galois-field 0.2.1 → 0.3.0

raw patch · 14 files changed

+611/−468 lines, 14 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +17/−9
• README.md +26/−1
• benchmarks/Main.hs +31/−105
• galois-field.cabal +4/−5
• src/BinaryField.hs +115/−57
• src/ExtensionField.hs +161/−60
• src/GaloisField.hs +17/−7
• src/PolynomialRing.hs +0/−104
• src/PrimeField.hs +108/−23
• tests/BinaryFieldTests.hs +31/−0
• tests/ExtensionFieldTests.hs +52/−67
• tests/GaloisFieldTests.hs +34/−17
• tests/Main.hs +3/−1
• tests/PrimeFieldTests.hs +12/−12

@@ -1,22 +1,30 @@ # Change log for galois-field +## 0.3.0++* Add complete implementation of binary fields.+* Add `quad` function for prime fields.+* Add `sr` function for prime fields.+ ## 0.2.1-* Add preliminary implementation of BinaryField.-* Add `frob` function for GaloisField.++* Add preliminary implementation of binary fields.+* Add `frob` function for Galois fields. * Add minor improvements to documentation.  ## 0.2.0 -* Add `deg` function for GaloisField.-* Add `order` function for GaloisField.-* Add `pow` function for GaloisField.-* Add `rnd` function for GaloisField.+* Add `deg` function for Galois fields.+* Add `order` function for Galois fields.+* Add `pow` function for Galois fields.+* Add `rnd` function for Galois fields.+* Add `Random` instances for Galois fields.  ## 0.1.1 -* Add `Arbitrary` instances to PrimeField, PolynomialRing, and ExtensionField.-* Add `Bits` instances to PrimeField.-* Add `Pretty` instances to PrimeField, PolynomialRing, and ExtensionField.+* Add `Arbitrary` instances for Galois fields.+* Add `Bits` instances for prime fields.+* Add `Pretty` instances for Galois fields. * Add minor optimisations to multiplication and inversion with `INLINE`.  ## 0.1.0

@@ -4,7 +4,6 @@   </a> </p> - [![CircleCI](https://circleci.com/gh/adjoint-io/galois-field.svg?style=svg)](https://circleci.com/gh/adjoint-io/galois-field) [![Hackage](https://img.shields.io/hackage/v/galois-field.svg)](https://hackage.haskell.org/package/galois-field) @@ -32,6 +31,12 @@  For example, GF(4) has order 2^2 and can be constructed as an extension field GF(2)[X] / \<f(X)\> where f(X) = X^2 + X + 1 is an irreducible monic splitting quadratic polynomial in GF(2)[X]. +### Binary fields++A Galois field of the form GF(2^m) for big positive m is a sum of x^n for a non-empty set of 0 \< n \< m. For computational efficiency in cryptography, an element of a **binary field** can be represented by an integer that represents a bit string.++For example, X^8 + X^4 + X^3 + X + 1 can be represented as the integer 283 that represents the bit string 100011011.+ ## Example usage  Include the following required language extensions.@@ -173,6 +178,26 @@ ```haskell fromList [ fromList [fromList [a, b], fromList [c, d], fromList [e, f]]          , fromList [fromList [g, h], fromList [i, j], fromList [k, l]] ] :: Fq12+```++### Binary fields++The following type declaration creates a binary field modulo a given splitting irreducible binary polynomial.+```haskell+type F2m = BinaryField 0x80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000425+```+Note that the splitting polynomial given *must* be irreducible in F2.++Galois field arithmetic can then be performed in this binary field.+```haskell+f2m :: F2m+f2m = 0x303001d34b856296c16c0d40d3cd7750a93d1d2955fa80aa5f40fc8db7b2abdbde53950f4c0d293cdd711a35b67fb1499ae60038614f1394abfa3b4c850d927e1e7769c8eec2d19++f2m' :: F2m+f2m' = 0x37bf27342da639b6dccfffeb73d69d78c6c27a6009cbbca1980f8533921e8a684423e43bab08a576291af8f461bb2a8b3531d2f0485c19b16e2f1516e23dd3c1a4827af1b8ac15b++arithmeticF2m :: (F2m, F2m, F2m, F2m)+arithmeticF2m = (f2m + f2m', f2m - f2m', f2m * f2m', f2m / f2m') ```  ## License

@@ -2,8 +2,11 @@  import Protolude +import BinaryField import Criterion.Main import ExtensionField+import GaloisField+import GHC.Base import PrimeField  type Fq = PrimeField 21888242871839275222246405745257275088696311157297823662689037894645226208583@@ -19,55 +22,11 @@   split _ = x ^ (2 :: Int) + 1 type Fq2 = ExtensionField Fq Pu -fq2 :: Fq2-fq2 = fromList-  [ 19908898611787582971615951530393785823319364696376311494770162270472288380562-  , 2444690988583914246674870181013910409542697083717824402984851238236041783759-  ]--fq2' :: Fq2-fq2' = fromList-  [ 176307305890807650390915550856467756101144733976249050387177647283239486934-  , 9913547941088878400547309488585076816688958962210000330808066250849942240036-  ]- data Pv instance IrreducibleMonic Fq2 Pv where-  split _ = x ^ (3 :: Int) - (9 + t x)+  split _ = x ^ (3 :: Int) - 9 - t x type Fq6 = ExtensionField Fq2 Pv -fq6 :: Fq6-fq6 = fromList-  [ fromList-    [ 8727269669017421992537561450387212506711577304101544328736696625792447584819-    , 14548604791762199086915107662335514800873255588931510951007415299299859294564-    ]-  , fromList-    [ 12226353852518517213098257637254082040554292743096797524265221809863992104040-    , 12690801089710533803594523982915673248220237967492611523932652691226365708512-    ]-  , fromList-    [ 18336930404004840796680535059992401039831316705513753839479258873269709495858-    , 21634580953983557175729336703450663797341055784728343534694506874757389871868-    ]-  ]--fq6' :: Fq6-fq6' = fromList-  [ fromList-    [ 21427158918811764040959407626476119248515601360702754918240300689672054041331-    , 12750457256357562507331331307761996193149796736574153338180573114576232473092-    ]-  , fromList-    [ 19307896751125425658868292427117755307914453765471505616446813557567103424424-    , 11511704315039881938763578963465960361806962511008317843374696569679546862720-    ]-  , fromList-    [ 16856354813335682789816416666746807604324955216244680818919639213184967817815-    , 10563739714379631354612735346769824530666877338817980746884577737330686430079-    ]-  ]- data Pw instance IrreducibleMonic Fq6 Pw where   split _ = x ^ (2 :: Int) - t x@@ -137,66 +96,33 @@     ]   ] +type F2m = BinaryField 0x80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000425++f2m :: F2m+f2m = 0x303001d34b856296c16c0d40d3cd7750a93d1d2955fa80aa5f40fc8db7b2abdbde53950f4c0d293cdd711a35b67fb1499ae60038614f1394abfa3b4c850d927e1e7769c8eec2d19++f2m' :: F2m+f2m' = 0x37bf27342da639b6dccfffeb73d69d78c6c27a6009cbbca1980f8533921e8a684423e43bab08a576291af8f461bb2a8b3531d2f0485c19b16e2f1516e23dd3c1a4827af1b8ac15b++benchmark :: GaloisField k => String -> k -> k -> Benchmark+benchmark s a b = bgroup s+  [ bench "Addition" $+    whnf (uncurry (+)) (a, b)+  , bench "Multiplication" $+    whnf (uncurry (*)) (a, b)+  , bench "Negation" $+    whnf negate a+  , bench "Subtraction" $+    whnf (uncurry (-)) (a, b)+  , bench "Inversion" $+    whnf recip a+  , bench "Division" $+    whnf (uncurry (/)) (a, b)+  ]+ main :: IO () main = defaultMain-  [ bgroup "PrimeField"-    [ bgroup "Fq"-      [ bench "Addition"-        $ whnf (uncurry (+)) (fq, fq')-      , bench "Multiplication"-        $ whnf (uncurry (*)) (fq, fq')-      , bench "Negation"-        $ whnf negate fq-      , bench "Subtraction"-        $ whnf (uncurry (-)) (fq, fq')-      , bench "Inversion"-        $ whnf recip fq-      , bench "Division"-        $ whnf (uncurry (/)) (fq, fq')-      ]-    ]-  , bgroup "ExtensionField"-    [ bgroup "Fq2"-      [ bench "Addition"-        $ whnf (uncurry (+)) (fq2, fq2')-      , bench "Multiplication"-        $ whnf (uncurry (*)) (fq2, fq2')-      , bench "Negation"-        $ whnf negate fq2-      , bench "Subtraction"-        $ whnf (uncurry (-)) (fq2, fq2')-      , bench "Inversion"-        $ whnf recip fq2-      , bench "Division"-        $ whnf (uncurry (/)) (fq2, fq2')-      ]-    , bgroup "Fq6"-      [ bench "Addition"-        $ whnf (uncurry (+)) (fq6, fq6')-      , bench "Multiplication"-        $ whnf (uncurry (*)) (fq6, fq6')-      , bench "Negation"-        $ whnf negate fq6-      , bench "Subtraction"-        $ whnf (uncurry (-)) (fq6, fq6')-      , bench "Inversion"-        $ whnf recip fq6-      , bench "Division"-        $ whnf (uncurry (/)) (fq6, fq6')-      ]-    , bgroup "Fq12"-      [ bench "Addition"-        $ whnf (uncurry (+)) (fq12, fq12')-      , bench "Multiplication"-        $ whnf (uncurry (*)) (fq12, fq12')-      , bench "Negation"-        $ whnf negate fq12-      , bench "Subtraction"-        $ whnf (uncurry (-)) (fq12, fq12')-      , bench "Inversion"-        $ whnf recip fq12-      , bench "Division"-        $ whnf (uncurry (/)) (fq12, fq12')-      ]-    ]+  [ benchmark "PrimeField Fq" fq fq'+  , benchmark "ExtensionField Fq12" fq12 fq12'+  , benchmark "BinaryField F2m" f2m f2m'   ]

@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: c0b59111dcbf4f45abd61925f0a42fbe4a93dce27b89db73519e0e36afc5e8a8+-- hash: 094ec398fd4d7e6719c2a9ba616c6ca5e682b6d55f80d89d64a037adb94e845e  name:           galois-field-version:        0.2.1+version:        0.3.0 synopsis:       Galois field library description:    An efficient implementation of Galois fields used in cryptography research category:       Cryptography@@ -31,7 +31,7 @@       GaloisField       PrimeField   other-modules:-      PolynomialRing+      Paths_galois_field   hs-source-dirs:       src   default-extensions: LambdaCase RecordWildCards OverloadedStrings NoImplicitPrelude FlexibleInstances FlexibleContexts ScopedTypeVariables RankNTypes DataKinds DeriveGeneric GeneralizedNewtypeDeriving KindSignatures MultiParamTypeClasses@@ -49,13 +49,13 @@   type: exitcode-stdio-1.0   main-is: Main.hs   other-modules:+      BinaryFieldTests       ExtensionFieldTests       GaloisFieldTests       PrimeFieldTests       BinaryField       ExtensionField       GaloisField-      PolynomialRing       PrimeField       Paths_galois_field   hs-source-dirs:@@ -80,7 +80,6 @@       BinaryField       ExtensionField       GaloisField-      PolynomialRing       PrimeField       Paths_galois_field   hs-source-dirs:

@@ -10,99 +10,157 @@  import GaloisField (GaloisField(..)) +-------------------------------------------------------------------------------+-- Binary field type+-------------------------------------------------------------------------------+ -- | Binary fields @GF(2^q)[X]/\<f(X)\>@ for @q@ positive and -- @f(X)@ irreducible monic in @GF(2^q)[X]@ encoded as an integer.-newtype BinaryField (ib :: Nat) = BF Integer-  deriving (Eq, Generic, NFData, Show)---- Binary fields are arbitrary.-instance KnownNat ib => Arbitrary (BinaryField ib) where-  arbitrary = BF <$> choose (0, 2 ^ natVal (witness :: BinaryField ib) - 1)---- Binary fields are fields.-instance KnownNat ib => Fractional (BinaryField ib) where-  recip y@(BF x)      = case inv (natVal y) x of-    Just z -> BF z-    _      -> panic "no multiplicative inverse."-  {-# INLINE recip #-}-  fromRational (x:%y) = fromInteger x / fromInteger y-  {-# INLINABLE fromRational #-}+newtype BinaryField (im :: Nat) = BF Integer+  deriving (Eq, Generic, NFData, Read, Show)  -- Binary fields are Galois fields.-instance KnownNat ib => GaloisField (BinaryField ib) where-  char = const 2+instance KnownNat im => GaloisField (BinaryField im) where+  char          = const 2   {-# INLINE char #-}-  deg  = bin . natVal+  deg           = binLog . natVal   {-# INLINE deg #-}-  frob = flip pow 2+  frob          = flip pow 2   {-# INLINE frob #-}-  pow  = (^)+  pow w@(BF y) n+    | n < 0     = pow (recip w) (-n)+    | otherwise = BF (pow' 1 y n)+    where+      mul = (.) (binMod (natVal w)) . binMul+      pow' ws zs m+        | m == 0    = ws+        | m == 1    = mul ws zs+        | even m    = pow' ws (mul zs zs) (div m 2)+        | otherwise = pow' (mul ws zs) (mul zs zs) (div m 2)   {-# INLINE pow #-}-  rnd  = getRandom+  quad a b c+    | b == 0    = sr c+    | otherwise = (* (b / a)) <$> binQuad (a * c / (b * b))+  {-# INLINE quad #-}+  rnd           = getRandom   {-# INLINE rnd #-}+  sr            = panic "not implemented."+  {-# INLINE sr #-} +-------------------------------------------------------------------------------+-- Binary field instances+-------------------------------------------------------------------------------++-- Binary fields are arbitrary.+instance KnownNat im => Arbitrary (BinaryField im) where+  arbitrary = BF <$> choose (0, order (witness :: BinaryField im) - 1)+ -- Binary fields are fields.-instance KnownNat ib => Num (BinaryField ib) where+instance KnownNat im => Fractional (BinaryField im) where+  recip w@(BF x)      = BF (binInv x (natVal w))+  {-# INLINE recip #-}+  fromRational (x:%y) = fromInteger x / fromInteger y+  {-# INLINABLE fromRational #-}++-- Binary fields are rings.+instance KnownNat im => Num (BinaryField im) where   BF x + BF y = BF (xor x y)   {-# INLINE (+) #-}-  BF x * BF y = fromInteger (mul x y)+  BF x * BF y = fromInteger (binMul x y)   {-# INLINE (*) #-}   BF x - BF y = BF (xor x y)   {-# INLINE (-) #-}   negate      = identity   {-# INLINE negate #-}-  fromInteger = BF . red (natVal (witness :: BinaryField ib))+  fromInteger = BF . binMod (natVal (witness :: BinaryField im))   {-# INLINABLE fromInteger #-}   abs         = panic "not implemented."   signum      = panic "not implemented."  -- Binary fields are pretty.-instance KnownNat ib => Pretty (BinaryField ib) where+instance KnownNat im => Pretty (BinaryField im) where   pretty (BF x) = pretty x  -- Binary fields are random.-instance KnownNat ib => Random (BinaryField ib) where-  random  = first BF . randomR (0, 2 ^ natVal (witness :: BinaryField ib) - 1)+instance KnownNat im => Random (BinaryField im) where+  random  = first BF . randomR (0, order (witness :: BinaryField im) - 1)+  {-# INLINE random #-}   randomR = panic "not implemented." +-------------------------------------------------------------------------------+-- Binary field arithmetic+-------------------------------------------------------------------------------+ -- Binary logarithm.-bin :: Integer -> Int-bin = logP 2+binLog :: Integer -> Int+binLog = binLog' 2   where-    logP :: Integer -> Integer -> Int-    logP p x = let l = 2 * logP (p * p) x-               in if x < p then 0 else log' l (quot x (p ^ l))+    binLog' :: Integer -> Integer -> Int+    binLog' p x+      | x < p     = 0+      | otherwise = case binLog' (p * p) x of+        l -> let l' = 2 * l in binLog'' (quot x (p ^ l')) l'       where-        log' :: Int -> Integer -> Int-        log' q y = if y < p then q else log' (q + 1) (quot y p)-{-# INLINE bin #-}+        binLog'' :: Integer -> Int -> Int+        binLog'' y n+          | y < p     = n+          | otherwise = binLog'' (quot y p) (n + 1)+{-# INLINE binLog #-}  -- Binary multiplication.-mul :: Integer -> Integer -> Integer-mul x y = mul' (bin y) (if testBit y 0 then x else 0)+binMul :: Integer -> Integer -> Integer+binMul = binMul' 0   where-    mul' :: Int -> Integer -> Integer-    mul' 0 n = n-    mul' l n = mul' (l - 1) (if testBit y l then xor n (shift x l) else n)-{-# INLINE mul #-}+    binMul' :: Integer -> Integer -> Integer -> Integer+    binMul' n x y+      | y == 0      = n+      | testBit y 0 = binMul' (xor n x) x' y'+      | otherwise   = binMul' n x' y'+      where+        x' = shiftL x 1 :: Integer+        y' = shiftR y 1 :: Integer+{-# INLINE binMul #-} --- Binary reduction.-red :: Integer -> Integer -> Integer-red f = red'+-- Binary modulus.+binMod :: Integer -> Integer -> Integer+binMod f = binMod'   where-    red' :: Integer -> Integer-    red' x = let n = bin x - bin f-             in if n < 0 then x else red' (xor x (shift f n))-{-# INLINE red #-}+    m = binLog f :: Int+    binMod' :: Integer -> Integer+    binMod' x+      | n < 0     = x+      | otherwise = binMod' (xor x (shiftL f n))+      where+        n = binLog x - m :: Int+{-# INLINE binMod #-}  -- Binary inversion.-inv :: Integer -> Integer -> Maybe Integer-inv f x = case inv' 1 x 0 f of-  (y, 1) -> Just y-  _      -> Nothing+binInv :: Integer -> Integer -> Integer+binInv f x = case binInv' 0 1 x f of+  (y, 1) -> y+  _      -> panic "no multiplicative inverse."   where-    inv' :: Integer -> Integer -> Integer -> Integer -> (Integer, Integer)-    inv' t r _  0  = (t, r)-    inv' t r t' r' = let q = max 0 (bin r - bin r')-                     in inv' t' r' (xor t (shift t' q)) (xor r (shift r' q))-{-# INLINE inv #-}+    binInv' :: Integer -> Integer -> Integer -> Integer -> (Integer, Integer)+    binInv' s s' r r'+      | r' == 0   = (s, r)+      | otherwise = binInv' s' (xor s (shift s' q)) r' (xor r (shift r' q))+      where+        q = max 0 (binLog r - binLog r') :: Int+{-# INLINE binInv #-}++-------------------------------------------------------------------------------+-- Binary field quadratics+-------------------------------------------------------------------------------++-- Binary quadratic @y^2+y+x=0@.+binQuad :: forall im . KnownNat im+  => BinaryField im -> Maybe (BinaryField im)+binQuad x+  | sum xs /= 0 = Nothing+  | odd m       = Just (sum h)+  | otherwise   = panic "not implemented."+  where+    m  = deg x :: Int+    xs = take m (iterate (^ (2 :: Int)) x) :: [BinaryField im]+    h  = zipWith ($) (cycle [identity, const 0]) xs :: [BinaryField im]+{-# INLINE binQuad #-}

@@ -1,6 +1,6 @@ module ExtensionField   ( ExtensionField-  , IrreducibleMonic(..)+  , IrreducibleMonic(split)   , fromField   , fromList   , t@@ -14,108 +14,86 @@ import Text.PrettyPrint.Leijen.Text (Pretty(..))  import GaloisField (GaloisField(..))-import PolynomialRing (Polynomial(..), cut, polyInv, polyMul, polyQR) +-------------------------------------------------------------------------------+-- Extension field type+-------------------------------------------------------------------------------+ -- | Extension fields @GF(p^q)[X]/\<f(X)\>@ for @p@ prime, @q@ positive, and -- @f(X)@ irreducible monic in @GF(p^q)[X]@. newtype ExtensionField k im = EF (Polynomial k)-  deriving (Eq, Generic, NFData, Show)+  deriving (Eq, Generic, NFData, Read, Show)  -- | Irreducible monic splitting polynomial @f(X)@ of extension field. class IrreducibleMonic k im where   {-# MINIMAL split #-}   -- | Splitting polynomial @f(X)@.   split :: ExtensionField k im -> Polynomial k---- Extension fields are arbitrary.-instance (Arbitrary k, GaloisField k, IrreducibleMonic k im)-  => Arbitrary (ExtensionField k im) where-  arbitrary = fromList <$> vector (length xs - 1)-    where-      X xs = split (witness :: ExtensionField k im)---- Extension fields are fields.-instance (GaloisField k, IrreducibleMonic k im)-  => Fractional (ExtensionField k im) where-  recip y@(EF (X ys)) = case polyInv ys xs of-    Just zs -> EF (X zs)-    _       -> panic "no multiplicative inverse."-    where-      X xs = split y-  {-# INLINE recip #-}-  fromRational (y:%z) = fromInteger y / fromInteger z-  {-# INLINABLE fromRational #-}+  -- | Splitting polynomial list.+  plist :: ExtensionField k im -> [k]+  plist = (\(X xs) -> xs) . split  -- Extension fields are Galois fields. instance (GaloisField k, IrreducibleMonic k im)   => GaloisField (ExtensionField k im) where   char          = const (char (witness :: k))   {-# INLINE char #-}-  deg y         = deg (witness :: k) * (length xs - 1)-    where-      X xs = split y+  deg w         = deg (witness :: k) * (length (plist w) - 1)   {-# INLINE deg #-}   frob          = pow <*> char   {-# INLINE frob #-}-  pow y@(EF (X ys)) n-    | n < 0     = pow (recip y) (-n)-    | otherwise = EF (X (pow' [1] ys n))+  pow w@(EF (X y)) n+    | n < 0     = pow (recip w) (-n)+    | otherwise = EF (X (pow' [1] y n))     where-      X xs = split y-      mul = (.) (snd . flip polyQR xs) . polyMul+      mul = (.) (snd . flip polyQR (plist w)) . polyMul       pow' ws zs m         | m == 0    = ws         | m == 1    = mul ws zs         | even m    = pow' ws (mul zs zs) (div m 2)         | otherwise = pow' (mul ws zs) (mul zs zs) (div m 2)   {-# INLINE pow #-}+  quad          = panic "not implemented."+  {-# INLINE quad #-}   rnd           = getRandom   {-# INLINE rnd #-}+  sr            = panic "not implemented."+  {-# INLINE sr #-} --- Extension fields are rings.-instance (GaloisField k, IrreducibleMonic k im)-  => Num (ExtensionField k im) where-  EF y + EF z               = EF (y + z)+-------------------------------------------------------------------------------+-- Extension field conversions+-------------------------------------------------------------------------------++-- Polynomial rings.+newtype Polynomial k = X [k]+  deriving (Eq, Generic, NFData, Read, Show)++-- Polynomial rings are rings.+instance GaloisField k => Num (Polynomial k) where+  X y + X z     = X (polyAdd y z)   {-# INLINE (+) #-}-  y@(EF (X ys)) * EF (X zs) = EF (X (snd (polyQR (polyMul ys zs) xs)))-    where-      X xs = split y+  X y * X z     = X (polyMul y z)   {-# INLINE (*) #-}-  EF y - EF z               = EF (y - z)+  X y - X z     = X (polySub y z)   {-# INLINE (-) #-}-  negate (EF y)             = EF (-y)+  negate (X y)  = X (map negate y)   {-# INLINE negate #-}-  fromInteger               = EF . fromInteger+  fromInteger n = X (let m = fromInteger n in if m == 0 then [] else [m])   {-# INLINABLE fromInteger #-}-  abs                       = panic "not implemented."-  signum                    = panic "not implemented."---- Extension fields are pretty.-instance (GaloisField k, IrreducibleMonic k im)-  => Pretty (ExtensionField k im) where-  pretty (EF y) = pretty y---- Extension fields are random.-instance (GaloisField k, IrreducibleMonic k im)-  => Random (ExtensionField k im) where-  random  = first (EF . X . cut) . unfold (length xs - 1) []-    where-      X xs = split (witness :: ExtensionField k im)-      unfold n ys g = if n <= 0 then (ys, g) else-        let (y, g') = random g in unfold (n - 1) (y : ys) g'-  randomR = panic "not implemented."+  abs           = panic "not implemented."+  signum        = panic "not implemented."  -- | Convert from field element to list representation. fromField :: ExtensionField k im -> [k]-fromField (EF (X xs)) = xs+fromField (EF (X y)) = y {-# INLINABLE fromField #-}  -- | Convert from list representation to field element. fromList :: forall k im . (GaloisField k, IrreducibleMonic k im)   => [k] -> ExtensionField k im-fromList = EF . X . snd . flip polyQR xs . cut+fromList = EF . X . snd . flip polyQR (plist w) . dropZero   where-    X xs = split (witness :: ExtensionField k im)+    w = witness :: ExtensionField k im {-# INLINABLE fromList #-}  -- | Descend tower of indeterminate variables.@@ -127,3 +105,126 @@ x :: GaloisField k => Polynomial k x = X [0, 1] {-# INLINE x #-}++-------------------------------------------------------------------------------+-- Extension field instances+-------------------------------------------------------------------------------++-- Extension fields are arbitrary.+instance (Arbitrary k, GaloisField k, IrreducibleMonic k im)+  => Arbitrary (ExtensionField k im) where+  arbitrary = fromList <$>+    vector (length (plist (witness :: ExtensionField k im)) - 1)++-- Extension fields are fields.+instance (GaloisField k, IrreducibleMonic k im)+  => Fractional (ExtensionField k im) where+  recip w@(EF (X y))  = EF (X (polyInv y (plist w)))+  {-# INLINE recip #-}+  fromRational (y:%z) = fromInteger y / fromInteger z+  {-# INLINABLE fromRational #-}++-- Extension fields are rings.+instance (GaloisField k, IrreducibleMonic k im)+  => Num (ExtensionField k im) where+  EF y + EF z             = EF (y + z)+  {-# INLINE (+) #-}+  w@(EF (X y)) * EF (X z) = EF (X (snd (polyQR (polyMul y z) (plist w))))+  {-# INLINE (*) #-}+  EF y - EF z             = EF (y - z)+  {-# INLINE (-) #-}+  negate (EF y)           = EF (-y)+  {-# INLINE negate #-}+  fromInteger             = EF . fromInteger+  {-# INLINABLE fromInteger #-}+  abs                     = panic "not implemented."+  signum                  = panic "not implemented."++-- Extension fields are pretty.+instance (GaloisField k, IrreducibleMonic k im)+  => Pretty (ExtensionField k im) where+  pretty (EF (X y)) = pretty y++-- Extension fields are random.+instance (GaloisField k, IrreducibleMonic k im)+  => Random (ExtensionField k im) where+  random  = first (EF . X . dropZero) . unfold (length (plist w) - 1) []+    where+      w = witness :: ExtensionField k im+      unfold n ys g+        | n <= 0    = (ys, g)+        | otherwise = case random g of+          (y, g') -> unfold (n - 1) (y : ys) g'+  {-# INLINE random #-}+  randomR = panic "not implemented."++-------------------------------------------------------------------------------+-- Extension field arithmetic+-------------------------------------------------------------------------------++-- Polynomial drop zeroes.+dropZero :: GaloisField k => [k] -> [k]+dropZero = reverse . dropWhile (== 0) . reverse+{-# INLINABLE dropZero #-}++-- Polynomial addition.+polyAdd :: GaloisField k => [k] -> [k] -> [k]+polyAdd ys     []     = ys+polyAdd []     zs     = zs+polyAdd (y:ys) (z:zs) = let w  = y + z+                            ws = polyAdd ys zs+                        in if w == 0 && null ws then [] else w : ws+{-# INLINE polyAdd #-}++-- Polynomial multiplication.+polyMul :: GaloisField k => [k] -> [k] -> [k]+polyMul _      [] = []+polyMul []     _  = []+polyMul (y:ys) zs = let ws  = map (* y) zs+                        ws' = polyMul ys zs+                    in if null ys then ws else polyAdd ws (0 : ws')+{-# INLINE polyMul #-}++-- Polynomial subtraction.+polySub :: GaloisField k => [k] -> [k] -> [k]+polySub ys     []     = ys+polySub []     zs     = map negate zs+polySub (y:ys) (z:zs) = let w  = y - z+                            ws = polySub ys zs+                        in if w == 0 && null ws then [] else w : ws+{-# INLINE polySub #-}++-- Polynomial quotient and remainder.+polyQR :: forall k . GaloisField k => [k] -> [k] -> ([k], [k])+polyQR ys zs = polyGCD ([], ys)+  where+    z = last zs :: k+    m = length zs :: Int+    last :: [k] -> k+    last []     = 0+    last [w]    = w+    last (_:ws) = last ws+    polyGCD :: ([k], [k]) -> ([k], [k])+    polyGCD qr@(qs, rs)+      | n < 0     = qr+      | otherwise = polyGCD (polyAdd qs ts, polySub rs (polyMul ts zs))+      where+        r = last rs :: k+        n = length rs - m :: Int+        ts = replicate n 0 ++ [r / z] :: [k]+{-# INLINE polyQR #-}++-- Polynomial inverse.+polyInv :: forall k . GaloisField k => [k] -> [k] -> [k]+polyInv [y] _ = [recip y]+polyInv ys zs = case extGCD (zs, ys) of+  ([w], (ws, _)) -> map (/ w) ws+  _              -> panic "no multiplicative inverse."+  where+    extGCD :: ([k], [k]) -> ([k], ([k], [k]))+    extGCD (y, []) = (y, ([], [1]))+    extGCD (y, z)  = (g, (polySub v (polyMul u q), u))+      where+        (q, r)      = polyQR y z+        (g, (u, v)) = extGCD (z, r)+{-# INLINE polyInv #-}

@@ -8,10 +8,14 @@ import Test.Tasty.QuickCheck (Arbitrary) import Text.PrettyPrint.Leijen.Text (Pretty) +-------------------------------------------------------------------------------+-- Galois field class+-------------------------------------------------------------------------------+ -- | Galois fields @GF(p^q)@ for @p@ prime and @q@ non-negative.-class (Arbitrary k, Eq k, Fractional k, Pretty k, Random k, Show k)+class (Arbitrary k, Eq k, Fractional k, Pretty k, Random k, Read k, Show k)   => GaloisField k where-  {-# MINIMAL char, deg, frob, pow, rnd #-}+  {-# MINIMAL char, deg, frob, pow, quad, rnd, sr #-}    -- Characteristics @@ -21,18 +25,24 @@   -- | Degree @q@ of field as extension field over prime subfield.   deg :: k -> Int -  -- | Frobenius endomorphism @x->x^p@ of prime subfield.-  frob :: k -> k-   -- | Order @p^q@ of field.   order :: k -> Integer   order = (^) <$> char <*> deg   {-# INLINE order #-} +  -- | Frobenius endomorphism @x->x^p@ of prime subfield.+  frob :: k -> k+   -- Functions -  -- | Exponentiation @x@ to the power of @y@.+  -- | Exponentiation of a field element to an integer.   pow :: k -> Integer -> k -  -- | Randomised element @x@ of field.+  -- | Solve quadratic @ax^2+bx+c=0@ over field.+  quad :: k -> k -> k -> Maybe k++  -- | Randomised field element.   rnd :: MonadRandom m => m k++  -- | Square root of a field element.+  sr :: k -> Maybe k

@@ -1,104 +0,0 @@-module PolynomialRing-  ( Polynomial(..)-  , cut-  , polyInv-  , polyMul-  , polyQR-  , toPoly-  ) where--import Protolude--import Test.Tasty.QuickCheck (Arbitrary(..))-import Text.PrettyPrint.Leijen.Text (Pretty(..))--import GaloisField (GaloisField(..))--newtype Polynomial k = X [k]-  deriving (Eq, Generic, NFData, Show)--instance (Arbitrary k, GaloisField k) => Arbitrary (Polynomial k) where-  arbitrary = toPoly <$> arbitrary--instance GaloisField k => Num (Polynomial k) where-  X xs + X ys   = X (polyAdd xs ys)-  {-# INLINE (+) #-}-  X xs * X ys   = X (polyMul xs ys)-  {-# INLINE (*) #-}-  X xs - X ys   = X (polySub xs ys)-  {-# INLINE (-) #-}-  negate (X xs) = X (map negate xs)-  {-# INLINE negate #-}-  fromInteger n = X (let m = fromInteger n in if m == 0 then [] else [m])-  {-# INLINABLE fromInteger #-}-  abs           = panic "not implemented."-  signum        = panic "not implemented."--instance GaloisField k => Pretty (Polynomial k) where-  pretty (X xs) = pretty xs--polyAdd :: GaloisField k => [k] -> [k] -> [k]-polyAdd xs     []     = xs-polyAdd []     ys     = ys-polyAdd (x:xs) (y:ys) = let z  = x + y-                            zs = polyAdd xs ys-                        in if z == 0 && null zs then [] else z : zs-{-# INLINE polyAdd #-}--polyMul :: GaloisField k => [k] -> [k] -> [k]-polyMul _      [] = []-polyMul []     _  = []-polyMul (x:xs) ys = let ws = map (* x) ys-                        zs = polyMul xs ys-                    in if null xs then ws else polyAdd ws (0 : zs)-{-# INLINE polyMul #-}--polySub :: GaloisField k => [k] -> [k] -> [k]-polySub xs     []     = xs-polySub []     ys     = map negate ys-polySub (x:xs) (y:ys) = let z  = x - y-                            zs = polySub xs ys-                        in if z == 0 && null zs then [] else z : zs-{-# INLINE polySub #-}--polyQR :: forall k . GaloisField k => [k] -> [k] -> ([k], [k])-polyQR xs ys = polyGCD ([], xs)-  where-    m :: Int-    m = length ys-    polyGCD :: ([k], [k]) -> ([k], [k])-    polyGCD qr@(qs, rs)-      | n < 0     = qr-      | otherwise = polyGCD (polyAdd qs ts, polySub rs (polyMul ts ys))-      where-        n :: Int-        n = length rs - m-        ts :: [k]-        ts = replicate n 0 ++ [last rs / last ys]-        last :: [k] -> k-        last []     = 0-        last [z]    = z-        last (_:zs) = last zs-{-# INLINE polyQR #-}--polyInv :: forall k . GaloisField k => [k] -> [k] -> Maybe [k]-polyInv [x] _ = Just [recip x]-polyInv xs ps = case extGCD (ps, xs) of-  ([y], (ys, _)) -> Just (map (/ y) ys)-  _              -> Nothing-  where-    extGCD :: ([k], [k]) -> ([k], ([k], [k]))-    extGCD (y, []) = (y, ([], [1]))-    extGCD (y, x)  = (g, (polySub t (polyMul s q), s))-      where-        (q, r)      = polyQR y x-        (g, (s, t)) = extGCD (x, r)-{-# INLINE polyInv #-}--cut :: GaloisField k => [k] -> [k]-cut = reverse . dropWhile (== 0) . reverse-{-# INLINABLE cut #-}--toPoly :: GaloisField k => [k] -> Polynomial k-toPoly = X . cut-{-# INLINABLE toPoly #-}

@@ -12,20 +12,13 @@  import GaloisField (GaloisField(..)) +-------------------------------------------------------------------------------+-- Prime field type+-------------------------------------------------------------------------------+ -- | Prime fields @GF(p)@ for @p@ prime. newtype PrimeField (p :: Nat) = PF Integer-  deriving (Bits, Eq, Generic, NFData, Show)---- Prime fields are arbitrary.-instance KnownNat p => Arbitrary (PrimeField p) where-  arbitrary = fromInteger <$> arbitrary---- Prime fields are fields.-instance KnownNat p => Fractional (PrimeField p) where-  recip y@(PF x)      = PF (recipModInteger x (natVal y))-  {-# INLINE recip #-}-  fromRational (x:%y) = fromInteger x / fromInteger y-  {-# INLINABLE fromRational #-}+  deriving (Bits, Eq, Generic, NFData, Read, Show)  -- Prime fields are Galois fields. instance KnownNat p => GaloisField (PrimeField p) where@@ -35,25 +28,55 @@   {-# INLINE deg #-}   frob           = identity   {-# INLINE frob #-}-  pow y@(PF x) n = PF (powModInteger x n (natVal y))+  pow w@(PF x) n = PF (powModInteger x n (natVal w))   {-# INLINE pow #-}+  quad           = primeQuad+  {-# INLINE quad #-}   rnd            = getRandom   {-# INLINE rnd #-}+  sr w@(PF x)    = let p = natVal w+                   in if p == 2 || x == 0 then Just w else PF <$> primeSqrt p x+  {-# INLINE sr #-} +-------------------------------------------------------------------------------+-- Prime field conversions+-------------------------------------------------------------------------------++-- | Embed field element to integers.+toInt :: PrimeField p -> Integer+toInt (PF x) = x+{-# INLINABLE toInt #-}++-------------------------------------------------------------------------------+-- Prime field instances+-------------------------------------------------------------------------------++-- Prime fields are arbitrary.+instance KnownNat p => Arbitrary (PrimeField p) where+  arbitrary = fromInteger <$> arbitrary++-- Prime fields are fields.+instance KnownNat p => Fractional (PrimeField p) where+  recip w@(PF x)      = PF (if x == 0 then panic "no multiplicative inverse."+                            else recipModInteger x (natVal w))+  {-# INLINE recip #-}+  fromRational (x:%y) = fromInteger x / fromInteger y+  {-# INLINABLE fromRational #-}+ -- Prime fields are rings. instance KnownNat p => Num (PrimeField p) where-  z@(PF x) + PF y = PF (if xyp >= 0 then xyp else xy)+  w@(PF x) + PF y = PF (if xyp >= 0 then xyp else xy)     where       xy  = x + y-      xyp = xy - natVal z+      xyp = xy - natVal w   {-# INLINE (+) #-}-  z@(PF x) * PF y = PF (rem (x * y) (natVal z))+  w@(PF x) * PF y = PF (rem (x * y) (natVal w))   {-# INLINE (*) #-}-  z@(PF x) - PF y = PF (if xy >= 0 then xy else xy + natVal z)+  w@(PF x) - PF y = PF (if xy >= 0 then xy else xy + natVal w)     where       xy = x - y   {-# INLINE (-) #-}-  negate y@(PF x) = PF (if x == 0 then 0 else -x + natVal y)+  negate w@(PF x) = PF (if x == 0 then 0 else -x + natVal w)   {-# INLINE negate #-}   fromInteger x   = PF (if y >= 0 then y else y + p)     where@@ -65,14 +88,76 @@  -- Prime fields are pretty. instance KnownNat p => Pretty (PrimeField p) where-  pretty (PF x) = pretty [x]+  pretty (PF x) = pretty x  -- Prime fields are random. instance KnownNat p => Random (PrimeField p) where   random  = first PF . randomR (0, natVal (witness :: PrimeField p) - 1)+  {-# INLINE random #-}   randomR = panic "not implemented." --- | Embed field element to integers.-toInt :: PrimeField p -> Integer-toInt (PF x) = x-{-# INLINABLE toInt #-}+-------------------------------------------------------------------------------+-- Prime field quadratics+-------------------------------------------------------------------------------++-- Check quadratic nonresidue.+isQNR :: Integer -> Integer -> Bool+isQNR p n = powModInteger n (shiftR (p - 1) 1) p /= 1+{-# INLINE isQNR #-}++-- Factor binary powers.+factor2 :: Integer -> (Integer, Int)+factor2 p = factor 0 (p - 1)+  where+    factor :: Int -> Integer -> (Integer, Int)+    factor s q+      | testBit q 0 = (q, s)+      | otherwise   = factor (s + 1) (shiftR q 1)+{-# INLINE factor2 #-}++-- Get quadratic nonresidue.+getQNR :: Integer -> Integer+getQNR p+  | p7 == 3 || p7 == 5 = 2+  | otherwise          = case find (isQNR p) ps of+    Just q -> q+    _      -> panic "no quadratic nonresidue."+  where+    p7 = p .&. 7+    ps = 3 : 5 : 7 : 11 : 13 : concatMap (\x -> [x - 1, x + 1]) [18, 24 ..]+{-# INLINE getQNR #-}++-- Prime square root.+primeSqrt :: Integer -> Integer -> Maybe Integer+primeSqrt p n+  | isQNR p n = Nothing+  | otherwise = min <*> (-) p <$> case (factor2 p, getQNR p) of+    ((q, s), z) -> let zq  = powModInteger z q p+                       nq  = powModInteger n (quot q 2) p+                       nnq = rem (n * nq) p+                   in loop s zq (rem (nq * nnq) p) nnq+      where+        loop :: Int -> Integer -> Integer -> Integer -> Maybe Integer+        loop m c t r+          | t == 0    = Just 0+          | t == 1    = Just r+          | otherwise = let i  = least t 0+                            b  = powModInteger c (bit (m - i - 1)) p+                            b2 = rem (b * b) p+                        in loop i b2 (rem (t * b2) p) (rem (r * b) p)+          where+            least :: Integer -> Int -> Int+            least 1  j = j+            least ti j = least (rem (ti * ti) p) (j + 1)+{-# INLINE primeSqrt #-}++-- Prime quadratic @ax^2+bx+c=0@.+primeQuad :: KnownNat p+  => PrimeField p -> PrimeField p -> PrimeField p -> Maybe (PrimeField p)+primeQuad a b c+  | a == 0    = Nothing+  | p == 2    = if c == 0 then Just 0 else if b == 0 then Just 1 else Nothing+  | otherwise = (/ (2 * a)) . subtract b <$> sr (b * b - 4 * a * c)+  where+    p = char a :: Integer+{-# INLINE primeQuad #-}

@@ -0,0 +1,31 @@+module BinaryFieldTests where++import Protolude++import BinaryField+import Test.Tasty++import GaloisFieldTests++type F2A = BinaryField 0x20000000000000000000000000201+type F2B = BinaryField 0x80000000000000000000000000000010d+type F2C = BinaryField 0x800000000000000000000000000000000000000c9+type F2D = BinaryField 0x2000000000000000000000000000000000000000000008001+type F2E = BinaryField 0x20000000000000000000000000000000000000004000000000000000001+type F2F = BinaryField 0x800000000000000000004000000000000000000000000000000000000001+type F2G = BinaryField 0x800000000000000000000000000000000000000000000000000000000000000000010a1+type F2H = BinaryField 0x2000000000000000000000000000000000000000000000000000000000000000000000000000000008000000000000000000001+type F2I = BinaryField 0x80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000425++testBinaryField :: TestTree+testBinaryField = testGroup "Binary fields"+  [ testBF "F2A" (witness :: F2A)+  , testBF "F2B" (witness :: F2B)+  , testBF "F2C" (witness :: F2C)+  , testBF "F2D" (witness :: F2D)+  , testBF "F2E" (witness :: F2E)+  , testBF "F2F" (witness :: F2F)+  , testBF "F2G" (witness :: F2G)+  , testBF "F2H" (witness :: F2H)+  , testBF "F2I" (witness :: F2I)+  ]

@@ -3,73 +3,72 @@ import Protolude  import ExtensionField-import PolynomialRing import Test.Tasty  import GaloisFieldTests import PrimeFieldTests -data P11-instance IrreducibleMonic FS2 P11 where+data P111+instance IrreducibleMonic FS2 P111 where   split _ = x ^ (2 :: Int) + x + 1-type FS4 = ExtensionField FS2 P11+type FS4 = ExtensionField FS2 P111 -data P110-instance IrreducibleMonic FS2 P110 where+data P1101+instance IrreducibleMonic FS2 P1101 where   split _ = x ^ (3 :: Int) + x + 1-type FS8 = ExtensionField FS2 P110+type FS8 = ExtensionField FS2 P1101 -data P101-instance IrreducibleMonic FS2 P101 where+data P1011+instance IrreducibleMonic FS2 P1011 where   split _ = x ^ (3 :: Int) + x ^ (2 :: Int) + 1-type FS8' = ExtensionField FS2 P101+type FS8' = ExtensionField FS2 P1011 -data P10-instance IrreducibleMonic FS3 P10 where+data P101+instance IrreducibleMonic FS3 P101 where   split _ = x ^ (2 :: Int) + 1-type FS9 = ExtensionField FS3 P10+type FS9 = ExtensionField FS3 P101 -data P21-instance IrreducibleMonic FS3 P21 where+data P211+instance IrreducibleMonic FS3 P211 where   split _ = x ^ (2 :: Int) + x - 1-type FS9' = ExtensionField FS3 P21+type FS9' = ExtensionField FS3 P211 -data P22-instance IrreducibleMonic FS3 P22 where+data P221+instance IrreducibleMonic FS3 P221 where   split _ = x ^ (2 :: Int) - x - 1-type FS9'' = ExtensionField FS3 P22+type FS9'' = ExtensionField FS3 P221 -instance IrreducibleMonic FM0 P10 where+instance IrreducibleMonic FM0 P101 where   split _ = x ^ (2 :: Int) + 1-type FL0 = ExtensionField FM0 P10+type FL0 = ExtensionField FM0 P101 -instance IrreducibleMonic FM1 P10 where+instance IrreducibleMonic FM1 P101 where   split _ = x ^ (2 :: Int) + 1-type FL1 = ExtensionField FM1 P10+type FL1 = ExtensionField FM1 P101 -instance IrreducibleMonic FM2 P10 where+instance IrreducibleMonic FM2 P101 where   split _ = x ^ (2 :: Int) + 1-type FL2 = ExtensionField FM2 P10+type FL2 = ExtensionField FM2 P101 -instance IrreducibleMonic FM3 P10 where+instance IrreducibleMonic FM3 P101 where   split _ = x ^ (2 :: Int) + 1-type FL3 = ExtensionField FM3 P10+type FL3 = ExtensionField FM3 P101 -instance IrreducibleMonic FM4 P10 where+instance IrreducibleMonic FM4 P101 where   split _ = x ^ (2 :: Int) + 1-type FL4 = ExtensionField FM4 P10+type FL4 = ExtensionField FM4 P101 -instance IrreducibleMonic FVL P10 where+instance IrreducibleMonic FVL P101 where   split _ = x ^ (2 :: Int) + 1-type FV2 = ExtensionField FVL P10+type FV2 = ExtensionField FVL P101 -instance IrreducibleMonic FXL P10 where+instance IrreducibleMonic FXL P101 where   split _ = x ^ (2 :: Int) + 1-type FX2 = ExtensionField FXL P10+type FX2 = ExtensionField FXL P101 -instance IrreducibleMonic FZL P10 where+instance IrreducibleMonic FZL P101 where   split _ = x ^ (2 :: Int) + 1-type FZ2 = ExtensionField FZL P10+type FZ2 = ExtensionField FZL P101  data Pu instance IrreducibleMonic Fq Pu where@@ -78,7 +77,7 @@  data Pv instance IrreducibleMonic Fq2 Pv where-  split _ = x ^ (3 :: Int) - (9 + t x)+  split _ = x ^ (3 :: Int) - 9 - t x type Fq6 = ExtensionField Fq2 Pv  data Pw@@ -88,35 +87,21 @@  testExtensionField :: TestTree testExtensionField = testGroup "Extension fields"-  [ testGroup "Polynomial rings"-    [ ringAxioms "FS2[X]" (witness :: Polynomial FS2)-    , ringAxioms "FS3[X]" (witness :: Polynomial FS3)-    , ringAxioms "FS5[X]" (witness :: Polynomial FS5)-    , ringAxioms "FS7[X]" (witness :: Polynomial FS7)-    , ringAxioms "FM0[X]" (witness :: Polynomial FM0)-    , ringAxioms "FM1[X]" (witness :: Polynomial FM1)-    , ringAxioms "FM2[X]" (witness :: Polynomial FM2)-    , ringAxioms "FM3[X]" (witness :: Polynomial FM3)-    , ringAxioms "FM4[X]" (witness :: Polynomial FM4)-    , ringAxioms "FVL[X]" (witness :: Polynomial FVL)-    , ringAxioms "FXL[X]" (witness :: Polynomial FXL)-    , ringAxioms "FZL[X]" (witness :: Polynomial FZL)-    ]-  , fieldAxioms "FS4"   (witness :: FS4  )-  , fieldAxioms "FS8"   (witness :: FS8  )-  , fieldAxioms "FS8'"  (witness :: FS8' )-  , fieldAxioms "FS9"   (witness :: FS9  )-  , fieldAxioms "FS9'"  (witness :: FS9' )-  , fieldAxioms "FS9''" (witness :: FS9'')-  , fieldAxioms "FL0"   (witness :: FL0  )-  , fieldAxioms "FL1"   (witness :: FL1  )-  , fieldAxioms "FL2"   (witness :: FL2  )-  , fieldAxioms "FL3"   (witness :: FL3  )-  , fieldAxioms "FL4"   (witness :: FL4  )-  , fieldAxioms "FV2"   (witness :: FV2  )-  , fieldAxioms "FX2"   (witness :: FX2  )-  , fieldAxioms "FZ2"   (witness :: FZ2  )-  , fieldAxioms "Fq2"   (witness :: Fq2  )-  , fieldAxioms "Fq6"   (witness :: Fq6  )-  , fieldAxioms "Fq12"  (witness :: Fq12 )+  [ testEF "FS4"   (witness :: FS4  )+  , testEF "FS8"   (witness :: FS8  )+  , testEF "FS8'"  (witness :: FS8' )+  , testEF "FS9"   (witness :: FS9  )+  , testEF "FS9'"  (witness :: FS9' )+  , testEF "FS9''" (witness :: FS9'')+  , testEF "FL0"   (witness :: FL0  )+  , testEF "FL1"   (witness :: FL1  )+  , testEF "FL2"   (witness :: FL2  )+  , testEF "FL3"   (witness :: FL3  )+  , testEF "FL4"   (witness :: FL4  )+  , testEF "FV2"   (witness :: FV2  )+  , testEF "FX2"   (witness :: FX2  )+  , testEF "FZ2"   (witness :: FZ2  )+  , testEF "Fq2"   (witness :: Fq2  )+  , testEF "Fq6"   (witness :: Fq6  )+  , testEF "Fq12"  (witness :: Fq12 )   ]

@@ -2,6 +2,7 @@  import Protolude +import GaloisField import Test.Tasty import Test.Tasty.QuickCheck @@ -21,31 +22,47 @@ inverses :: Eq a => (a -> a -> a) -> (a -> a) -> a -> a -> Bool inverses op inv e x = op x (inv x) == e && op (inv x) x == e -ringAxioms :: forall r . (Arbitrary r, Eq r, Num r, Show r)-  => TestName -> r -> TestTree-ringAxioms s _ = testGroup ("Ring axioms of " <> s)+fieldAxioms :: forall k . GaloisField k => k -> TestTree+fieldAxioms _ = testGroup ("Field axioms")   [ testProperty "commutativity of addition"-    $ commutativity ((+) :: r -> r -> r)+    $ commutativity ((+) :: k -> k -> k)   , testProperty "commutativity of multiplication"-    $ commutativity ((*) :: r -> r -> r)+    $ commutativity ((*) :: k -> k -> k)   , testProperty "associativity of addition"-    $ associativity ((+) :: r -> r -> r)+    $ associativity ((+) :: k -> k -> k)   , testProperty "associativity of multiplication"-    $ associativity ((*) :: r -> r -> r)+    $ associativity ((*) :: k -> k -> k)   , testProperty "distributivity of multiplication over addition"-    $ distributivity ((*) :: r -> r -> r) (+)+    $ distributivity ((*) :: k -> k -> k) (+)   , testProperty "additive identity"-    $ identities ((+) :: r -> r -> r) 0+    $ identities ((+) :: k -> k -> k) 0   , testProperty "multiplicative identity"-    $ identities ((*) :: r -> r -> r) 1+    $ identities ((*) :: k -> k -> k) 1   , testProperty "additive inverses"-    $ inverses ((+) :: r -> r -> r) negate 0+    $ inverses ((+) :: k -> k -> k) negate 0+  , testProperty "multiplicative inverses"+    $ \x -> x /= 0 ==> inverses ((*) :: k -> k -> k) recip 1 x   ] -fieldAxioms :: forall k . (Arbitrary k, Eq k, Fractional k, Show k)-  => TestName -> k -> TestTree-fieldAxioms s k = testGroup ("Field axioms of " <> s)-  [ ringAxioms s k-  , testProperty "multiplicative inverses"-    $ \n -> n /= 0 ==> inverses ((*) :: k -> k -> k) recip 1 n+squareRoots :: forall k . GaloisField k => k -> TestTree+squareRoots _ = testGroup "Square roots"+  [ testProperty "squares of square roots"+    $ \(x :: k) -> isJust (sr x)+      ==> (((^ (2 :: Int)) <$> sr x) == Just x)   ]++quadraticEquations :: forall k . GaloisField k => k -> TestTree+quadraticEquations _ = testGroup "Quadratic equations"+  [ testProperty "solutions of quadratic equations"+    $ \(a :: k) (b :: k) (c :: k) -> a /= 0 && b /= 0 && isJust (quad a b c)+      ==> (((\x -> a * x * x + b * x + c) <$> quad a b c) == Just 0)+  ]++test :: forall k . GaloisField k => TestName -> k -> TestTree+test s x = testGroup s [fieldAxioms x, squareRoots x, quadraticEquations x]++testEF :: forall k . GaloisField k => TestName -> k -> TestTree+testEF s x = testGroup s [fieldAxioms x]++testBF :: forall k . GaloisField k => TestName -> k -> TestTree+testBF s x = testGroup s [fieldAxioms x]

@@ -4,8 +4,10 @@  import Test.Tasty +import BinaryFieldTests import ExtensionFieldTests import PrimeFieldTests  main :: IO ()-main = defaultMain $ testGroup "Tests" [testPrimeField, testExtensionField]+main = defaultMain $+  testGroup "Tests" [testPrimeField, testExtensionField, testBinaryField]

@@ -26,16 +26,16 @@  testPrimeField :: TestTree testPrimeField = testGroup "Prime fields"-  [ fieldAxioms "FS2" (witness :: FS2)-  , fieldAxioms "FS3" (witness :: FS3)-  , fieldAxioms "FS5" (witness :: FS5)-  , fieldAxioms "FS7" (witness :: FS7)-  , fieldAxioms "FM0" (witness :: FM0)-  , fieldAxioms "FM1" (witness :: FM1)-  , fieldAxioms "FM2" (witness :: FM2)-  , fieldAxioms "FM3" (witness :: FM3)-  , fieldAxioms "FM4" (witness :: FM4)-  , fieldAxioms "FVL" (witness :: FVL)-  , fieldAxioms "FXL" (witness :: FXL)-  , fieldAxioms "FZL" (witness :: FZL)+  [ test "FS2" (witness :: FS2)+  , test "FS3" (witness :: FS3)+  , test "FS5" (witness :: FS5)+  , test "FS7" (witness :: FS7)+  , test "FM0" (witness :: FM0)+  , test "FM1" (witness :: FM1)+  , test "FM2" (witness :: FM2)+  , test "FM3" (witness :: FM3)+  , test "FM4" (witness :: FM4)+  , test "FVL" (witness :: FVL)+  , test "FXL" (witness :: FXL)+  , test "FZL" (witness :: FZL)   ]