{-# 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 = Integer mask Integer -> Integer -> Integer forall a. Bits a => a -> a -> a .&. Int -> Integer -> Integer -> Integer go Int 0 Integer 0 (Integer -> Integer reduce Integer 1) 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 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