-- | Table of Conway polynomials
--
-- The data is from <http://www.math.rwth-aachen.de/~Frank.Luebeck/data/ConwayPol/index.html>
--

{-# LANGUAGE ForeignFunctionInterface, StandaloneDeriving, BangPatterns #-}
{-# LANGUAGE GADTs, ExistentialQuantification, DataKinds, KindSignatures #-}

module Math.FiniteField.Conway 
  ( HasConwayPoly
  , SomeConwayPoly(..)
  , conwayPrime  , conwayDim
  , conwayParams , conwayParams'
  , conwayCoefficients
  , lookupSomeConwayPoly   
  , lookupConwayPoly
  , unsafeLookupConwayPoly 
  , lookupConwayPrimRoot
  )
  where

--------------------------------------------------------------------------------

import Data.Word
import Data.Bits

import Data.Proxy

import GHC.TypeNats (Nat)

import qualified Data.IntMap.Strict as IntMap

--import Foreign.C
import Foreign.Ptr
--import Foreign.Storable
--import Foreign.Marshal
--import Foreign.Marshal.Array

import qualified System.IO.Unsafe as Unsafe

import Math.FiniteField.TypeLevel
import Math.FiniteField.TypeLevel.Singleton
import Math.FiniteField.Conway.Internal

-- import Data.Array
-- import Math.FiniteField.PrimeField.Small

--------------------------------------------------------------------------------

-- data ConwayPoly p = ConwayPoly
--   { _prime    :: !(IsPrime p)
--   , _exponent :: !Int
--   , _coeffs   :: !(Array Int (Fp p))
--   }

--------------------------------------------------------------------------------
-- * Witness for the existence of precomputed Conway polynomials

data SomeConwayPoly = forall p m. SomeConwayPoly (HasConwayPoly p m) 

deriving instance Show SomeConwayPoly

conwayProxies :: HasConwayPoly p m -> (Proxy p, Proxy m)
conwayProxies :: HasConwayPoly p m -> (Proxy p, Proxy m)
conwayProxies HasConwayPoly p m
_ = (Proxy p
forall k (t :: k). Proxy t
Proxy, Proxy m
forall k (t :: k). Proxy t
Proxy)

instance Show (HasConwayPoly p m) where
  show :: HasConwayPoly p m -> String
show HasConwayPoly p m
witness = String
"ConwayPoly[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show Word64
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"^" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
m String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]" where
    (Word64
p,Int
m) = HasConwayPoly p m -> (Word64, Int)
forall (p :: Nat) (m :: Nat). HasConwayPoly p m -> (Word64, Int)
conwayParams_ HasConwayPoly p m
witness

-- | The prime characteristic @p@
conwayPrime :: HasConwayPoly p m -> IsSmallPrime p
conwayPrime :: HasConwayPoly p m -> IsSmallPrime p
conwayPrime (ConwayWitness Ptr Word32
ptr) = IO (IsSmallPrime p) -> IsSmallPrime p
forall a. IO a -> a
Unsafe.unsafePerformIO (IO (IsSmallPrime p) -> IsSmallPrime p)
-> IO (IsSmallPrime p) -> IsSmallPrime p
forall a b. (a -> b) -> a -> b
$ do
  (Word64
p,Int
_) <- Ptr Word32 -> IO (Word64, Int)
getConwayEntryParams Ptr Word32
ptr
  IsSmallPrime p -> IO (IsSmallPrime p)
forall (m :: * -> *) a. Monad m => a -> m a
return (SNat64 p -> IsSmallPrime p
forall (n :: Nat). SNat64 n -> IsSmallPrime n
believeMeItsASmallPrime (Word64 -> SNat64 p
forall (n :: Nat). Word64 -> SNat64 n
SNat64 Word64
p))

-- | The dimension @m@ of @F_q@ over @F_p@
conwayDim :: HasConwayPoly p m -> Int
conwayDim :: HasConwayPoly p m -> Int
conwayDim (ConwayWitness Ptr Word32
ptr) = IO Int -> Int
forall a. IO a -> a
Unsafe.unsafePerformIO (IO Int -> Int) -> IO Int -> Int
forall a b. (a -> b) -> a -> b
$ do
  (Word64
_,Int
m) <- Ptr Word32 -> IO (Word64, Int)
getConwayEntryParams Ptr Word32
ptr
  Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m)

-- | The pair @(p,m)@
conwayParams :: HasConwayPoly p m -> (Int,Int)
conwayParams :: HasConwayPoly p m -> (Int, Int)
conwayParams HasConwayPoly p m
witness = (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
p, Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m) where
  (Word64
p,Int
m) = HasConwayPoly p m -> (Word64, Int)
forall (p :: Nat) (m :: Nat). HasConwayPoly p m -> (Word64, Int)
conwayParams_ HasConwayPoly p m
witness

