    {-# 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