-- | C implementation of GF(p^m) via precomputed tables of Zech's logarithm.
--
-- This way I can test the C implementation using the Haskell test framework.
--

{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}
{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-}
{-# LANGUAGE TypeFamilies, StandaloneDeriving, ExistentialQuantification #-}

module Math.FiniteField.GaloisField.Zech.C where

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

import Data.Int

import GHC.TypeNats (Nat)

import Foreign.C
import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.Storable
import Foreign.Marshal

import System.Random ( RandomGen , randomR )

import System.IO
import System.IO.Unsafe as Unsafe

import qualified Data.Vector.Unboxed as Vec

import Math.FiniteField.Class
import Math.FiniteField.TypeLevel.Singleton

import qualified Math.FiniteField.GaloisField.Zech as Z

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

data WitnessC (p :: Nat) (m :: Nat) 
  = WitnessC (ForeignPtr Int32)
  deriving Int -> WitnessC p m -> ShowS
[WitnessC p m] -> ShowS
WitnessC p m -> String
(Int -> WitnessC p m -> ShowS)
-> (WitnessC p m -> String)
-> ([WitnessC p m] -> ShowS)
-> Show (WitnessC p m)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (p :: Nat) (m :: Nat). Int -> WitnessC p m -> ShowS
forall (p :: Nat) (m :: Nat). [WitnessC p m] -> ShowS
forall (p :: Nat) (m :: Nat). WitnessC p m -> String
showList :: [WitnessC p m] -> ShowS
$cshowList :: forall (p :: Nat) (m :: Nat). [WitnessC p m] -> ShowS
show :: WitnessC p m -> String
$cshow :: forall (p :: Nat) (m :: Nat). WitnessC p m -> String
showsPrec :: Int -> WitnessC p m -> ShowS
$cshowsPrec :: forall (p :: Nat) (m :: Nat). Int -> WitnessC p m -> ShowS
Show

fromWitnessC :: WitnessC p m -> ForeignPtr Int32
fromWitnessC :: WitnessC p m -> ForeignPtr Int32
fromWitnessC (WitnessC ForeignPtr Int32
fptr) = ForeignPtr Int32
fptr

data SomeWitnessC 
  = forall p m. SomeWitnessC (WitnessC p m)

deriving instance Show SomeWitnessC

mkCField :: Int -> Int -> Maybe SomeWitnessC
mkCField :: Int -> Int -> Maybe SomeWitnessC
mkCField Int
p Int
m = case Int -> Int -> Maybe SomeWitnessZech
Z.mkZechField Int
p Int
m of 
  Maybe SomeWitnessZech
Nothing   -> Maybe SomeWitnessC
forall a. Maybe a
Nothing
  Just SomeWitnessZech
some -> case SomeWitnessZech
some of
    Z.SomeWitnessZech WitnessZech p m
wzech -> SomeWitnessC -> Maybe SomeWitnessC
forall a. a -> Maybe a
Just (WitnessC p m -> SomeWitnessC
forall (p :: Nat) (m :: Nat). WitnessC p m -> SomeWitnessC
SomeWitnessC (WitnessZech p m -> WitnessC p m
forall (p :: Nat) (m :: Nat). WitnessZech p m -> WitnessC p m
makeCZechTable WitnessZech p m
wzech))

unsafeCField :: Int -> Int -> SomeWitnessC
unsafeCField :: Int -> Int -> SomeWitnessC
unsafeCField Int
p Int
m = case Int -> Int -> Maybe SomeWitnessC
mkCField Int
p Int
m of 
  Maybe SomeWitnessC
Nothing   -> String -> SomeWitnessC
forall a. HasCallStack => String -> a
error (String -> SomeWitnessC) -> String -> SomeWitnessC
forall a b. (a -> b) -> a -> b
$ String
"unsafeCField: cannot find Conway polynomial for GF(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
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
")"
  Just SomeWitnessC
some -> SomeWitnessC
some

-- instance FieldWitness (WitnessC p m) where
--   type FieldElem    (WitnessC p m) = CFq p m
--   type WitnessPrime (WitnessC p m) = p
--   type WitnessDim   (WitnessC p m) = m

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

makeCZechTable :: Z.WitnessZech p m -> WitnessC p m
makeCZechTable :: WitnessZech p m -> WitnessC p m
makeCZechTable (Z.WitnessZech ZechTable
zechtable) = IO (WitnessC p m) -> WitnessC p m
forall a. IO a -> a
unsafePerformIO (ForeignPtr Int32 -> WitnessC p m
forall (p :: Nat) (m :: Nat). ForeignPtr Int32 -> WitnessC p m
WitnessC (ForeignPtr Int32 -> WitnessC p m)
-> IO (ForeignPtr Int32) -> IO (WitnessC p m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZechTable -> IO (ForeignPtr Int32)
marshalZechTable ZechTable
zechtable)

marshalZechTable :: Z.ZechTable -> IO (ForeignPtr Int32)
marshalZechTable :: ZechTable -> IO (ForeignPtr Int32)
marshalZechTable ZechTable
ztable = do

  let (Int32
p,Int32
m) = ZechTable -> (Int32, Int32)
Z._zechParams ZechTable
ztable
  let q :: Int32
q = Int32
p Int32 -> Int32 -> Int32
forall a b. (Num a, Integral b) => a -> b -> a
^ Int32
m 
  let e :: Int32
e = if Int32
p Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
2 then Int32
0 else Int32 -> Int32 -> Int32
forall a. Integral a => a -> a -> a
div (Int32
qInt32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
-Int32
1) Int32
2
  let len :: Int
len = Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32
4 Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
p Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
qInt32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
-Int32
1)
  ForeignPtr Int32
fptr <- Int -> IO (ForeignPtr Int32)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
len :: IO (ForeignPtr Int32)

  ForeignPtr Int32 -> (Ptr Int32 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Int32
fptr ((Ptr Int32 -> IO ()) -> IO ()) -> (Ptr Int32 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Int32
ptr -> do
    Ptr Int32 -> Int -> Int32 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Int32
ptr Int
0 Int32
p
    Ptr Int32 -> Int -> Int32 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Int32
ptr Int
1 Int32
m
    Ptr Int32 -> Int -> Int32 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Int32
ptr Int
2 (Int32
qInt32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
-Int32
1)
    Ptr Int32 -> Int -> Int32 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Int32
ptr Int
3 Int32
e
    let ofs :: Int
ofs = Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
p)
    Ptr Int32 -> [Int32] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray (Ptr Int32 -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Int32
ptr Int
16 ) (Vector Int32 -> [Int32]
forall a. Unbox a => Vector a -> [a]
Vec.toList (ZechTable -> Vector Int32
Z._embedding ZechTable
ztable))
    Ptr Int32 -> [Int32] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray (Ptr Int32 -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Int32
ptr Int
ofs) (Vector Int32 -> [Int32]
forall a. Unbox a => Vector a -> [a]
Vec.toList (ZechTable -> Vector Int32
Z._zechLogs  ZechTable
ztable))

  ForeignPtr Int32 -> IO (ForeignPtr Int32)
forall (m :: * -> *) a. Monad m => a -> m a
return ForeignPtr Int32
fptr

-- | Save the data necessary to do computations to a file
saveCZechTable :: FilePath -> WitnessC p q -> IO ()
saveCZechTable :: String -> WitnessC p q -> IO ()
saveCZechTable String
fname w :: WitnessC p q
w@(WitnessC ForeignPtr Int32
fptr) = do
  let p :: Int
p = WitnessC p q -> Int
forall (p :: Nat) (m :: Nat). WitnessC p m -> Int
rawPrime WitnessC p q
w
  let m :: Int
m = WitnessC p q -> Int
forall (p :: Nat) (m :: Nat). WitnessC p m -> Int
rawDim   WitnessC p q
w
  let q :: Int
q = Int
pInt -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^Int
m
  let len :: Int
len = Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
qInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
  ForeignPtr Int32 -> (Ptr Int32 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Int32
fptr ((Ptr Int32 -> IO ()) -> IO ()) -> (Ptr Int32 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Int32
ptr -> do
    Handle
h <- String -> IOMode -> IO Handle
openBinaryFile String
fname IOMode
WriteMode 
    Handle -> Ptr Int32 -> Int -> IO ()
forall a. Handle -> Ptr a -> Int -> IO ()
hPutBuf Handle
h Ptr Int32
ptr Int
len
    Handle -> IO ()
hClose Handle
h

-- | Load the data necessary to do computations from a file
loadCZechTable :: FilePath -> IO (Maybe SomeWitnessC)
loadCZechTable :: String -> IO (Maybe SomeWitnessC)
loadCZechTable String
fname = do
  Handle
h  <- String -> IOMode -> IO Handle
openBinaryFile String
fname IOMode
ReadMode 
  Maybe SomeWitnessC
mb <- Int
-> (Ptr Int32 -> IO (Maybe SomeWitnessC))
-> IO (Maybe SomeWitnessC)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
16 ((Ptr Int32 -> IO (Maybe SomeWitnessC)) -> IO (Maybe SomeWitnessC))
-> (Ptr Int32 -> IO (Maybe SomeWitnessC))
-> IO (Maybe SomeWitnessC)
forall a b. (a -> b) -> a -> b
$ \(Ptr Int32
header :: Ptr Int32) -> do
    Handle -> Ptr Int32 -> Int -> IO Int
forall a. Handle -> Ptr a -> Int -> IO Int
hGetBuf Handle
h Ptr Int32
header Int
16
    Int32
p   <- Ptr Int32 -> Int -> IO Int32
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Int32
header Int
0 
    Int32
m   <- Ptr Int32 -> Int -> IO Int32
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Int32
header Int
1
    Int32
qm1 <- Ptr Int32 -> Int -> IO Int32
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Int32
header Int
2
    Int32
e   <- Ptr Int32 -> Int -> IO Int32
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Int32
header Int
3
    let ok1 :: Bool
ok1 = Int32
qm1 Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
1 Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
pInt32 -> Int32 -> Int32
forall a b. (Num a, Integral b) => a -> b -> a
^Int32
m
        ok2 :: Bool
ok2 = if Int32
p Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
2 then Int32
e Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
0 else Int32
e Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32 -> Int32 -> Int32
forall a. Integral a => a -> a -> a
div Int32
qm1 Int32
2 
    if Bool -> Bool
not (Bool
ok1 Bool -> Bool -> Bool
&& Bool
ok2) 
      then Maybe SomeWitnessC -> IO (Maybe SomeWitnessC)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SomeWitnessC
forall a. Maybe a
Nothing
      else do
        Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
h SeekMode
AbsoluteSeek Integer
0
        let len :: Int
len = Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
qm1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
p) 
        ForeignPtr Int32
fptr <- Int -> IO (ForeignPtr Int32)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
len
        ForeignPtr Int32 -> (Ptr Int32 -> IO Int) -> IO Int
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Int32
fptr ((Ptr Int32 -> IO Int) -> IO Int)
-> (Ptr Int32 -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr Int32
ptr -> Handle -> Ptr Int32 -> Int -> IO Int
forall a. Handle -> Ptr a -> Int -> IO Int
hGetBuf Handle
h Ptr Int32
ptr Int
len  
        Maybe SomeWitnessC -> IO (Maybe SomeWitnessC)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe SomeWitnessC -> IO (Maybe SomeWitnessC))
-> Maybe SomeWitnessC -> IO (Maybe SomeWitnessC)
forall a b. (a -> b) -> a -> b
$ case (Int64 -> SomeSNat64
someSNat64 (Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
p), Int64 -> SomeSNat64
someSNat64 (Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
m)) of
          (SomeSNat64 SNat64 n
sp, SomeSNat64 SNat64 n
sm) -> SomeWitnessC -> Maybe SomeWitnessC
forall a. a -> Maybe a
Just (WitnessC n n -> SomeWitnessC
forall (p :: Nat) (m :: Nat). WitnessC p m -> SomeWitnessC
SomeWitnessC (SNat64 n -> SNat64 n -> ForeignPtr Int32 -> WitnessC n n
forall (p :: Nat) (m :: Nat).
SNat64 p -> SNat64 m -> ForeignPtr Int32 -> WitnessC p m
constructWitnessC SNat64 n
sp SNat64 n
sm ForeignPtr Int32
fptr))
  Handle -> IO ()
hClose Handle
h
  Maybe SomeWitnessC -> IO (Maybe SomeWitnessC)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SomeWitnessC
mb

constructWitnessC :: SNat64 p -> SNat64 m -> ForeignPtr Int32 -> WitnessC p m
constructWitnessC :: SNat64 p -> SNat64 m -> ForeignPtr Int32 -> WitnessC p m
constructWitnessC SNat64 p
_ SNat64 m
_ ForeignPtr Int32
fptr = ForeignPtr Int32 -> WitnessC p m
forall (p :: Nat) (m :: Nat). ForeignPtr Int32 -> WitnessC p m
WitnessC ForeignPtr Int32
fptr

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

-- | An element of the field
data CFq (p :: Nat) (m :: Nat) 
  = CFq {-# UNPACK #-} !(ForeignPtr Int32) {-# UNPACK #-} !Int32 

instance Eq (CFq p m) where
  == :: CFq p m -> CFq p m -> Bool
(==) (CFq ForeignPtr Int32
_ Int32
x) (CFq ForeignPtr Int32
_ Int32
y) = Int32
x Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
y

instance Ord (CFq p m) where
  compare :: CFq p m -> CFq p m -> Ordering
compare (CFq ForeignPtr Int32
_ Int32
x) (CFq ForeignPtr Int32
_ Int32
y) = Int32 -> Int32 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int32
x Int32
y

instance Show (CFq p m) where
  show :: CFq p m -> String
show (CFq ForeignPtr Int32
_ Int32
k)
    | Int32
k Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== -Int32
1    = String
"0"
    | Int32
k Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
==  Int32
0    = String
"1"
    | Int32
k Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
==  Int32
1    = String
"g"
    | Bool
otherwise  = String
"g^" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int32 -> String
forall a. Show a => a -> String
show Int32
k

instance Num (CFq p m) where
  fromInteger :: Integer -> CFq p m
fromInteger = String -> Integer -> CFq p m
forall a. HasCallStack => String -> a
error String
"GaloisField/Zech/C/fromInteger: cannot be implemented; use `embed` instead"
  negate :: CFq p m -> CFq p m
negate (CFq ForeignPtr Int32
fptr Int32
x)           = ForeignPtr Int32 -> Int32 -> CFq p m
forall (p :: Nat) (m :: Nat). ForeignPtr Int32 -> Int32 -> CFq p m
CFq ForeignPtr Int32
fptr (Raw Any Any -> Int32
forall (p :: Nat) (m :: Nat). Raw p m -> Int32
fromRaw (WitnessC Any Any -> Raw Any Any -> Raw Any Any
forall (p :: Nat) (m :: Nat). WitnessC p m -> Raw p m -> Raw p m
rawNeg (ForeignPtr Int32 -> WitnessC Any Any
forall (p :: Nat) (m :: Nat). ForeignPtr Int32 -> WitnessC p m
WitnessC ForeignPtr Int32
fptr) (Int32 -> Raw Any Any
forall (p :: Nat) (m :: Nat). Int32 -> Raw p m
Raw Int32
x)        ))
  + :: CFq p m -> CFq p m -> CFq p m
(+)    (CFq ForeignPtr Int32
fptr Int32
x) (CFq ForeignPtr Int32
_ Int32
y) = ForeignPtr Int32 -> Int32 -> CFq p m
forall (p :: Nat) (m :: Nat). ForeignPtr Int32 -> Int32 -> CFq p m
CFq ForeignPtr Int32
fptr (Raw Any Any -> Int32
forall (p :: Nat) (m :: Nat). Raw p m -> Int32
fromRaw (WitnessC Any Any -> Raw Any Any -> Raw Any Any -> Raw Any Any
forall (p :: Nat) (m :: Nat).
WitnessC p m -> Raw p m -> Raw p m -> Raw p m
rawAdd (ForeignPtr Int32 -> WitnessC Any Any
forall (p :: Nat) (m :: Nat). ForeignPtr Int32 -> WitnessC p m
WitnessC ForeignPtr Int32
fptr) (Int32 -> Raw Any Any
forall (p :: Nat) (m :: Nat). Int32 -> Raw p m
Raw Int32
x) (Int32 -> Raw Any Any
forall (p :: Nat) (m :: Nat). Int32 -> Raw p m
Raw Int32
y)))
  (-)    (CFq ForeignPtr Int32
fptr Int32
x) (CFq ForeignPtr Int32
_ Int32
y) = ForeignPtr Int32 -> Int32 -> CFq p m
forall (p :: Nat) (m :: Nat). ForeignPtr Int32 -> Int32 -> CFq p m
CFq ForeignPtr Int32
fptr (Raw Any Any -> Int32
forall (p :: Nat) (m :: Nat). Raw p m -> Int32
fromRaw (WitnessC Any Any -> Raw Any Any -> Raw Any Any -> Raw Any Any
forall (p :: Nat) (m :: Nat).
WitnessC p m -> Raw p m -> Raw p m -> Raw p m
rawSub (ForeignPtr Int32 -> WitnessC Any Any
forall (p :: Nat) (m :: Nat). ForeignPtr Int32 -> WitnessC p m
WitnessC ForeignPtr Int32
fptr) (Int32 -> Raw Any Any
forall (p :: Nat) (m :: Nat). Int32 -> Raw p m
Raw Int32
x) (Int32 -> Raw Any Any
forall (p :: Nat) (m :: Nat). Int32 -> Raw p m
Raw Int32
y)))
  * :: CFq p m -> CFq p m -> CFq p m
(*)    (CFq ForeignPtr Int32
fptr Int32
x) (CFq ForeignPtr Int32
_ Int32
y) = ForeignPtr Int32 -> Int32 -> CFq p m
forall (p :: Nat) (m :: Nat). ForeignPtr Int32 -> Int32 -> CFq p m
CFq ForeignPtr Int32
fptr (Raw Any Any -> Int32
forall (p :: Nat) (m :: Nat). Raw p m -> Int32
fromRaw (WitnessC Any Any -> Raw Any Any -> Raw Any Any -> Raw Any Any
forall (p :: Nat) (m :: Nat).
WitnessC p m -> Raw p m -> Raw p m -> Raw p m
rawMul (ForeignPtr Int32 -> WitnessC Any Any
forall (p :: Nat) (m :: Nat). ForeignPtr Int32 -> WitnessC p m
WitnessC ForeignPtr Int32
fptr) (Int32 -> Raw Any Any
forall (p :: Nat) (m :: Nat). Int32 -> Raw p m
Raw Int32
x) (Int32 -> Raw Any Any
forall (p :: Nat) (m :: Nat). Int32 -> Raw p m
Raw Int32
y)))
  abs :: CFq p m -> CFq p m
abs    (CFq ForeignPtr Int32
fptr Int32
x)           = ForeignPtr Int32 -> Int32 -> CFq p m
forall (p :: Nat) (m :: Nat). ForeignPtr Int32 -> Int32 -> CFq p m
CFq ForeignPtr Int32
fptr Int32
x
  signum :: CFq p m -> CFq p m
signum (CFq ForeignPtr Int32
fptr Int32
x)           = ForeignPtr Int32 -> Int32 -> CFq p m
forall (p :: Nat) (m :: Nat). ForeignPtr Int32 -> Int32 -> CFq p m
CFq ForeignPtr Int32
fptr Int32
0

instance Fractional (CFq p m) where
  fromRational :: Rational -> CFq p m
fromRational = String -> Rational -> CFq p m
forall a. HasCallStack => String -> a
error String
"GaloisField/Zech/C/fromRational: cannot be implemented; use `embed` instead"
  recip :: CFq p m -> CFq p m
recip  (CFq ForeignPtr Int32
fptr Int32
x)           = ForeignPtr Int32 -> Int32 -> CFq p m
forall (p :: Nat) (m :: Nat). ForeignPtr Int32 -> Int32 -> CFq p m
CFq ForeignPtr Int32
fptr (Raw Any Any -> Int32
forall (p :: Nat) (m :: Nat). Raw p m -> Int32
fromRaw (WitnessC Any Any -> Raw Any Any -> Raw Any Any
forall (p :: Nat) (m :: Nat). WitnessC p m -> Raw p m -> Raw p m
rawInv (ForeignPtr Int32 -> WitnessC Any Any
forall (p :: Nat) (m :: Nat). ForeignPtr Int32 -> WitnessC p m
WitnessC ForeignPtr Int32
fptr) (Int32 -> Raw Any Any
forall (p :: Nat) (m :: Nat). Int32 -> Raw p m
Raw Int32
x)        ))
  / :: CFq p m -> CFq p m -> CFq p m
(/)    (CFq ForeignPtr Int32
fptr Int32
x) (CFq ForeignPtr Int32
_ Int32
y) = ForeignPtr Int32 -> Int32 -> CFq p m
forall (p :: Nat) (m :: Nat). ForeignPtr Int32 -> Int32 -> CFq p m
CFq ForeignPtr Int32
fptr (Raw Any Any -> Int32
forall (p :: Nat) (m :: Nat). Raw p m -> Int32
fromRaw (WitnessC Any Any -> Raw Any Any -> Raw Any Any -> Raw Any Any
forall (p :: Nat) (m :: Nat).
WitnessC p m -> Raw p m -> Raw p m -> Raw p m
rawDiv (ForeignPtr Int32 -> WitnessC Any Any
forall (p :: Nat) (m :: Nat). ForeignPtr Int32 -> WitnessC p m
WitnessC ForeignPtr Int32
fptr) (Int32 -> Raw Any Any
forall (p :: Nat) (m :: Nat). Int32 -> Raw p m
Raw Int32
x) (Int32 -> Raw Any Any
forall (p :: Nat) (m :: Nat). Int32 -> Raw p m
Raw Int32
y)))

instance Field (CFq p m) where
  type Witness (CFq p m) = WitnessC p m
  type Prime   (CFq p m) = p
  type Dim     (CFq p m) = m

  characteristic :: Witness (CFq p m) -> Integer
characteristic    Witness (CFq p m)
w = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (WitnessC p m -> Int
forall (p :: Nat) (m :: Nat). WitnessC p m -> Int
rawPrime     Witness (CFq p m)
WitnessC p m
w)
  dimension :: Witness (CFq p m) -> Integer
dimension         Witness (CFq p m)
w = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (WitnessC p m -> Int
forall (p :: Nat) (m :: Nat). WitnessC p m -> Int
rawDim       Witness (CFq p m)
WitnessC p m
w)
  fieldSize :: Witness (CFq p m) -> Integer
fieldSize         Witness (CFq p m)
w = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (WitnessC p m -> Int
forall (p :: Nat) (m :: Nat). WitnessC p m -> Int
rawFieldSize Witness (CFq p m)
WitnessC p m
w)
  witnessOf :: CFq p m -> Witness (CFq p m)
witnessOf        !CFq p m
x = case CFq p m
x of { CFq ForeignPtr Int32
fptr Int32
_ -> ForeignPtr Int32 -> WitnessC p m
forall (p :: Nat) (m :: Nat). ForeignPtr Int32 -> WitnessC p m
WitnessC ForeignPtr Int32
fptr }

  enumerate :: Witness (CFq p m) -> [CFq p m]
enumerate  (WitnessC fptr)    = (Raw Any Any -> CFq p m) -> [Raw Any Any] -> [CFq p m]
forall a b. (a -> b) -> [a] -> [b]
map (\Raw Any Any
r -> ForeignPtr Int32 -> Int32 -> CFq p m
forall (p :: Nat) (m :: Nat). ForeignPtr Int32 -> Int32 -> CFq p m
CFq ForeignPtr Int32
fptr (Raw Any Any -> Int32
forall (p :: Nat) (m :: Nat). Raw p m -> Int32
fromRaw Raw Any Any
r)) (WitnessC Any Any -> [Raw Any Any]
forall (p :: Nat) (m :: Nat). WitnessC p m -> [Raw p m]
rawEnumerate (ForeignPtr Int32 -> WitnessC Any Any
forall (p :: Nat) (m :: Nat). ForeignPtr Int32 -> WitnessC p m
WitnessC ForeignPtr Int32
fptr))
  embed :: Witness (CFq p m) -> Integer -> CFq p m
embed      (WitnessC fptr) !Integer
k = ForeignPtr Int32 -> Int32 -> CFq p m
forall (p :: Nat) (m :: Nat). ForeignPtr Int32 -> Int32 -> CFq p m
CFq ForeignPtr Int32
fptr (Raw Any Any -> Int32
forall (p :: Nat) (m :: Nat). Raw p m -> Int32
fromRaw (WitnessC Any Any -> Int -> Raw Any Any
forall (p :: Nat) (m :: Nat). WitnessC p m -> Int -> Raw p m
rawEmbed (ForeignPtr Int32 -> WitnessC Any Any
forall (p :: Nat) (m :: Nat). ForeignPtr Int32 -> WitnessC p m
WitnessC ForeignPtr Int32
fptr) (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
k)))
  embedSmall :: Witness (CFq p m) -> Int -> CFq p m
embedSmall (WitnessC fptr) !Int
k = ForeignPtr Int32 -> Int32 -> CFq p m
forall (p :: Nat) (m :: Nat). ForeignPtr Int32 -> Int32 -> CFq p m
CFq ForeignPtr Int32
fptr (Raw Any Any -> Int32
forall (p :: Nat) (m :: Nat). Raw p m -> Int32
fromRaw (WitnessC Any Any -> Int -> Raw Any Any
forall (p :: Nat) (m :: Nat). WitnessC p m -> Int -> Raw p m
rawEmbed (ForeignPtr Int32 -> WitnessC Any Any
forall (p :: Nat) (m :: Nat). ForeignPtr Int32 -> WitnessC p m
WitnessC ForeignPtr Int32
fptr)              Int
k ))

  randomFieldElem :: Witness (CFq p m) -> gen -> (CFq p m, gen)
randomFieldElem   Witness (CFq p m)
w = WitnessC p m -> gen -> (CFq p m, gen)
forall gen (p :: Nat) (m :: Nat).
RandomGen gen =>
WitnessC p m -> gen -> (CFq p m, gen)
randomCFq    Witness (CFq p m)
WitnessC p m
w
  randomInvertible :: Witness (CFq p m) -> gen -> (CFq p m, gen)
randomInvertible  Witness (CFq p m)
w = WitnessC p m -> gen -> (CFq p m, gen)
forall gen (p :: Nat) (m :: Nat).
RandomGen gen =>
WitnessC p m -> gen -> (CFq p m, gen)
randomInvCFq Witness (CFq p m)
WitnessC p m
w

  power :: CFq p m -> Integer -> CFq p m
power      (CFq ForeignPtr Int32
fptr Int32
x) Integer
e = ForeignPtr Int32 -> Int32 -> CFq p m
forall (p :: Nat) (m :: Nat). ForeignPtr Int32 -> Int32 -> CFq p m
CFq ForeignPtr Int32
fptr (Raw Any Any -> Int32
forall (p :: Nat) (m :: Nat). Raw p m -> Int32
fromRaw (WitnessC Any Any -> Raw Any Any -> Int -> Raw Any Any
forall (p :: Nat) (m :: Nat).
WitnessC p m -> Raw p m -> Int -> Raw p m
rawPow (ForeignPtr Int32 -> WitnessC Any Any
forall (p :: Nat) (m :: Nat). ForeignPtr Int32 -> WitnessC p m
WitnessC ForeignPtr Int32
fptr) (Int32 -> Raw Any Any
forall (p :: Nat) (m :: Nat). Int32 -> Raw p m
Raw Int32
x) (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
e)))
  powerSmall :: CFq p m -> Int -> CFq p m
powerSmall (CFq ForeignPtr Int32
fptr Int32
x) Int
e = ForeignPtr Int32 -> Int32 -> CFq p m
forall (p :: Nat) (m :: Nat). ForeignPtr Int32 -> Int32 -> CFq p m
CFq ForeignPtr Int32
fptr (Raw Any Any -> Int32
forall (p :: Nat) (m :: Nat). Raw p m -> Int32
fromRaw (WitnessC Any Any -> Raw Any Any -> Int -> Raw Any Any
forall (p :: Nat) (m :: Nat).
WitnessC p m -> Raw p m -> Int -> Raw p m
rawPow (ForeignPtr Int32 -> WitnessC Any Any
forall (p :: Nat) (m :: Nat). ForeignPtr Int32 -> WitnessC p m
WitnessC ForeignPtr Int32
fptr) (Int32 -> Raw Any Any
forall (p :: Nat) (m :: Nat). Int32 -> Raw p m
Raw Int32
x)               Int
e ))

  zero :: Witness (CFq p m) -> CFq p m
zero    (WitnessC fptr) = ForeignPtr Int32 -> Int32 -> CFq p m
forall (p :: Nat) (m :: Nat). ForeignPtr Int32 -> Int32 -> CFq p m
CFq ForeignPtr Int32
fptr (-Int32
1)
  one :: Witness (CFq p m) -> CFq p m
one     (WitnessC fptr) = ForeignPtr Int32 -> Int32 -> CFq p m
forall (p :: Nat) (m :: Nat). ForeignPtr Int32 -> Int32 -> CFq p m
CFq ForeignPtr Int32
fptr   Int32
0
  primGen :: Witness (CFq p m) -> CFq p m
primGen (WitnessC fptr) = ForeignPtr Int32 -> Int32 -> CFq p m
forall (p :: Nat) (m :: Nat). ForeignPtr Int32 -> Int32 -> CFq p m
CFq ForeignPtr Int32
fptr   Int32
1
  isZero :: CFq p m -> Bool
isZero  (CFq ForeignPtr Int32
_ Int32
a)       = Int32
a Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== -Int32
1
  isOne :: CFq p m -> Bool
isOne   (CFq ForeignPtr Int32
_ Int32
a)       = Int32
a Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
0

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

randomCFq :: RandomGen gen => WitnessC p m -> gen -> (CFq p m, gen)
randomCFq :: WitnessC p m -> gen -> (CFq p m, gen)
randomCFq w :: WitnessC p m
w@(WitnessC ForeignPtr Int32
fptr) gen
g = 
  let q :: Int
q = WitnessC p m -> Int
forall (p :: Nat) (m :: Nat). WitnessC p m -> Int
rawFieldSize WitnessC p m
w 
  in  case (Int, Int) -> gen -> (Int, gen)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (-Int
1,Int
qInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2) gen
g of (Int
k,gen
g') -> (ForeignPtr Int32 -> Int32 -> CFq p m
forall (p :: Nat) (m :: Nat). ForeignPtr Int32 -> Int32 -> CFq p m
CFq ForeignPtr Int32
fptr (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k), gen
g')

randomInvCFq :: RandomGen gen => WitnessC p m -> gen -> (CFq p m, gen)
randomInvCFq :: WitnessC p m -> gen -> (CFq p m, gen)
randomInvCFq w :: WitnessC p m
w@(WitnessC ForeignPtr Int32
fptr) gen
g = 
  let q :: Int
q = WitnessC p m -> Int
forall (p :: Nat) (m :: Nat). WitnessC p m -> Int
rawFieldSize WitnessC p m
w 
  in  case (Int, Int) -> gen -> (Int, gen)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (Int
0,Int
qInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2) gen
g of (Int
k,gen
g') -> (ForeignPtr Int32 -> Int32 -> CFq p m
forall (p :: Nat) (m :: Nat). ForeignPtr Int32 -> Int32 -> CFq p m
CFq ForeignPtr Int32
fptr (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k), gen
g')

--------------------------------------------------------------------------------
-- * The \"raw\" interface, where you have to manually supply the tables

newtype Raw (p :: Nat) (m :: Nat) 
  = Raw Int32 
  deriving (Raw p m -> Raw p m -> Bool
(Raw p m -> Raw p m -> Bool)
-> (Raw p m -> Raw p m -> Bool) -> Eq (Raw p m)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (p :: Nat) (m :: Nat). Raw p m -> Raw p m -> Bool
/= :: Raw p m -> Raw p m -> Bool
$c/= :: forall (p :: Nat) (m :: Nat). Raw p m -> Raw p m -> Bool
== :: Raw p m -> Raw p m -> Bool
$c== :: forall (p :: Nat) (m :: Nat). Raw p m -> Raw p m -> Bool
Eq,Eq (Raw p m)
Eq (Raw p m)
-> (Raw p m -> Raw p m -> Ordering)
-> (Raw p m -> Raw p m -> Bool)
-> (Raw p m -> Raw p m -> Bool)
-> (Raw p m -> Raw p m -> Bool)
-> (Raw p m -> Raw p m -> Bool)
-> (Raw p m -> Raw p m -> Raw p m)
-> (Raw p m -> Raw p m -> Raw p m)
-> Ord (Raw p m)
Raw p m -> Raw p m -> Bool
Raw p m -> Raw p m -> Ordering
Raw p m -> Raw p m -> Raw p m
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (p :: Nat) (m :: Nat). Eq (Raw p m)
forall (p :: Nat) (m :: Nat). Raw p m -> Raw p m -> Bool
forall (p :: Nat) (m :: Nat). Raw p m -> Raw p m -> Ordering
forall (p :: Nat) (m :: Nat). Raw p m -> Raw p m -> Raw p m
min :: Raw p m -> Raw p m -> Raw p m
$cmin :: forall (p :: Nat) (m :: Nat). Raw p m -> Raw p m -> Raw p m
max :: Raw p m -> Raw p m -> Raw p m
$cmax :: forall (p :: Nat) (m :: Nat). Raw p m -> Raw p m -> Raw p m
>= :: Raw p m -> Raw p m -> Bool
$c>= :: forall (p :: Nat) (m :: Nat). Raw p m -> Raw p m -> Bool
> :: Raw p m -> Raw p m -> Bool
$c> :: forall (p :: Nat) (m :: Nat). Raw p m -> Raw p m -> Bool
<= :: Raw p m -> Raw p m -> Bool
$c<= :: forall (p :: Nat) (m :: Nat). Raw p m -> Raw p m -> Bool
< :: Raw p m -> Raw p m -> Bool
$c< :: forall (p :: Nat) (m :: Nat). Raw p m -> Raw p m -> Bool
compare :: Raw p m -> Raw p m -> Ordering
$ccompare :: forall (p :: Nat) (m :: Nat). Raw p m -> Raw p m -> Ordering
$cp1Ord :: forall (p :: Nat) (m :: Nat). Eq (Raw p m)
Ord)

fromRaw :: Raw p m -> Int32
fromRaw :: Raw p m -> Int32
fromRaw (Raw Int32
k) = Int32
k

instance Show (Raw p m) where
  show :: Raw p m -> String
show (Raw Int32
k)
    | Int32
k Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== -Int32
1    = String
"0"
    | Int32
k Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
==  Int32
0    = String
"1"
    | Int32
k Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
==  Int32
1    = String
"g"
    | Bool
otherwise  = String
"g^" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int32 -> String
forall a. Show a => a -> String
show Int32
k

rawNeg :: WitnessC p m -> Raw p m -> Raw p m
rawNeg :: WitnessC p m -> Raw p m -> Raw p m
rawNeg (WitnessC ForeignPtr Int32
fptr) (Raw Int32
x) = IO (Raw p m) -> Raw p m
forall a. IO a -> a
unsafePerformIO (ForeignPtr Int32 -> (Ptr Int32 -> IO (Raw p m)) -> IO (Raw p m)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Int32
fptr (\Ptr Int32
ptr -> Int32 -> Raw p m
forall (p :: Nat) (m :: Nat). Int32 -> Raw p m
Raw (Int32 -> Raw p m) -> IO Int32 -> IO (Raw p m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Int32 -> Int32 -> IO Int32
zech_neg Ptr Int32
ptr Int32
x))

rawAdd :: WitnessC p m -> Raw p m -> Raw p m -> Raw p m
rawAdd :: WitnessC p m -> Raw p m -> Raw p m -> Raw p m
rawAdd (WitnessC ForeignPtr Int32
fptr) (Raw Int32
x) (Raw Int32
y) = IO (Raw p m) -> Raw p m
forall a. IO a -> a
unsafePerformIO (ForeignPtr Int32 -> (Ptr Int32 -> IO (Raw p m)) -> IO (Raw p m)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Int32
fptr (\Ptr Int32
ptr -> Int32 -> Raw p m
forall (p :: Nat) (m :: Nat). Int32 -> Raw p m
Raw (Int32 -> Raw p m) -> IO Int32 -> IO (Raw p m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Int32 -> Int32 -> Int32 -> IO Int32
zech_add Ptr Int32
ptr Int32
x Int32
y))

rawSub :: WitnessC p m -> Raw p m -> Raw p m -> Raw p m
rawSub :: WitnessC p m -> Raw p m -> Raw p m -> Raw p m
rawSub (WitnessC ForeignPtr Int32
fptr) (Raw Int32
x) (Raw Int32
y) = IO (Raw p m) -> Raw p m
forall a. IO a -> a
unsafePerformIO (ForeignPtr Int32 -> (Ptr Int32 -> IO (Raw p m)) -> IO (Raw p m)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Int32
fptr (\Ptr Int32
ptr -> Int32 -> Raw p m
forall (p :: Nat) (m :: Nat). Int32 -> Raw p m
Raw (Int32 -> Raw p m) -> IO Int32 -> IO (Raw p m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Int32 -> Int32 -> Int32 -> IO Int32
zech_sub Ptr Int32
ptr Int32
x Int32
y))

rawInv :: WitnessC p m -> Raw p m -> Raw p m
rawInv :: WitnessC p m -> Raw p m -> Raw p m
rawInv (WitnessC ForeignPtr Int32
fptr) (Raw Int32
x) = IO (Raw p m) -> Raw p m
forall a. IO a -> a
unsafePerformIO (ForeignPtr Int32 -> (Ptr Int32 -> IO (Raw p m)) -> IO (Raw p m)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Int32
fptr (\Ptr Int32
ptr -> Int32 -> Raw p m
forall (p :: Nat) (m :: Nat). Int32 -> Raw p m
Raw (Int32 -> Raw p m) -> IO Int32 -> IO (Raw p m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Int32 -> Int32 -> IO Int32
zech_inv Ptr Int32
ptr Int32
x))

rawMul :: WitnessC p m -> Raw p m -> Raw p m -> Raw p m
rawMul :: WitnessC p m -> Raw p m -> Raw p m -> Raw p m
rawMul (WitnessC ForeignPtr Int32
fptr) (Raw Int32
x) (Raw Int32
y) = IO (Raw p m) -> Raw p m
forall a. IO a -> a
unsafePerformIO (ForeignPtr Int32 -> (Ptr Int32 -> IO (Raw p m)) -> IO (Raw p m)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Int32
fptr (\Ptr Int32
ptr -> Int32 -> Raw p m
forall (p :: Nat) (m :: Nat). Int32 -> Raw p m
Raw (Int32 -> Raw p m) -> IO Int32 -> IO (Raw p m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Int32 -> Int32 -> Int32 -> IO Int32
zech_mul Ptr Int32
ptr Int32
x Int32
y))

rawDiv :: WitnessC p m -> Raw p m -> Raw p m -> Raw p m
rawDiv :: WitnessC p m -> Raw p m -> Raw p m -> Raw p m
rawDiv (WitnessC ForeignPtr Int32
fptr) (Raw Int32
x) (Raw Int32
y) = IO (Raw p m) -> Raw p m
forall a. IO a -> a
unsafePerformIO (ForeignPtr Int32 -> (Ptr Int32 -> IO (Raw p m)) -> IO (Raw p m)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Int32
fptr (\Ptr Int32
ptr -> Int32 -> Raw p m
forall (p :: Nat) (m :: Nat). Int32 -> Raw p m
Raw (Int32 -> Raw p m) -> IO Int32 -> IO (Raw p m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Int32 -> Int32 -> Int32 -> IO Int32
zech_div Ptr Int32
ptr Int32
x Int32
y))

rawPow :: WitnessC p m -> Raw p m -> Int -> Raw p m
rawPow :: WitnessC p m -> Raw p m -> Int -> Raw p m
rawPow (WitnessC ForeignPtr Int32
fptr) (Raw Int32
x) Int
e = IO (Raw p m) -> Raw p m
forall a. IO a -> a
unsafePerformIO (ForeignPtr Int32 -> (Ptr Int32 -> IO (Raw p m)) -> IO (Raw p m)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Int32
fptr (\Ptr Int32
ptr -> Int32 -> Raw p m
forall (p :: Nat) (m :: Nat). Int32 -> Raw p m
Raw (Int32 -> Raw p m) -> IO Int32 -> IO (Raw p m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Int32 -> Int32 -> CInt -> IO Int32
zech_pow Ptr Int32
ptr Int32
x (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
e)))

rawIsZero :: Raw p m -> Bool
rawIsZero :: Raw p m -> Bool
rawIsZero (Raw Int32
x) = (CBool -> Bool
cboolToBool (CBool -> Bool) -> CBool -> Bool
forall a b. (a -> b) -> a -> b
$ Int32 -> CBool
zech_is_zero Int32
x)

rawIsOne :: Raw p m -> Bool
rawIsOne :: Raw p m -> Bool
rawIsOne (Raw Int32
x) = (CBool -> Bool
cboolToBool (CBool -> Bool) -> CBool -> Bool
forall a b. (a -> b) -> a -> b
$ Int32 -> CBool
zech_is_one Int32
x)

rawZero :: Raw p m
rawZero :: Raw p m
rawZero = Int32 -> Raw p m
forall (p :: Nat) (m :: Nat). Int32 -> Raw p m
Raw (-Int32
1)

rawOne :: Raw p m
rawOne :: Raw p m
rawOne = Int32 -> Raw p m
forall (p :: Nat) (m :: Nat). Int32 -> Raw p m
Raw Int32
0

rawPrim :: Raw p m
rawPrim :: Raw p m
rawPrim = Int32 -> Raw p m
forall (p :: Nat) (m :: Nat). Int32 -> Raw p m
Raw Int32
1

rawEmbed :: WitnessC p m -> Int -> Raw p m
rawEmbed :: WitnessC p m -> Int -> Raw p m
rawEmbed (WitnessC ForeignPtr Int32
fptr) Int
k = IO (Raw p m) -> Raw p m
forall a. IO a -> a
unsafePerformIO (ForeignPtr Int32 -> (Ptr Int32 -> IO (Raw p m)) -> IO (Raw p m)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Int32
fptr (\Ptr Int32
ptr -> Int32 -> Raw p m
forall (p :: Nat) (m :: Nat). Int32 -> Raw p m
Raw (Int32 -> Raw p m) -> IO Int32 -> IO (Raw p m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Int32 -> CInt -> IO Int32
zech_embed Ptr Int32
ptr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k)))

rawEnumerate :: WitnessC p m -> [Raw p m]
rawEnumerate :: WitnessC p m -> [Raw p m]
rawEnumerate (WitnessC ForeignPtr Int32
fptr) = IO [Raw p m] -> [Raw p m]
forall a. IO a -> a
unsafePerformIO (IO [Raw p m] -> [Raw p m]) -> IO [Raw p m] -> [Raw p m]
forall a b. (a -> b) -> a -> b
$ do
  ForeignPtr Int32 -> (Ptr Int32 -> IO [Raw p m]) -> IO [Raw p m]
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Int32
fptr ((Ptr Int32 -> IO [Raw p m]) -> IO [Raw p m])
-> (Ptr Int32 -> IO [Raw p m]) -> IO [Raw p m]
forall a b. (a -> b) -> a -> b
$ \Ptr Int32
ptr -> do
    Int32
qminus1 <- Ptr Int32 -> Int -> IO Int32
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Int32
ptr Int
2     :: IO Int32
    let q :: Int
q = Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
qminus1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 :: Int
    Int -> (Ptr Int32 -> IO [Raw p m]) -> IO [Raw p m]
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
4Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
q) ((Ptr Int32 -> IO [Raw p m]) -> IO [Raw p m])
-> (Ptr Int32 -> IO [Raw p m]) -> IO [Raw p m]
forall a b. (a -> b) -> a -> b
$ \Ptr Int32
tgt -> do
      CInt
_ <- Ptr Int32 -> Ptr Int32 -> IO CInt
zech_enumerate Ptr Int32
ptr Ptr Int32
tgt
      (Int32 -> Raw p m) -> [Int32] -> [Raw p m]
forall a b. (a -> b) -> [a] -> [b]
map Int32 -> Raw p m
forall (p :: Nat) (m :: Nat). Int32 -> Raw p m
Raw ([Int32] -> [Raw p m]) -> IO [Int32] -> IO [Raw p m]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Ptr Int32 -> IO [Int32]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
q Ptr Int32
tgt

rawPrime :: WitnessC p m -> Int
rawPrime :: WitnessC p m -> Int
rawPrime (WitnessC ForeignPtr Int32
fptr) = IO Int -> Int
forall a. IO a -> a
unsafePerformIO (IO Int -> Int) -> IO Int -> Int
forall a b. (a -> b) -> a -> b
$ ForeignPtr Int32 -> (Ptr Int32 -> IO Int) -> IO Int
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Int32
fptr ((Ptr Int32 -> IO Int) -> IO Int)
-> (Ptr Int32 -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr Int32
ptr -> Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int) -> IO Int32 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Int32 -> Int -> IO Int32
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Int32
ptr Int
0 

rawDim :: WitnessC p m -> Int
rawDim :: WitnessC p m -> Int
rawDim (WitnessC ForeignPtr Int32
fptr) = IO Int -> Int
forall a. IO a -> a
unsafePerformIO (IO Int -> Int) -> IO Int -> Int
forall a b. (a -> b) -> a -> b
$ ForeignPtr Int32 -> (Ptr Int32 -> IO Int) -> IO Int
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Int32
fptr ((Ptr Int32 -> IO Int) -> IO Int)
-> (Ptr Int32 -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr Int32
ptr -> Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int) -> IO Int32 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Int32 -> Int -> IO Int32
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Int32
ptr Int
1 

rawFieldSize :: WitnessC p m -> Int
rawFieldSize :: WitnessC p m -> Int
rawFieldSize (WitnessC ForeignPtr Int32
fptr) = IO Int -> Int
forall a. IO a -> a
unsafePerformIO (IO Int -> Int) -> IO Int -> Int
forall a b. (a -> b) -> a -> b
$ do
  ForeignPtr Int32 -> (Ptr Int32 -> IO Int) -> IO Int
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Int32
fptr ((Ptr Int32 -> IO Int) -> IO Int)
-> (Ptr Int32 -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr Int32
ptr -> do
    Int32
qminus1 <- Ptr Int32 -> Int -> IO Int32
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Int32
ptr Int
2 :: IO Int32
    Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
qminus1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

--------------------------------------------------------------------------------
-- * foreign imports

cboolToBool :: CBool -> Bool
cboolToBool :: CBool -> Bool
cboolToBool CBool
b = (CBool
b CBool -> CBool -> Bool
forall a. Eq a => a -> a -> Bool
/= CBool
0)

foreign import ccall unsafe "zech_neg" zech_neg :: Ptr Int32 -> Int32 -> IO Int32
foreign import ccall unsafe "zech_add" zech_add :: Ptr Int32 -> Int32 -> Int32 -> IO Int32
foreign import ccall unsafe "zech_sub" zech_sub :: Ptr Int32 -> Int32 -> Int32 -> IO Int32
foreign import ccall unsafe "zech_inv" zech_inv :: Ptr Int32 -> Int32 -> IO Int32
foreign import ccall unsafe "zech_mul" zech_mul :: Ptr Int32 -> Int32 -> Int32 -> IO Int32
foreign import ccall unsafe "zech_div" zech_div :: Ptr Int32 -> Int32 -> Int32 -> IO Int32
foreign import ccall unsafe "zech_pow" zech_pow :: Ptr Int32 -> Int32 -> CInt  -> IO Int32

foreign import ccall unsafe "zech_zero" zech_zero :: Int32
foreign import ccall unsafe "zech_one"  zech_one  :: Int32
foreign import ccall unsafe "zech_prim" zech_prim :: Int32

foreign import ccall unsafe "zech_is_zero" zech_is_zero :: Int32 -> CBool
foreign import ccall unsafe "zech_is_one"  zech_is_one  :: Int32 -> CBool

foreign import ccall unsafe "zech_embed"     zech_embed     :: Ptr Int32 -> CInt      -> IO Int32
foreign import ccall unsafe "zech_enumerate" zech_enumerate :: Ptr Int32 -> Ptr Int32 -> IO CInt

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