conwayParams' :: HasConwayPoly p m -> (SNat64 p, SNat64 m)
conwayParams' :: HasConwayPoly p m -> (SNat64 p, SNat64 m)
conwayParams' HasConwayPoly p m
witness = (Word64 -> SNat64 p
forall (n :: Nat). Word64 -> SNat64 n
SNat64 Word64
p, Word64 -> SNat64 m
forall (n :: Nat). Word64 -> SNat64 n
SNat64 (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m)) where
  (Word64
p,Int
m) = HasConwayPoly p m -> (Word64, Int)
forall (p :: Nat) (m :: Nat). HasConwayPoly p m -> (Word64, Int)
conwayParams_ HasConwayPoly p m
witness

conwayCoefficients :: HasConwayPoly p m -> [Word64]
conwayCoefficients :: HasConwayPoly p m -> [Word64]
conwayCoefficients (ConwayWitness Ptr Word32
ptr) = IO [Word64] -> [Word64]
forall a. IO a -> a
Unsafe.unsafePerformIO (IO [Word64] -> [Word64]) -> IO [Word64] -> [Word64]
forall a b. (a -> b) -> a -> b
$ do
  (Word64
_,Int
_,[Word64]
list) <- Ptr Word32 -> IO (Word64, Int, [Word64])
marshalConwayEntry Ptr Word32
ptr
  [Word64] -> IO [Word64]
forall (m :: * -> *) a. Monad m => a -> m a
return [Word64]
list

-- | Usage: @lookupConwayPoly sp sm@ for @q = p^m@
lookupConwayPoly :: SNat64 p -> SNat64 m -> Maybe (HasConwayPoly p m)
lookupConwayPoly :: SNat64 p -> SNat64 m -> Maybe (HasConwayPoly p m)
lookupConwayPoly !SNat64 p
sp !SNat64 m
sm = 
  let p :: Int
p = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (SNat64 p -> Word64
forall (n :: Nat). SNat64 n -> Word64
fromSNat64 SNat64 p
sp)
      m :: Int
m = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (SNat64 m -> Word64
forall (n :: Nat). SNat64 n -> Word64
fromSNat64 SNat64 m
sm)
  in case Int -> IntMap (Ptr Word32) -> Maybe (Ptr Word32)
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup (Int -> Int -> Int
encodePrimeExpo Int
p Int
m) (ConwayTable -> IntMap (Ptr Word32)
fromConwayTable ConwayTable
theConwayTable) of
       Maybe (Ptr Word32)
Nothing  -> Maybe (HasConwayPoly p m)
forall a. Maybe a
Nothing
       Just Ptr Word32
ptr -> HasConwayPoly p m -> Maybe (HasConwayPoly p m)
forall a. a -> Maybe a
Just (Ptr Word32 -> HasConwayPoly p m
forall (p :: Nat) (m :: Nat). Ptr Word32 -> HasConwayPoly p m
ConwayWitness Ptr Word32
ptr)

unsafeLookupConwayPoly :: SNat64 p -> SNat64 m -> HasConwayPoly p m
unsafeLookupConwayPoly :: SNat64 p -> SNat64 m -> HasConwayPoly p m
unsafeLookupConwayPoly SNat64 p
sp SNat64 m
sm = case SNat64 p -> SNat64 m -> Maybe (HasConwayPoly p m)
forall (p :: Nat) (m :: Nat).
SNat64 p -> SNat64 m -> Maybe (HasConwayPoly p m)
lookupConwayPoly SNat64 p
sp SNat64 m
sm of
  Maybe (HasConwayPoly p m)
Nothing  -> String -> HasConwayPoly p m
forall a. HasCallStack => String -> a
error String
"unsafeLookupConwayPoly: Conway polynomial not found"
  Just HasConwayPoly p m
cw  -> HasConwayPoly p m
cw

-- | Usage: @lookupSomeConwayPoly p m@ for @q = p^m@
lookupSomeConwayPoly :: Int -> Int -> Maybe SomeConwayPoly
lookupSomeConwayPoly :: Int -> Int -> Maybe SomeConwayPoly
lookupSomeConwayPoly !Int
p !Int
m = case (Int64 -> SomeSNat64
someSNat64 (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
p) , Int64 -> SomeSNat64
someSNat64 (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m)) of
  (SomeSNat64 SNat64 n
sp , SomeSNat64 SNat64 n
sm) -> HasConwayPoly n n -> SomeConwayPoly
forall (p :: Nat) (m :: Nat). HasConwayPoly p m -> SomeConwayPoly
SomeConwayPoly (HasConwayPoly n n -> SomeConwayPoly)
-> Maybe (HasConwayPoly n n) -> Maybe SomeConwayPoly
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SNat64 n -> SNat64 n -> Maybe (HasConwayPoly n n)
forall (p :: Nat) (m :: Nat).
SNat64 p -> SNat64 m -> Maybe (HasConwayPoly p m)
lookupConwayPoly SNat64 n
sp SNat64 n
sm

-- | We have some Conway polynomials for @m=1@ too; the roots of 
-- these linear polynomials are primitive roots in @F_p@
lookupConwayPrimRoot :: Int -> Maybe Int
lookupConwayPrimRoot :: Int -> Maybe Int
lookupConwayPrimRoot Int
p = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> Maybe Word64 -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Maybe Word64
lookupConwayPrimRoot_ Int
p)

--------------------------------------------------------------------------------