{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
module Cryptol.F2 where

import Data.Bits
import Cryptol.TypeCheck.Solver.InfNat (widthInteger)

pmult :: Int -> Integer -> Integer -> Integer
pmult :: Int -> Integer -> Integer -> Integer
pmult Int
w Integer
x Integer
y = Int -> Integer -> Integer
go (Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Integer
0
  where
    go :: Int -> Integer -> Integer
go !Int
i !Integer
z
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0    = Int -> Integer -> Integer
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (if Integer -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Integer
x Int
i then (Integer
z Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
1) Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
`xor` Integer
y else (Integer
z Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
1))
      | Bool
otherwise = Integer
z

pdiv :: Int -> Integer -> Integer -> Integer
pdiv :: Int -> Integer -> Integer -> Integer
pdiv Int
w Integer
x Integer
m = Int -> Integer -> Integer -> Integer
forall t. (Bits t, Num t) => Int -> Integer -> t -> t
go (Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Integer
0 Integer
0
  where
    degree :: Int
    degree :: Int
degree = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Integer
widthInteger Integer
m Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)

    reduce :: Integer -> Integer
    reduce :: Integer -> Integer
reduce Integer
u = if Integer -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Integer
u Int
degree then Integer
u Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
`xor` Integer
m else Integer
u
    {-# INLINE reduce #-}

    go :: Int -> Integer -> t -> t
go !Int
i !Integer
z !t
r
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0    = Int -> Integer -> t -> t
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Integer
z' t
r'
      | Bool
otherwise = t
r
     where
      zred :: Integer
zred = Integer -> Integer
reduce Integer
z
      z' :: Integer
z'   = if Integer -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Integer
x  Int
i      then (Integer
zred Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
1) Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer
1 else Integer
zred Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
1
      r' :: t
r'   = if Integer -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Integer
z' Int
degree then (t
r    t -> Int -> t
forall a. Bits a => a -> Int -> a
`shiftL` Int
1) t -> t -> t
forall a. Bits a => a -> a -> a
.|. t
1 else t
r    t -> Int -> t
forall a. Bits a => a -> Int -> a
`shiftL` Int
1


pmod :: Int -> Integer -> Integer -> Integer
pmod :: Int -> Integer -> Integer -> Integer
pmod Int
w Integer
x Integer
m = Int -> Integer -> Integer -> Integer
go Int
degree (Integer
x Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
mask) (Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
clearBit Integer
m Int
degree)
  where
    degree :: Int
    degree :: Int
degree = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Integer
widthInteger Integer
m Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)

    reduce :: Integer -> Integer
    reduce :: Integer -> Integer
reduce Integer
u = if Integer -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Integer
u Int
degree then Integer
u Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
`xor` Integer
m else Integer
u
    {-# INLINE reduce #-}

    mask :: Integer
mask = Int -> Integer
forall a. Bits a => Int -> a
bit Int
degree Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1

    -- invariant: z and p are in the range [0..mask]
    go :: Int -> Integer -> Integer -> Integer
go !Int
i !Integer
z !Integer
p
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
w     = Int -> Integer -> Integer -> Integer
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (if Integer -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Integer
x Int
i then Integer
z Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
`xor` Integer
p else Integer
z) (Integer -> Integer
reduce (Integer
p Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
1))
      | Bool
otherwise = Integer
z