galois-field 0.3.0 → 0.4.0

raw patch · 15 files changed

+688/−547 lines, 15 filesdep +polydep +semiringsdep +vectordep ~basedep ~protoludePVP ok

version bump matches the API change (PVP)

Dependencies added: poly, semirings, vector

Dependency ranges changed: base, protolude

API changes (from Hackage documentation)

Files

• ChangeLog.md +11/−0
• README.md +31/−28
• benchmarks/BinaryFieldBenchmarks.hs +17/−0
• benchmarks/ExtensionFieldBenchmarks.hs +91/−0
• benchmarks/GaloisFieldBenchmarks.hs +23/−0
• benchmarks/Main.hs +4/−119
• benchmarks/PrimeFieldBenchmarks.hs +17/−0
• galois-field.cabal +24/−11
• src/BinaryField.hs +68/−55
• src/ExtensionField.hs +126/−164
• src/GaloisField.hs +146/−10
• src/PrimeField.hs +82/−105
• tests/BinaryFieldTests.hs +9/−9
• tests/ExtensionFieldTests.hs +34/−34
• tests/GaloisFieldTests.hs +5/−12

@@ -1,5 +1,16 @@ # Change log for galois-field +## 0.4.0++* Add `Vector` implementation of extension fields.+* Add `qnr` function for Galois fields.+* Add `qr` function for Galois fields.+* Add `quad` function for extension fields and binary fields.+* Add `sr` function for extension fields and binary fields.+* Add `Semiring` instances for Galois fields.+* Add `Ord` instances for Galois fields.+* Add minor optimisations to exponentiation with `RULES`.+ ## 0.3.0  * Add complete implementation of binary fields.

@@ -33,7 +33,7 @@  ### 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.+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. It should always be used when the field characteristic is 2.  For example, X^8 + X^4 + X^3 + X + 1 can be represented as the integer 283 that represents the bit string 100011011. @@ -44,11 +44,14 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PatternSynonyms #-} ``` Import the following functions at minimum. ```haskell import PrimeField (PrimeField)-import ExtensionField (ExtensionField, IrreducibleMonic(split), fromList, t, x)+import ExtensionField (ExtensionField, IrreducibleMonic(split), toField,+                       pattern X, pattern X2, pattern X3, pattern Y)+import BinaryField (BinaryField) ```  ### Prime fields@@ -77,7 +80,7 @@ ```haskell data P2 instance IrreducibleMonic Fq P2 where-  split _ = x^2 + 1+  split _ = X2 + 1 ``` The following type declaration then creates an extension field with this splitting polynomial. ```haskell@@ -89,46 +92,46 @@ ```haskell data P6 instance IrreducibleMonic Fq2 P6 where-  split _ = x^3 - (9 + t x)+  split _ = X3 - (9 + Y X)  type Fq6 = ExtensionField Fq2 P6  data P12 instance IrreducibleMonic Fq6 P12 where-  split _ = x^2 - t x+  split _ = X2 - Y X  type Fq12 = ExtensionField Fq6 P12 ```-Note that `x` accesses the current indeterminate variable and `t` descends the tower of indeterminate variables.+Note that `X, X2, X3` accesses the current indeterminate variables and `Y` descends the tower of indeterminate variables.  Galois field arithmetic can then be performed in this extension field. ```haskell fq12 :: Fq12-fq12 = fromList-  [ fromList-    [ fromList+fq12 = toField+  [ toField+    [ toField       [ 4025484419428246835913352650763180341703148406593523188761836807196412398582       , 5087667423921547416057913184603782240965080921431854177822601074227980319916       ]-    , fromList+    , toField       [ 8868355606921194740459469119392835913522089996670570126495590065213716724895       , 12102922015173003259571598121107256676524158824223867520503152166796819430680       ]-    , fromList+    , toField       [ 92336131326695228787620679552727214674825150151172467042221065081506740785       , 5482141053831906120660063289735740072497978400199436576451083698548025220729       ]     ]-  , fromList-    [ fromList+  , toField+    [ toField       [ 7642691434343136168639899684817459509291669149586986497725240920715691142493       , 1211355239100959901694672926661748059183573115580181831221700974591509515378       ]-    , fromList+    , toField       [ 20725578899076721876257429467489710434807801418821512117896292558010284413176       , 17642016461759614884877567642064231230128683506116557502360384546280794322728       ]-    , fromList+    , toField       [ 17449282511578147452934743657918270744212677919657988500433959352763226500950       , 1205855382909824928004884982625565310515751070464736233368671939944606335817       ]@@ -136,31 +139,31 @@   ]  fq12' :: Fq12-fq12' = fromList-  [ fromList-    [ fromList+fq12' = toField+  [ toField+    [ toField       [ 495492586688946756331205475947141303903957329539236899715542920513774223311       , 9283314577619389303419433707421707208215462819919253486023883680690371740600       ]-    , fromList+    , toField       [ 11142072730721162663710262820927009044232748085260948776285443777221023820448       , 1275691922864139043351956162286567343365697673070760209966772441869205291758       ]-    , fromList+    , toField       [ 20007029371545157738471875537558122753684185825574273033359718514421878893242       , 9839139739201376418106411333971304469387172772449235880774992683057627654905       ]     ]-  , fromList-    [ fromList+  , toField+    [ toField       [ 9503058454919356208294350412959497499007919434690988218543143506584310390240       , 19236630380322614936323642336645412102299542253751028194541390082750834966816       ]-    , fromList+    , toField       [ 18019769232924676175188431592335242333439728011993142930089933693043738917983       , 11549213142100201239212924317641009159759841794532519457441596987622070613872       ]-    , fromList+    , toField       [ 9656683724785441232932664175488314398614795173462019188529258009817332577664       , 20666848762667934776817320505559846916719041700736383328805334359135638079015       ]@@ -172,12 +175,12 @@ ``` Note that ```-a + bx + (c + dx)y + (e + fx)y^2 + (g + hx + (i + jx)y + (k + lx)y^2)z+a + bX + (c + dX)Y + (e + fX)Y^2 + (g + hX + (i + jX)Y + (k + lX)Y^2)Z ```-where `x, y, z` is a tower of indeterminate variables is constructed by+where `X, Y, Z` is a tower of indeterminate variables, is constructed by ```haskell-fromList [ fromList [fromList [a, b], fromList [c, d], fromList [e, f]]-         , fromList [fromList [g, h], fromList [i, j], fromList [k, l]] ] :: Fq12+toField [ toField [toField [a, b], toField [c, d], toField [e, f]]+        , toField [toField [g, h], toField [i, j], toField [k, l]] ] :: Fq12 ```  ### Binary fields

