{-# LANGUAGE ScopedTypeVariables, MultiParamTypeClasses, DeriveDataTypeable, TemplateHaskell, BangPatterns #-}
{-# LANGUAGE CPP, KindSignatures, DataKinds, ConstraintKinds #-}
{-# OPTIONS_GHC -Wall #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.FiniteField.PrimeField
-- Copyright   :  (c) Masahiro Sakai 2013-2014
-- License     :  BSD-style
--
-- Maintainer  :  masahiro.sakai@gmail.com
-- Stability   :  provisional
-- Portability :  non-portable (ScopedTypeVariables, MultiParamTypeClasses, DeriveDataTypeable, TemplateHaskell, BangPatterns)
--
-- Finite field of prime order p, Fp = Z/pZ.
--
-- References:
--
-- * <http://en.wikipedia.org/wiki/Finite_field>
--
-----------------------------------------------------------------------------
module Data.FiniteField.PrimeField
  ( PrimeField
  , toInteger
  -- * Template haskell utilities
  -- $TH
  , primeField
  ) where

import Prelude hiding (toInteger)
import Control.DeepSeq
import Data.Hashable
import Data.Ratio (denominator, numerator)
import Data.Typeable
import qualified Language.Haskell.TH as TH
#if !defined(UseGHCTypeLits)
import qualified TypeLevel.Number.Nat as TL
#else
import GHC.TypeLits
#endif
import Data.FiniteField.Base

-- | Finite field of prime order p, Fp = Z/pZ.
--
-- NB: Primality of @p@ is assumed, but not checked.
#if !defined(UseGHCTypeLits)
newtype PrimeField p = PrimeField Integer deriving (Eq, Typeable)
#else
newtype PrimeField (p::Nat) = PrimeField Integer deriving (PrimeField p -> PrimeField p -> Bool
(PrimeField p -> PrimeField p -> Bool)
-> (PrimeField p -> PrimeField p -> Bool) -> Eq (PrimeField p)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (p :: Nat). PrimeField p -> PrimeField p -> Bool
/= :: PrimeField p -> PrimeField p -> Bool
$c/= :: forall (p :: Nat). PrimeField p -> PrimeField p -> Bool
== :: PrimeField p -> PrimeField p -> Bool
$c== :: forall (p :: Nat). PrimeField p -> PrimeField p -> Bool
Eq, Typeable)
#endif

#if !defined(UseGHCTypeLits)
type KnownNat p = TL.Nat p
#endif

-- | conversion to 'Integer'
toInteger :: PrimeField p -> Integer
toInteger :: PrimeField p -> Integer
toInteger (PrimeField Integer
a) = Integer
a

toInt :: Integral a => PrimeField p -> a
toInt :: PrimeField p -> a
toInt = Integer -> a
forall a. Num a => Integer -> a
fromInteger (Integer -> a) -> (PrimeField p -> Integer) -> PrimeField p -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimeField p -> Integer
forall (p :: Nat). PrimeField p -> Integer
toInteger

instance Show (PrimeField p) where
  showsPrec :: Int -> PrimeField p -> ShowS
showsPrec Int
n (PrimeField Integer
x) = Int -> Integer -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
n Integer
x

instance KnownNat p => Read (PrimeField p) where
  readsPrec :: Int -> ReadS (PrimeField p)
readsPrec Int
n String
s = [(Integer -> PrimeField p
forall a. Num a => Integer -> a
fromInteger Integer
a, String
s') | (Integer
a,String
s') <- Int -> ReadS Integer
forall a. Read a => Int -> ReadS a
readsPrec Int
n String
s]

instance NFData (PrimeField p) where
  rnf :: PrimeField p -> ()
rnf (PrimeField Integer
a) = Integer -> ()
forall a. NFData a => a -> ()
rnf Integer
a

instance KnownNat p => Num (PrimeField p) where
  PrimeField Integer
a + :: PrimeField p -> PrimeField p -> PrimeField p
+ PrimeField Integer
b = Integer -> PrimeField p
forall a. Num a => Integer -> a
fromInteger (Integer -> PrimeField p) -> Integer -> PrimeField p
forall a b. (a -> b) -> a -> b
$ Integer
aInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
b
  PrimeField Integer
a * :: PrimeField p -> PrimeField p -> PrimeField p
* PrimeField Integer
b = Integer -> PrimeField p
forall a. Num a => Integer -> a
fromInteger (Integer -> PrimeField p) -> Integer -> PrimeField p
forall a b. (a -> b) -> a -> b
$ Integer
aInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
b
  PrimeField Integer
a - :: PrimeField p -> PrimeField p -> PrimeField p
- PrimeField Integer
b = Integer -> PrimeField p
forall a. Num a => Integer -> a
fromInteger (Integer -> PrimeField p) -> Integer -> PrimeField p
forall a b. (a -> b) -> a -> b
$ Integer
aInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
b
  negate :: PrimeField p -> PrimeField p
negate (PrimeField Integer
a)       = Integer -> PrimeField p
forall a. Num a => Integer -> a
fromInteger (Integer -> PrimeField p) -> Integer -> PrimeField p
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. Num a => a -> a
negate Integer
a
  abs :: PrimeField p -> PrimeField p
abs PrimeField p
a         = PrimeField p
a
  signum :: PrimeField p -> PrimeField p
signum PrimeField p
_      = PrimeField p
1
  fromInteger :: Integer -> PrimeField p
fromInteger Integer
a = PrimeField p
ret
    where
      ret :: PrimeField p
ret = Integer -> PrimeField p
forall (p :: Nat). Integer -> PrimeField p
PrimeField (Integer -> PrimeField p) -> Integer -> PrimeField p
forall a b. (a -> b) -> a -> b
$ Integer
a Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` PrimeField p -> Integer
forall k. FiniteField k => k -> Integer
char PrimeField p
ret

instance KnownNat p => Fractional (PrimeField p) where
  fromRational :: Rational -> PrimeField p
fromRational Rational
r = Integer -> PrimeField p
forall a. Num a => Integer -> a
fromInteger (Rational -> Integer
forall a. Ratio a -> a
numerator Rational
r) PrimeField p -> PrimeField p -> PrimeField p
forall a. Fractional a => a -> a -> a
/ Integer -> PrimeField p
forall a. Num a => Integer -> a
fromInteger (Rational -> Integer
forall a. Ratio a -> a
denominator Rational
r)
--  recip a = a ^ (char a - 2 :: Integer)
  recip :: PrimeField p -> PrimeField p
recip x :: PrimeField p
x@(PrimeField Integer
a) =
    case Integer -> Integer -> (Integer, Integer, Integer)
forall a. Integral a => a -> a -> (a, a, a)
exgcd Integer
a Integer
p of
      (Integer
_, Integer
r, Integer
_) -> Integer -> PrimeField p
forall a. Num a => Integer -> a
fromInteger Integer
r
    where
      p :: Integer
      p :: Integer
p = PrimeField p -> Integer
forall k. FiniteField k => k -> Integer
char PrimeField p
x

instance KnownNat p => Bounded (PrimeField p) where
  minBound :: PrimeField p
minBound = Integer -> PrimeField p
forall (p :: Nat). Integer -> PrimeField p
PrimeField Integer
0
  maxBound :: PrimeField p
maxBound = PrimeField p
ret
    where
      ret :: PrimeField p
ret = Integer -> PrimeField p
forall (p :: Nat). Integer -> PrimeField p
PrimeField (PrimeField p -> Integer
forall k. FiniteField k => k -> Integer
char PrimeField p
ret Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)

instance KnownNat p => Enum (PrimeField p) where
  toEnum :: Int -> PrimeField p
toEnum Int
x
    | PrimeField p -> Integer
forall (p :: Nat). PrimeField p -> Integer
toInteger (PrimeField p
forall a. Bounded a => a
minBound :: PrimeField p) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
x' Bool -> Bool -> Bool
&& Integer
x' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= PrimeField p -> Integer
forall (p :: Nat). PrimeField p -> Integer
toInteger (PrimeField p
forall a. Bounded a => a
maxBound :: PrimeField p) = Integer -> PrimeField p
forall (p :: Nat). Integer -> PrimeField p
PrimeField Integer
x'
    | Bool
otherwise = String -> PrimeField p
forall a. HasCallStack => String -> a
error String
"PrimeField.toEnum: bad argument"
    where
      x' :: Integer
x' = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x
  fromEnum :: PrimeField p -> Int
fromEnum = PrimeField p -> Int
forall a (p :: Nat). Integral a => PrimeField p -> a
toInt

instance Ord (PrimeField p) where
  PrimeField Integer
a compare :: PrimeField p -> PrimeField p -> Ordering
`compare` PrimeField Integer
b = Integer
a Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Integer
b

instance KnownNat p => FiniteField (PrimeField p) where
  order :: PrimeField p -> Integer
order PrimeField p
x   = PrimeField p -> Integer
forall k. FiniteField k => k -> Integer
char PrimeField p
x
#if !defined(UseGHCTypeLits)
  char _    = TL.toInt (undefined :: p)
#else
  char :: PrimeField p -> Integer
char PrimeField p
_    = Proxy p -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy p
forall k (t :: k). Proxy t
Proxy :: Proxy p)
#endif
  pthRoot :: PrimeField p -> PrimeField p
pthRoot PrimeField p
a = PrimeField p
a
  allValues :: [PrimeField p]
allValues = [PrimeField p
forall a. Bounded a => a
minBound .. PrimeField p
forall a. Bounded a => a
maxBound]

instance KnownNat p => Hashable (PrimeField p) where
  hashWithSalt :: Int -> PrimeField p -> Int
hashWithSalt Int
s x :: PrimeField p
x@(PrimeField Integer
a) =
    Int
s Int -> Integer -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` PrimeField p -> Integer
forall k. FiniteField k => k -> Integer
char PrimeField p
x Int -> Integer -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Integer
a

-- | Extended GCD algorithm
exgcd :: Integral a => a -> a -> (a, a, a)
exgcd :: a -> a -> (a, a, a)
exgcd a
f1 a
f2 = (a, a, a) -> (a, a, a)
forall a b c.
(Ord a, Num a, Num b, Num c) =>
(a, b, c) -> (a, b, c)
f ((a, a, a) -> (a, a, a)) -> (a, a, a) -> (a, a, a)
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> a -> a -> a -> (a, a, a)
forall t. Integral t => t -> t -> t -> t -> t -> t -> (t, t, t)
go a
f1 a
f2 a
1 a
0 a
0 a
1
  where
    go :: t -> t -> t -> t -> t -> t -> (t, t, t)
go !t
r0 !t
r1 !t
s0 !t
s1 !t
t0 !t
t1
      | t
r1 t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0   = (t
r0, t
s0, t
t0)
      | Bool
otherwise = t -> t -> t -> t -> t -> t -> (t, t, t)
go t
r1 t
r2 t
s1 t
s2 t
t1 t
t2
      where
        (t
q, t
r2) = t
r0 t -> t -> (t, t)
forall a. Integral a => a -> a -> (a, a)
`divMod` t
r1
        s2 :: t
s2 = t
s0 t -> t -> t
forall a. Num a => a -> a -> a
- t
qt -> t -> t
forall a. Num a => a -> a -> a
*t
s1
        t2 :: t
t2 = t
t0 t -> t -> t
forall a. Num a => a -> a -> a
- t
qt -> t -> t
forall a. Num a => a -> a -> a
*t
t1
    f :: (a, b, c) -> (a, b, c)
f (a
g,b
u,c
v)
      | a
g a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 = (-a
g, -b
u, -c
v)
      | Bool
otherwise = (a
g,b
u,c
v)

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

-- | Create a PrimeField type
primeField :: Integer -> TH.TypeQ
primeField :: Integer -> TypeQ
primeField Integer
n
  | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0    = String -> TypeQ
forall a. HasCallStack => String -> a
error String
"primeField: negative value"
#if !defined(UseGHCTypeLits)
  | otherwise = [t| PrimeField $(TL.natT n) |]
#else
  | Bool
otherwise = [t| PrimeField $(TH.litT (TH.numTyLit n)) |]
#endif

-- $TH
-- Here is usage example for primeField:
--
-- > a :: $(primeField 15485867)
-- > a = 1