@@ -0,0 +1,17 @@+module BinaryFieldBenchmarks where++import BinaryField+import Criterion.Main++import GaloisFieldBenchmarks++type F2m = BinaryField 0x80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000425++f2m :: F2m+f2m = 0x303001d34b856296c16c0d40d3cd7750a93d1d2955fa80aa5f40fc8db7b2abdbde53950f4c0d293cdd711a35b67fb1499ae60038614f1394abfa3b4c850d927e1e7769c8eec2d19++f2m' :: F2m+f2m' = 0x37bf27342da639b6dccfffeb73d69d78c6c27a6009cbbca1980f8533921e8a684423e43bab08a576291af8f461bb2a8b3531d2f0485c19b16e2f1516e23dd3c1a4827af1b8ac15b++benchmarkBinaryField :: Benchmark+benchmarkBinaryField = benchmark "BinaryField F2m" f2m f2m'

@@ -0,0 +1,91 @@+module ExtensionFieldBenchmarks where++import Protolude++import Criterion.Main+import ExtensionField++import GaloisFieldBenchmarks+import PrimeFieldBenchmarks++data Pu+instance IrreducibleMonic Fq Pu where+  split _ = X2 + 1+type Fq2 = ExtensionField Fq Pu++data Pv+instance IrreducibleMonic Fq2 Pv where+  split _ = X3 - 9 - Y X+type Fq6 = ExtensionField Fq2 Pv++data Pw+instance IrreducibleMonic Fq6 Pw where+  split _ = X2 - Y X+type Fq12 = ExtensionField Fq6 Pw++fq12 :: Fq12+fq12 = toField+  [ toField+    [ toField+      [ 4025484419428246835913352650763180341703148406593523188761836807196412398582+      , 5087667423921547416057913184603782240965080921431854177822601074227980319916+      ]+    , toField+      [ 8868355606921194740459469119392835913522089996670570126495590065213716724895+      , 12102922015173003259571598121107256676524158824223867520503152166796819430680+      ]+    , toField+      [ 92336131326695228787620679552727214674825150151172467042221065081506740785+      , 5482141053831906120660063289735740072497978400199436576451083698548025220729+      ]+    ]+  , toField+    [ toField+      [ 7642691434343136168639899684817459509291669149586986497725240920715691142493+      , 1211355239100959901694672926661748059183573115580181831221700974591509515378+      ]+    , toField+      [ 20725578899076721876257429467489710434807801418821512117896292558010284413176+      , 17642016461759614884877567642064231230128683506116557502360384546280794322728+      ]+    , toField+      [ 17449282511578147452934743657918270744212677919657988500433959352763226500950+      , 1205855382909824928004884982625565310515751070464736233368671939944606335817+      ]+    ]+  ]++fq12' :: Fq12+fq12' = toField+  [ toField+    [ toField+      [ 495492586688946756331205475947141303903957329539236899715542920513774223311+      , 9283314577619389303419433707421707208215462819919253486023883680690371740600+      ]+    , toField+      [ 11142072730721162663710262820927009044232748085260948776285443777221023820448+      , 1275691922864139043351956162286567343365697673070760209966772441869205291758+      ]+    , toField+      [ 20007029371545157738471875537558122753684185825574273033359718514421878893242+      , 9839139739201376418106411333971304469387172772449235880774992683057627654905+      ]+    ]+  , toField+    [ toField+      [ 9503058454919356208294350412959497499007919434690988218543143506584310390240+      , 19236630380322614936323642336645412102299542253751028194541390082750834966816+      ]+    , toField+      [ 18019769232924676175188431592335242333439728011993142930089933693043738917983+      , 11549213142100201239212924317641009159759841794532519457441596987622070613872+      ]+    , toField+      [ 9656683724785441232932664175488314398614795173462019188529258009817332577664+      , 20666848762667934776817320505559846916719041700736383328805334359135638079015+      ]+    ]+  ]++benchmarkExtensionField :: Benchmark+benchmarkExtensionField = benchmark "ExtensionField Fq12" fq12 fq12'

@@ -0,0 +1,23 @@+module GaloisFieldBenchmarks where++import Protolude++import Criterion.Main+import GaloisField+import GHC.Base++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)+  ]

@@ -2,127 +2,12 @@  import Protolude -import BinaryField import Criterion.Main-import ExtensionField-import GaloisField-import GHC.Base-import PrimeField -type Fq = PrimeField 21888242871839275222246405745257275088696311157297823662689037894645226208583--fq :: Fq-fq = 5216004179354450092383934373463611881445186046129513844852096383579774061693--fq' :: Fq-fq' = 10757805228921058098980668000791497318123219899766237205512608761387909753942--data Pu-instance IrreducibleMonic Fq Pu where-  split _ = x ^ (2 :: Int) + 1-type Fq2 = ExtensionField Fq Pu--data Pv-instance IrreducibleMonic Fq2 Pv where-  split _ = x ^ (3 :: Int) - 9 - t x-type Fq6 = ExtensionField Fq2 Pv--data Pw-instance IrreducibleMonic Fq6 Pw where-  split _ = x ^ (2 :: Int) - t x-type Fq12 = ExtensionField Fq6 Pw--fq12 :: Fq12-fq12 = fromList-  [ fromList-    [ fromList-      [ 4025484419428246835913352650763180341703148406593523188761836807196412398582-      , 5087667423921547416057913184603782240965080921431854177822601074227980319916-      ]-    , fromList-      [ 8868355606921194740459469119392835913522089996670570126495590065213716724895-      , 12102922015173003259571598121107256676524158824223867520503152166796819430680-      ]-    , fromList-      [ 92336131326695228787620679552727214674825150151172467042221065081506740785-      , 5482141053831906120660063289735740072497978400199436576451083698548025220729-      ]-    ]-  , fromList-    [ fromList-      [ 7642691434343136168639899684817459509291669149586986497725240920715691142493-      , 1211355239100959901694672926661748059183573115580181831221700974591509515378-      ]-    , fromList-      [ 20725578899076721876257429467489710434807801418821512117896292558010284413176-      , 17642016461759614884877567642064231230128683506116557502360384546280794322728-      ]-    , fromList-      [ 17449282511578147452934743657918270744212677919657988500433959352763226500950-      , 1205855382909824928004884982625565310515751070464736233368671939944606335817-      ]-    ]-  ]--fq12' :: Fq12-fq12' = fromList-  [ fromList-    [ fromList-      [ 495492586688946756331205475947141303903957329539236899715542920513774223311-      , 9283314577619389303419433707421707208215462819919253486023883680690371740600-      ]-    , fromList-      [ 11142072730721162663710262820927009044232748085260948776285443777221023820448-      , 1275691922864139043351956162286567343365697673070760209966772441869205291758-      ]-    , fromList-      [ 20007029371545157738471875537558122753684185825574273033359718514421878893242-      , 9839139739201376418106411333971304469387172772449235880774992683057627654905-      ]-    ]-  , fromList-    [ fromList-      [ 9503058454919356208294350412959497499007919434690988218543143506584310390240-      , 19236630380322614936323642336645412102299542253751028194541390082750834966816-      ]-    , fromList-      [ 18019769232924676175188431592335242333439728011993142930089933693043738917983-      , 11549213142100201239212924317641009159759841794532519457441596987622070613872-      ]-    , fromList-      [ 9656683724785441232932664175488314398614795173462019188529258009817332577664-      , 20666848762667934776817320505559846916719041700736383328805334359135638079015-      ]-    ]-  ]--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)-  ]+import BinaryFieldBenchmarks+import ExtensionFieldBenchmarks+import PrimeFieldBenchmarks  main :: IO () main = defaultMain-  [ benchmark "PrimeField Fq" fq fq'-  , benchmark "ExtensionField Fq12" fq12 fq12'-  , benchmark "BinaryField F2m" f2m f2m'-  ]+  [benchmarkBinaryField, benchmarkExtensionField, benchmarkPrimeField]

@@ -0,0 +1,17 @@+module PrimeFieldBenchmarks where++import Criterion.Main+import PrimeField++import GaloisFieldBenchmarks++type Fq = PrimeField 21888242871839275222246405745257275088696311157297823662689037894645226208583++fq :: Fq+fq = 5216004179354450092383934373463611881445186046129513844852096383579774061693++fq' :: Fq+fq' = 10757805228921058098980668000791497318123219899766237205512608761387909753942++benchmarkPrimeField :: Benchmark+benchmarkPrimeField = benchmark "PrimeField Fq" fq fq'

@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 094ec398fd4d7e6719c2a9ba616c6ca5e682b6d55f80d89d64a037adb94e845e+-- hash: 033214ea0f37604de3c3e831efac36ce0278f2f57df82216bf93635ec31dc830  name:           galois-field-version:        0.3.0+version:        0.4.0 synopsis:       Galois field library description:    An efficient implementation of Galois fields used in cryptography research category:       Cryptography@@ -34,14 +34,17 @@       Paths_galois_field   hs-source-dirs:       src-  default-extensions: LambdaCase RecordWildCards OverloadedStrings NoImplicitPrelude FlexibleInstances FlexibleContexts ScopedTypeVariables RankNTypes DataKinds DeriveGeneric GeneralizedNewtypeDeriving KindSignatures MultiParamTypeClasses+  default-extensions: LambdaCase RecordWildCards OverloadedStrings NoImplicitPrelude FlexibleInstances FlexibleContexts ScopedTypeVariables RankNTypes DataKinds DeriveGeneric GeneralizedNewtypeDeriving KindSignatures MultiParamTypeClasses PatternSynonyms   ghc-options: -O2 -Wall   build-depends:       MonadRandom-    , base >=4.7 && <5+    , base >=4.10 && <5     , integer-gmp-    , protolude >=0.2+    , poly+    , protolude+    , semirings     , tasty-quickcheck+    , vector     , wl-pprint-text   default-language: Haskell2010 @@ -61,15 +64,18 @@   hs-source-dirs:       tests       src-  default-extensions: LambdaCase RecordWildCards OverloadedStrings NoImplicitPrelude FlexibleInstances FlexibleContexts ScopedTypeVariables RankNTypes DataKinds DeriveGeneric GeneralizedNewtypeDeriving KindSignatures MultiParamTypeClasses+  default-extensions: LambdaCase RecordWildCards OverloadedStrings NoImplicitPrelude FlexibleInstances FlexibleContexts ScopedTypeVariables RankNTypes DataKinds DeriveGeneric GeneralizedNewtypeDeriving KindSignatures MultiParamTypeClasses PatternSynonyms   ghc-options: -O2 -Wall -main-is Main   build-depends:       MonadRandom-    , base >=4.7 && <5+    , base >=4.10 && <5     , integer-gmp-    , protolude >=0.2+    , poly+    , protolude+    , semirings     , tasty     , tasty-quickcheck+    , vector     , wl-pprint-text   default-language: Haskell2010 @@ -77,6 +83,10 @@   type: exitcode-stdio-1.0   main-is: Main.hs   other-modules:+      BinaryFieldBenchmarks+      ExtensionFieldBenchmarks+      GaloisFieldBenchmarks+      PrimeFieldBenchmarks       BinaryField       ExtensionField       GaloisField@@ -85,14 +95,17 @@   hs-source-dirs:       benchmarks       src-  default-extensions: LambdaCase RecordWildCards OverloadedStrings NoImplicitPrelude FlexibleInstances FlexibleContexts ScopedTypeVariables RankNTypes DataKinds DeriveGeneric GeneralizedNewtypeDeriving KindSignatures MultiParamTypeClasses+  default-extensions: LambdaCase RecordWildCards OverloadedStrings NoImplicitPrelude FlexibleInstances FlexibleContexts ScopedTypeVariables RankNTypes DataKinds DeriveGeneric GeneralizedNewtypeDeriving KindSignatures MultiParamTypeClasses PatternSynonyms   ghc-options: -O2 -Wall -main-is Main   build-depends:       MonadRandom-    , base >=4.7 && <5+    , base >=4.10 && <5     , criterion     , integer-gmp-    , protolude >=0.2+    , poly+    , protolude+    , semirings     , tasty-quickcheck+    , vector     , wl-pprint-text   default-language: Haskell2010

@@ -2,22 +2,24 @@   ( BinaryField   ) where -import Protolude+import Protolude as P hiding (Semiring) -import Control.Monad.Random (Random(..), getRandom)+import Control.Monad.Random (Random(..))+import Data.Euclidean (Euclidean(..), GcdDomain(..))+import Data.Semiring (Ring(..), Semiring(..)) import Test.Tasty.QuickCheck (Arbitrary(..), choose) import Text.PrettyPrint.Leijen.Text (Pretty(..)) -import GaloisField (GaloisField(..))+import GaloisField (Field(..), GaloisField(..))  ---------------------------------------------------------------------------------- Binary field type+-- Data types -------------------------------------------------------------------------------  -- | 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 (im :: Nat) = BF Integer-  deriving (Eq, Generic, NFData, Read, Show)+  deriving (Eq, Generic, Ord, Show)  -- Binary fields are Galois fields. instance KnownNat im => GaloisField (BinaryField im) where@@ -27,46 +29,27 @@   {-# INLINE deg #-}   frob          = flip pow 2   {-# INLINE frob #-}-  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 #-}-  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 #-} +{-# RULES "BinaryField/pow"+  forall (k :: KnownNat im => BinaryField im) n . (^) k n = pow k n+  #-}+ ---------------------------------------------------------------------------------- Binary field instances+-- Numeric 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.+-- Binary fields are fractional. instance KnownNat im => Fractional (BinaryField im) where-  recip w@(BF x)      = BF (binInv x (natVal w))+  recip (BF x)        = BF (binInv x (natVal (witness :: BinaryField im)))   {-# INLINE recip #-}   fromRational (x:%y) = fromInteger x / fromInteger y   {-# INLINABLE fromRational #-} --- Binary fields are rings.+-- Binary fields are numeric. instance KnownNat im => Num (BinaryField im) where   BF x + BF y = BF (xor x y)   {-# INLINE (+) #-}-  BF x * BF y = fromInteger (binMul x y)+  BF x * BF y = BF (binMul (natVal (witness :: BinaryField im)) x y)   {-# INLINE (*) #-}   BF x - BF y = BF (xor x y)   {-# INLINE (-) #-}@@ -77,6 +60,53 @@   abs         = panic "not implemented."   signum      = panic "not implemented." +-------------------------------------------------------------------------------+-- Semiring instances+-------------------------------------------------------------------------------++-- Binary fields are Euclidean domains.+instance KnownNat im => Euclidean (BinaryField im) where+  quotRem = (flip (,) 0 .) . (/)+  {-# INLINE quotRem #-}+  degree  = panic "not implemented."+  {-# INLINE degree #-}++-- Binary fields are fields.+instance KnownNat im => Field (BinaryField im) where+  invert = recip+  {-# INLINE invert #-}+  minus  = (-)+  {-# INLINE minus #-}++-- Binary fields are GCD domains.+instance KnownNat im => GcdDomain (BinaryField im)++-- Binary fields are rings.+instance KnownNat im => Ring (BinaryField im) where+  negate = P.negate+  {-# INLINE negate #-}++-- Binary fields are semirings.+instance KnownNat im => Semiring (BinaryField im) where+  zero        = 0+  {-# INLINE zero #-}+  plus        = (+)+  {-# INLINE plus #-}+  one         = 1+  {-# INLINE one #-}+  times       = (*)+  {-# INLINE times #-}+  fromNatural = fromIntegral+  {-# INLINE fromNatural #-}++-------------------------------------------------------------------------------+-- Other instances+-------------------------------------------------------------------------------++-- Binary fields are arbitrary.+instance KnownNat im => Arbitrary (BinaryField im) where+  arbitrary = BF <$> choose (0, order (witness :: BinaryField im) - 1)+ -- Binary fields are pretty. instance KnownNat im => Pretty (BinaryField im) where   pretty (BF x) = pretty x@@ -88,7 +118,7 @@   randomR = panic "not implemented."  ---------------------------------------------------------------------------------- Binary field arithmetic+-- Binary arithmetic -------------------------------------------------------------------------------  -- Binary logarithm.@@ -99,17 +129,17 @@     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'+        l -> let l' = 2 * l in binLog'' (P.quot x (p ^ l')) l'       where         binLog'' :: Integer -> Int -> Int         binLog'' y n           | y < p     = n-          | otherwise = binLog'' (quot y p) (n + 1)+          | otherwise = binLog'' (P.quot y p) (n + 1) {-# INLINE binLog #-}  -- Binary multiplication.-binMul :: Integer -> Integer -> Integer-binMul = binMul' 0+binMul :: Integer -> Integer -> Integer -> Integer+binMul = (. binMul' 0) . (.) . binMod   where     binMul' :: Integer -> Integer -> Integer -> Integer     binMul' n x y@@ -147,20 +177,3 @@       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,230 +1,192 @@ module ExtensionField   ( ExtensionField+  , PolynomialRing   , IrreducibleMonic(split)   , fromField-  , fromList-  , t-  , x+  , toField+  , pattern X+  , pattern X2+  , pattern X3+  , pattern Y   ) where -import Protolude+import Protolude as P hiding (Semiring, quot, quotRem, rem) -import Control.Monad.Random (Random(..), getRandom)+import Control.Monad.Random (Random(..))+import Data.Euclidean (Euclidean(..), GcdDomain(..))+import Data.Poly.Semiring (VPoly, leading, monomial, scale, toPoly, unPoly, pattern X)+import Data.Semiring as S (Ring(..), Semiring(..))+import Data.Vector (fromList) import Test.Tasty.QuickCheck (Arbitrary(..), vector) import Text.PrettyPrint.Leijen.Text (Pretty(..)) -import GaloisField (GaloisField(..))+import GaloisField (Field(..), GaloisField(..))  ---------------------------------------------------------------------------------- Extension field type+-- Data types -------------------------------------------------------------------------------  -- | 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, Read, Show)+newtype ExtensionField k im = EF (VPoly k)+  deriving (Eq, Generic, Ord, Show) +-- | Polynomial rings.+type PolynomialRing = VPoly+ -- | Irreducible monic splitting polynomial @f(X)@ of extension field.-class IrreducibleMonic k im where+class GaloisField k => IrreducibleMonic k im where   {-# MINIMAL split #-}   -- | Splitting polynomial @f(X)@.-  split :: ExtensionField k im -> Polynomial k-  -- | Splitting polynomial list.-  plist :: ExtensionField k im -> [k]-  plist = (\(X xs) -> xs) . split+  split :: ExtensionField k im -> VPoly k+  -- | Splitting polynomial degree.+  deg' :: ExtensionField k im -> Int+  deg' = pred . fromIntegral . degree . split  -- Extension fields are Galois fields.-instance (GaloisField k, IrreducibleMonic k im)-  => GaloisField (ExtensionField k im) where+instance IrreducibleMonic k im => GaloisField (ExtensionField k im) where   char          = const (char (witness :: k))   {-# INLINE char #-}-  deg w         = deg (witness :: k) * (length (plist w) - 1)+  deg           = (deg (witness :: k) *) . deg'   {-# INLINE deg #-}   frob          = pow <*> char   {-# INLINE frob #-}-  pow w@(EF (X y)) n-    | n < 0     = pow (recip w) (-n)-    | otherwise = EF (X (pow' [1] y n))-    where-      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 #-} +{-# RULES "ExtensionField/pow"+  forall (k :: IrreducibleMonic k im => ExtensionField k im) n . (^) k n = pow k n+  #-}+ ---------------------------------------------------------------------------------- Extension field conversions+-- Numeric instances ------------------------------------------------------------------------------- --- Polynomial rings.-newtype Polynomial k = X [k]-  deriving (Eq, Generic, NFData, Read, Show)+-- Extension fields are fractional.+instance IrreducibleMonic k im => Fractional (ExtensionField k im) where+  recip (EF x)        = EF (polyInv x (split (witness :: ExtensionField k im)))+  {-# INLINE recip #-}+  fromRational (x:%y) = fromInteger x / fromInteger y+  {-# INLINABLE fromRational #-} --- Polynomial rings are rings.-instance GaloisField k => Num (Polynomial k) where-  X y + X z     = X (polyAdd y z)+-- Extension fields are numeric.+instance IrreducibleMonic k im => Num (ExtensionField k im) where+  EF x + EF y   = EF (plus x y)   {-# INLINE (+) #-}-  X y * X z     = X (polyMul y z)+  EF x * EF y   = EF (rem (times x y) (split (witness :: ExtensionField k im)))   {-# INLINE (*) #-}-  X y - X z     = X (polySub y z)+  EF x - EF y   = EF (x - y)   {-# INLINE (-) #-}-  negate (X y)  = X (map negate y)+  negate (EF x) = EF (S.negate x)   {-# INLINE negate #-}-  fromInteger n = X (let m = fromInteger n in if m == 0 then [] else [m])+  fromInteger   = EF . fromInteger   {-# INLINABLE fromInteger #-}   abs           = panic "not implemented."   signum        = panic "not implemented." --- | Convert from field element to list representation.-fromField :: ExtensionField k im -> [k]-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 (plist w) . dropZero-  where-    w = witness :: ExtensionField k im-{-# INLINABLE fromList #-}---- | Descend tower of indeterminate variables.-t :: Polynomial k -> Polynomial (ExtensionField k im)-t = X . return . EF-{-# INLINE t #-}---- | Current indeterminate variable.-x :: GaloisField k => Polynomial k-x = X [0, 1]-{-# INLINE x #-}- ---------------------------------------------------------------------------------- Extension field instances+-- Semiring 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 Euclidean domains.+instance IrreducibleMonic k im => Euclidean (ExtensionField k im) where+  quotRem = (flip (,) 0 .) . (/)+  {-# INLINE quotRem #-}+  degree  = panic "not implemented."+  {-# INLINE degree #-}  -- 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 #-}+instance IrreducibleMonic k im => Field (ExtensionField k im) where+  invert = recip+  {-# INLINE invert #-}+  minus  = (-)+  {-# INLINE minus #-} +-- Extension fields are GCD domains.+instance IrreducibleMonic k im => GcdDomain (ExtensionField k im)+ -- 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)+instance IrreducibleMonic k im => Ring (ExtensionField k im) where+  negate = P.negate   {-# INLINE negate #-}-  fromInteger             = EF . fromInteger-  {-# INLINABLE fromInteger #-}-  abs                     = panic "not implemented."-  signum                  = panic "not implemented." +-- Extension fields are semirings.+instance IrreducibleMonic k im => Semiring (ExtensionField k im) where+  zero        = 0+  {-# INLINE zero #-}+  plus        = (+)+  {-# INLINE plus #-}+  one         = 1+  {-# INLINE one #-}+  times       = (*)+  {-# INLINE times #-}+  fromNatural = fromIntegral+  {-# INLINE fromNatural #-}++-------------------------------------------------------------------------------+-- Other instances+-------------------------------------------------------------------------------++-- Extension fields are arbitrary.+instance IrreducibleMonic k im => Arbitrary (ExtensionField k im) where+  arbitrary = toField <$> vector (deg' (witness :: ExtensionField k im))+ -- Extension fields are pretty.-instance (GaloisField k, IrreducibleMonic k im)-  => Pretty (ExtensionField k im) where-  pretty (EF (X y)) = pretty y+instance IrreducibleMonic k im => Pretty (ExtensionField k im) where+  pretty (EF x) = pretty (toList (unPoly x))  -- 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) []+instance IrreducibleMonic k im => Random (ExtensionField k im) where+  random  = first toField . unfold (deg' (witness :: ExtensionField k im)) []     where-      w = witness :: ExtensionField k im-      unfold n ys g-        | n <= 0    = (ys, g)+      unfold n xs g+        | n <= 0    = (xs, g)         | otherwise = case random g of-          (y, g') -> unfold (n - 1) (y : ys) g'+        (x, g') -> unfold (n - 1) (x : xs) g'   {-# INLINE random #-}   randomR = panic "not implemented."  ---------------------------------------------------------------------------------- Extension field arithmetic+-- Type conversions ------------------------------------------------------------------------------- --- Polynomial drop zeroes.-dropZero :: GaloisField k => [k] -> [k]-dropZero = reverse . dropWhile (== 0) . reverse-{-# INLINABLE dropZero #-}+-- | Convert from field element to list representation.+fromField :: ExtensionField k im -> [k]+fromField (EF x) = toList (unPoly x)+{-# INLINABLE fromField #-} --- 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 #-}+-- | Convert from list representation to field element.+toField :: forall k im . IrreducibleMonic k im => [k] -> ExtensionField k im+toField = EF . flip rem (split (witness :: ExtensionField k im)) . toPoly . fromList+{-# INLINABLE toField #-} --- 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 #-}+-- | Pattern for @X^2@.+pattern X2 :: GaloisField k => VPoly k+pattern X2 <- _ where X2 = toPoly (fromList [0, 0, 1]) --- 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 #-}+-- | Pattern for @X^3@.+pattern X3 :: GaloisField k => VPoly k+pattern X3 <- _ where X3 = toPoly (fromList [0, 0, 0, 1]) --- 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 #-}+-- | Pattern for descending tower of indeterminate variables.+pattern Y :: IrreducibleMonic k im => VPoly k -> VPoly (ExtensionField k im)+pattern Y <- _ where Y = monomial 0 . EF --- 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)+-------------------------------------------------------------------------------+-- Polynomial arithmetic+-------------------------------------------------------------------------------++-- Polynomial inversion algorithm.+polyInv :: GaloisField k => VPoly k -> VPoly k -> VPoly k+polyInv xs ps = case first leading (polyGCD xs ps) of+  (Just (0, x), ys) -> scale 0 (recip x) ys+  _                 -> panic "no multiplicative inverse." {-# INLINE polyInv #-}++-- Polynomial extended greatest common divisor algorithm.+polyGCD :: forall k . GaloisField k => VPoly k -> VPoly k -> (VPoly k, VPoly k)+polyGCD x y = polyGCD' 0 1 y x+  where+    polyGCD' :: VPoly k -> VPoly k -> VPoly k -> VPoly k -> (VPoly k, VPoly k)+    polyGCD' s _  r 0  = (r, s)+    polyGCD' s s' r r' = case quot r r' of+      q -> polyGCD' s' (s - times q s') r' (r - times q r')+{-# INLINE polyGCD #-}

@@ -1,21 +1,45 @@ module GaloisField-  ( GaloisField(..)+  ( Field(..)+  , GaloisField(..)   ) where -import Protolude+import Protolude hiding ((-), one, quot) -import Control.Monad.Random (MonadRandom, Random)+import Control.Monad.Random (MonadRandom, Random, StdGen,+                             getRandom, mkStdGen, runRand)+import Data.Euclidean (Euclidean(..))+import Data.Semiring (Ring, (-), one) import Test.Tasty.QuickCheck (Arbitrary) import Text.PrettyPrint.Leijen.Text (Pretty)  ---------------------------------------------------------------------------------- Galois field class+-- Classes ------------------------------------------------------------------------------- +-- | Fields.+class (Euclidean k, Ring k) => Field k where++  -- Operations++  -- | Division.+  divide :: k -> k -> k+  divide = quot+  {-# INLINE divide #-}++  -- | Inversion.+  invert :: k -> k+  invert = quot one+  {-# INLINE invert #-}++  -- | Subtraction.+  minus :: k -> k -> k+  minus = (-)+  {-# INLINE minus #-}+ -- | Galois fields @GF(p^q)@ for @p@ prime and @q@ non-negative.-class (Arbitrary k, Eq k, Fractional k, Pretty k, Random k, Read k, Show k)-  => GaloisField k where-  {-# MINIMAL char, deg, frob, pow, quad, rnd, sr #-}+class (Arbitrary k, Field k, Fractional k,+       Generic k, Ord k, Pretty k, Random k, Show k) => GaloisField k where+  {-# MINIMAL char, deg, frob #-}    -- Characteristics @@ -35,14 +59,126 @@    -- Functions -  -- | Exponentiation of a field element to an integer.+  -- | Exponentiation of field element to integer.   pow :: k -> Integer -> k+  pow x n+    | n < 0     = pow (recip x) (negate n)+    | otherwise = pow' 1 x n+    where+      pow' z y m+        | m == 0    = z+        | m == 1    = z'+        | even m    = pow' z  y' m'+        | otherwise = pow' z' y' m'+        where+          z' = z * y+          y' = y * y+          m' = div m 2+  {-# INLINE pow #-} -  -- | Solve quadratic @ax^2+bx+c=0@ over field.+  -- | Get randomised quadratic nonresidue.+  qnr :: k+  qnr = getQNR+  {-# INLINE qnr #-}++  -- | Check if quadratic residue.+  qr :: k -> Bool+  qr = not . isQNR+  {-# INLINE qr #-}++  -- | Solve quadratic @ax^2 + bx + c = 0@ over field.   quad :: k -> k -> k -> Maybe k+  quad = solveQuadratic+  {-# INLINE quad #-}    -- | Randomised field element.   rnd :: MonadRandom m => m k+  rnd = getRandom+  {-# INLINE rnd #-} -  -- | Square root of a field element.+  -- | Square root of field element.   sr :: k -> Maybe k+  sr = squareRoot+  {-# INLINE sr #-}++-------------------------------------------------------------------------------+-- Square roots+-------------------------------------------------------------------------------++-- Check if an element is a quadratic nonresidue.+isQNR :: GaloisField k => k -> Bool+isQNR n = pow n (shiftR (order n) 1) /= 1+{-# INLINE isQNR #-}++-- Factor the order @p - 1@ to get @q@ and @s@ such that @p - 1 = q2^s@.+factorOrder :: GaloisField k => k -> (Integer, Int)+factorOrder w = factorOrder' (order w - 1, 0)+  where+    factorOrder' :: (Integer, Int) -> (Integer, Int)+    factorOrder' qs@(q, s)+      | testBit q 0 = qs+      | otherwise   = factorOrder' (shiftR q 1, s + 1)+{-# INLINE factorOrder #-}++-- Get a random quadratic nonresidue.+getQNR :: forall k . GaloisField k => k+getQNR = getQNR' (runRand rnd (mkStdGen 0))+  where+    getQNR' :: (k, StdGen) -> k+    getQNR' (x, g)+      | x /= 0 && isQNR x = x+      | otherwise         = getQNR' (runRand rnd g)+{-# INLINE getQNR #-}++-- Get a square root of @n@ with the Tonelli-Shanks algorithm.+squareRoot :: forall k . GaloisField k => k -> Maybe k+squareRoot 0    = Just 0+squareRoot n+  | char n == 2 = Just (power n)+  | isQNR n     = Nothing+  | otherwise   = case (factorOrder n, getQNR) of+  ((q, s), z) -> let zq  = pow z q+                     nq  = pow n (shiftR q 1)+                     nnq = n * nq+                 in loop s zq (nq * nnq) nnq+  where+    power :: k -> k+    power = next (deg n)+      where+       next :: Int -> k -> k+       next 1 m = m+       next i m = next (i - 1) (m * m)+    loop :: Int -> k -> k -> k -> Maybe k+    loop _ _ 0 _ = Just 0+    loop _ _ 1 r = Just r+    loop m c t r = let i  = least t 0+                       b  = pow c (bit (m - i - 1))+                       b2 = b * b+                   in loop i b2 (t * b2) (r * b)+      where+        least :: k -> Int -> Int+        least 1  j = j+        least ti j = least (ti * ti) (j + 1)+{-# INLINE squareRoot #-}++-- Solve a quadratic equation @ax^2 + bx + c = 0@.+solveQuadratic :: forall k . GaloisField k => k -> k -> k -> Maybe k+solveQuadratic 0 _ _ = Nothing+solveQuadratic _ _ 0 = Just 0+solveQuadratic a 0 c = squareRoot (-c / a)+solveQuadratic a b c+  | char a == 2      = (* (b / a)) <$> solveQuadratic' (ac / bb)+  | otherwise        = (/ (2 * a)) . subtract b <$> squareRoot (bb - 4 * ac)+  where+    ac = a * c+    bb = b * b+    solveQuadratic' :: k -> Maybe k+    solveQuadratic' x+      | sum xs /= 0 = Nothing+      | odd m       = Just (sum h)+      | otherwise   = panic "not implemented."+      where+        m  = deg x+        xs = take m (iterate (join (*)) x)+        h  = zipWith ($) (cycle [identity, const 0]) xs+{-# INLINE solveQuadratic #-}

@@ -3,89 +3,123 @@   , toInt   ) where -import Protolude+import Protolude as P hiding (Semiring) -import Control.Monad.Random (Random(..), getRandom)+import Control.Monad.Random (Random(..))+import Data.Euclidean (Euclidean(..), GcdDomain(..))+import Data.Semiring (Ring(..), Semiring(..)) import GHC.Integer.GMP.Internals (powModInteger, recipModInteger)-import Test.Tasty.QuickCheck (Arbitrary(..))+import Test.Tasty.QuickCheck (Arbitrary(..), choose) import Text.PrettyPrint.Leijen.Text (Pretty(..)) -import GaloisField (GaloisField(..))+import GaloisField (Field(..), GaloisField(..))  ---------------------------------------------------------------------------------- Prime field type+-- Data types -------------------------------------------------------------------------------  -- | Prime fields @GF(p)@ for @p@ prime. newtype PrimeField (p :: Nat) = PF Integer-  deriving (Bits, Eq, Generic, NFData, Read, Show)+  deriving (Bits, Eq, Generic, Ord, Show)  -- Prime fields are Galois fields. instance KnownNat p => GaloisField (PrimeField p) where-  char           = natVal+  char         = natVal   {-# INLINE char #-}-  deg            = const 1+  deg          = const 1   {-# INLINE deg #-}-  frob           = identity+  frob         = identity   {-# INLINE frob #-}-  pow w@(PF x) n = PF (powModInteger x n (natVal w))+  pow (PF x) n = PF (powModInteger x n (natVal (witness :: PrimeField p)))   {-# 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 #-}+{-# RULES "PrimeField/pow"+  forall (k :: KnownNat p => PrimeField p) (n :: Integer) . (^) k n = pow k n+  #-}  ---------------------------------------------------------------------------------- Prime field instances+-- Numeric instances ------------------------------------------------------------------------------- --- Prime fields are arbitrary.-instance KnownNat p => Arbitrary (PrimeField p) where-  arbitrary = fromInteger <$> arbitrary---- Prime fields are fields.+-- Prime fields are fractional. 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))+  recip (PF 0)        = panic "no multiplicative inverse."+  recip (PF x)        = PF (recipModInteger x (natVal (witness :: PrimeField p)))   {-# INLINE recip #-}   fromRational (x:%y) = fromInteger x / fromInteger y   {-# INLINABLE fromRational #-} --- Prime fields are rings.+-- Prime fields are numeric. instance KnownNat p => Num (PrimeField p) where-  w@(PF x) + PF y = PF (if xyp >= 0 then xyp else xy)+  PF x + PF y   = PF (if xyp >= 0 then xyp else xy)     where       xy  = x + y-      xyp = xy - natVal w+      xyp = xy - natVal (witness :: PrimeField p)   {-# INLINE (+) #-}-  w@(PF x) * PF y = PF (rem (x * y) (natVal w))+  PF x * PF y   = PF (P.rem (x * y) (natVal (witness :: PrimeField p)))   {-# INLINE (*) #-}-  w@(PF x) - PF y = PF (if xy >= 0 then xy else xy + natVal w)+  PF x - PF y   = PF (if xy >= 0 then xy else xy + natVal (witness :: PrimeField p))     where       xy = x - y   {-# INLINE (-) #-}-  negate w@(PF x) = PF (if x == 0 then 0 else -x + natVal w)+  negate (PF 0) = PF 0+  negate (PF x) = PF (natVal (witness :: PrimeField p) - x)   {-# INLINE negate #-}-  fromInteger x   = PF (if y >= 0 then y else y + p)+  fromInteger x = PF (if y >= 0 then y else y + p)     where-      y = rem x p+      y = P.rem x p       p = natVal (witness :: PrimeField p)   {-# INLINABLE fromInteger #-}-  abs             = panic "not implemented."-  signum          = panic "not implemented."+  abs           = panic "not implemented."+  signum        = panic "not implemented." +-------------------------------------------------------------------------------+-- Semiring instances+-------------------------------------------------------------------------------++-- Prime fields are Euclidean domains.+instance KnownNat p => Euclidean (PrimeField p) where+  quotRem = (flip (,) 0 .) . (/)+  {-# INLINE quotRem #-}+  degree  = panic "not implemented."+  {-# INLINE degree #-}++-- Prime fields are fields.+instance KnownNat p => Field (PrimeField p) where+  invert = recip+  {-# INLINE invert #-}+  minus  = (-)+  {-# INLINE minus #-}++-- Prime fields are GCD domains.+instance KnownNat p => GcdDomain (PrimeField p)++-- Prime fields are rings.+instance KnownNat p => Ring (PrimeField p) where+  negate = P.negate+  {-# INLINE negate #-}++-- Prime fields are semirings.+instance KnownNat p => Semiring (PrimeField p) where+  zero        = 0+  {-# INLINE zero #-}+  plus        = (+)+  {-# INLINE plus #-}+  one         = 1+  {-# INLINE one #-}+  times       = (*)+  {-# INLINE times #-}+  fromNatural = fromIntegral+  {-# INLINE fromNatural #-}++-------------------------------------------------------------------------------+-- Other instances+-------------------------------------------------------------------------------++-- Prime fields are arbitrary.+instance KnownNat p => Arbitrary (PrimeField p) where+  arbitrary = PF <$> choose (0, natVal (witness :: PrimeField p) - 1)+ -- Prime fields are pretty. instance KnownNat p => Pretty (PrimeField p) where   pretty (PF x) = pretty x@@ -97,67 +131,10 @@   randomR = panic "not implemented."  ---------------------------------------------------------------------------------- Prime field quadratics+-- Type conversions ------------------------------------------------------------------------------- --- 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 #-}+-- | Embed field element to integers.+toInt :: PrimeField p -> Integer+toInt (PF x) = x+{-# INLINABLE toInt #-}

@@ -19,13 +19,13 @@  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)+  [ test "F2A" (witness :: F2A)+  , test "F2B" (witness :: F2B)+  , test "F2C" (witness :: F2C)+  , test "F2D" (witness :: F2D)+  , test "F2E" (witness :: F2E)+  , test "F2F" (witness :: F2F)+  , test "F2G" (witness :: F2G)+  , test "F2H" (witness :: F2H)+  , test "F2I" (witness :: F2I)   ]

@@ -10,98 +10,98 @@  data P111 instance IrreducibleMonic FS2 P111 where-  split _ = x ^ (2 :: Int) + x + 1+  split _ = X2 + X + 1 type FS4 = ExtensionField FS2 P111  data P1101 instance IrreducibleMonic FS2 P1101 where-  split _ = x ^ (3 :: Int) + x + 1+  split _ = X3 + X + 1 type FS8 = ExtensionField FS2 P1101  data P1011 instance IrreducibleMonic FS2 P1011 where-  split _ = x ^ (3 :: Int) + x ^ (2 :: Int) + 1+  split _ = X3 + X2 + 1 type FS8' = ExtensionField FS2 P1011  data P101 instance IrreducibleMonic FS3 P101 where-  split _ = x ^ (2 :: Int) + 1+  split _ = X2 + 1 type FS9 = ExtensionField FS3 P101  data P211 instance IrreducibleMonic FS3 P211 where-  split _ = x ^ (2 :: Int) + x - 1+  split _ = X2 + X - 1 type FS9' = ExtensionField FS3 P211  data P221 instance IrreducibleMonic FS3 P221 where-  split _ = x ^ (2 :: Int) - x - 1+  split _ = X2 - X - 1 type FS9'' = ExtensionField FS3 P221  instance IrreducibleMonic FM0 P101 where-  split _ = x ^ (2 :: Int) + 1+  split _ = X2 + 1 type FL0 = ExtensionField FM0 P101  instance IrreducibleMonic FM1 P101 where-  split _ = x ^ (2 :: Int) + 1+  split _ = X2 + 1 type FL1 = ExtensionField FM1 P101  instance IrreducibleMonic FM2 P101 where-  split _ = x ^ (2 :: Int) + 1+  split _ = X2 + 1 type FL2 = ExtensionField FM2 P101  instance IrreducibleMonic FM3 P101 where-  split _ = x ^ (2 :: Int) + 1+  split _ = X2 + 1 type FL3 = ExtensionField FM3 P101  instance IrreducibleMonic FM4 P101 where-  split _ = x ^ (2 :: Int) + 1+  split _ = X2 + 1 type FL4 = ExtensionField FM4 P101  instance IrreducibleMonic FVL P101 where-  split _ = x ^ (2 :: Int) + 1+  split _ = X2 + 17 type FV2 = ExtensionField FVL P101  instance IrreducibleMonic FXL P101 where-  split _ = x ^ (2 :: Int) + 1+  split _ = X2 + 17 type FX2 = ExtensionField FXL P101  instance IrreducibleMonic FZL P101 where-  split _ = x ^ (2 :: Int) + 1+  split _ = X2 + 17 type FZ2 = ExtensionField FZL P101  data Pu instance IrreducibleMonic Fq Pu where-  split _ = x ^ (2 :: Int) + 1+  split _ = X2 + 1 type Fq2 = ExtensionField Fq Pu  data Pv instance IrreducibleMonic Fq2 Pv where-  split _ = x ^ (3 :: Int) - 9 - t x+  split _ = X3 - 9 - Y X type Fq6 = ExtensionField Fq2 Pv  data Pw instance IrreducibleMonic Fq6 Pw where-  split _ = x ^ (2 :: Int) - t x+  split _ = X2 - Y X type Fq12 = ExtensionField Fq6 Pw  testExtensionField :: TestTree testExtensionField = testGroup "Extension fields"-  [ 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 )+  [ test' "FS4"   (witness :: FS4  ) -- not implemented.+  , test  "FS8"   (witness :: FS8  )+  , test  "FS8'"  (witness :: FS8' )+  , test  "FS9"   (witness :: FS9  )+  , test  "FS9'"  (witness :: FS9' )+  , test  "FS9''" (witness :: FS9'')+  , test  "FL0"   (witness :: FL0  )+  , test  "FL1"   (witness :: FL1  )+  , test  "FL2"   (witness :: FL2  )+  , test  "FL3"   (witness :: FL3  )+  , test  "FL4"   (witness :: FL4  )+  , test  "FV2"   (witness :: FV2  )+  , test  "FX2"   (witness :: FX2  )+  , test  "FZ2"   (witness :: FZ2  )+  , test  "Fq2"   (witness :: Fq2  )+  , test' "Fq6"   (witness :: Fq6  ) -- time out.+  , test' "Fq12"  (witness :: Fq12 ) -- time out.   ]

@@ -45,24 +45,17 @@   ]  squareRoots :: forall k . GaloisField k => k -> TestTree-squareRoots _ = testGroup "Square roots"+squareRoots _ = localOption (QuickCheckTests 10) $ 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"+  , 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]+test s x = testGroup s [fieldAxioms x, squareRoots x] -testBF :: forall k . GaloisField k => TestName -> k -> TestTree-testBF s x = testGroup s [fieldAxioms x]+test' :: forall k . GaloisField k => TestName -> k -> TestTree+test' s x = testGroup s [fieldAxioms x]