{-|
Copyright  :  (C) 2019, Andrew Lelechenko
License    :  MIT
Maintainer :  QBayLogic B.V. <devops@qbaylogic.com>

This module contains code from: https://hackage.haskell.org/package/mod and has
the following license:

Copyright (c) 2019 Andrew Lelechenko

Permission is hereby granted, free of charge, to any person obtaining a copy of this software and
associated documentation files (the "Software"), to deal in the Software without restriction,
including without limitation the rights to use, copy, modify, merge, publish, distribute,
sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in all copies or
substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT
LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
-}

{-# LANGUAGE CPP #-}
{-# LANGUAGE UnboxedTuples #-}

module Clash.Sized.Internal.Mod where

import GHC.Exts
  ((==#), (<=#), geWord#, isTrue#, minusWord#, plusWord#, uncheckedShiftL#, xor#,
   timesWord2#, quotRemWord2#, and#)
#if MIN_VERSION_base(4,12,0)
import GHC.Exts (addWordC#)
#endif
#if !MIN_VERSION_base(4,12,0)
import GHC.Exts (Int#, Word#, plusWord2#, word2Int#)
#endif
import GHC.Natural (Natural (..))
import GHC.Integer.GMP.Internals
  (BigNat, Integer (..), bigNatToWord, compareBigNat, minusBigNat, minusBigNatWord,
   plusBigNat, plusBigNatWord, sizeofBigNat#, bitBigNat, wordToBigNat2,
   remBigNat, timesBigNat, timesBigNatWord, xorBigNat, wordToBigNat, andBigNat)
#if !MIN_VERSION_base(4,12,0)
import GHC.Integer.GMP.Internals (wordToInteger)
#endif

#include "MachDeps.h"

-- | modular subtraction
subMod :: Natural -> Natural -> Natural -> Natural
subMod :: Natural -> Natural -> Natural -> Natural
subMod (NatS# GmpLimb#
m#) (NatS# GmpLimb#
x#) (NatS# GmpLimb#
y#) =
  if Int# -> Bool
isTrue# (GmpLimb#
x# GmpLimb# -> GmpLimb# -> Int#
`geWord#` GmpLimb#
y#) then GmpLimb# -> Natural
NatS# GmpLimb#
z# else GmpLimb# -> Natural
NatS# (GmpLimb#
z# GmpLimb# -> GmpLimb# -> GmpLimb#
`plusWord#` GmpLimb#
m#)
  where
    z# :: GmpLimb#
z# = GmpLimb#
x# GmpLimb# -> GmpLimb# -> GmpLimb#
`minusWord#` GmpLimb#
y#
subMod NatS#{} Natural
_ Natural
_ = Natural
forall a. a
brokenInvariant
subMod (NatJ# BigNat
m#) (NatS# GmpLimb#
x#) (NatS# GmpLimb#
y#) =
  if Int# -> Bool
isTrue# (GmpLimb#
x# GmpLimb# -> GmpLimb# -> Int#
`geWord#` GmpLimb#
y#)
    then GmpLimb# -> Natural
NatS# (GmpLimb#
x# GmpLimb# -> GmpLimb# -> GmpLimb#
`minusWord#` GmpLimb#
y#)
    else BigNat -> Natural
bigNatToNat (BigNat -> Natural) -> BigNat -> Natural
forall a b. (a -> b) -> a -> b
$ BigNat
m# BigNat -> GmpLimb# -> BigNat
`minusBigNatWord` (GmpLimb#
y# GmpLimb# -> GmpLimb# -> GmpLimb#
`minusWord#` GmpLimb#
x#)
subMod (NatJ# BigNat
m#) (NatS# GmpLimb#
x#) (NatJ# BigNat
y#) =
  BigNat -> Natural
bigNatToNat (BigNat -> Natural) -> BigNat -> Natural
forall a b. (a -> b) -> a -> b
$ (BigNat
m# BigNat -> BigNat -> BigNat
`minusBigNat` BigNat
y#) BigNat -> GmpLimb# -> BigNat
`plusBigNatWord` GmpLimb#
x#
subMod NatJ#{} (NatJ# BigNat
x#) (NatS# GmpLimb#
y#) =
  BigNat -> Natural
bigNatToNat (BigNat -> Natural) -> BigNat -> Natural
forall a b. (a -> b) -> a -> b
$ BigNat
x# BigNat -> GmpLimb# -> BigNat
`minusBigNatWord` GmpLimb#
y#
subMod (NatJ# BigNat
m#) (NatJ# BigNat
x#) (NatJ# BigNat
y#) = case BigNat
x# BigNat -> BigNat -> Ordering
`compareBigNat` BigNat
y# of
  Ordering
LT -> BigNat -> Natural
bigNatToNat (BigNat -> Natural) -> BigNat -> Natural
forall a b. (a -> b) -> a -> b
$ (BigNat
m# BigNat -> BigNat -> BigNat
`minusBigNat` BigNat
y#) BigNat -> BigNat -> BigNat
`plusBigNat` BigNat
x#
  Ordering
EQ -> GmpLimb# -> Natural
NatS# GmpLimb#
0##
  Ordering
GT -> BigNat -> Natural
bigNatToNat (BigNat -> Natural) -> BigNat -> Natural
forall a b. (a -> b) -> a -> b
$ BigNat
x# BigNat -> BigNat -> BigNat
`minusBigNat` BigNat
y#

-- | modular addition
addMod :: Natural -> Natural -> Natural -> Natural
addMod :: Natural -> Natural -> Natural -> Natural
addMod (NatS# GmpLimb#
m#) (NatS# GmpLimb#
x#) (NatS# GmpLimb#
y#) =
  if Int# -> Bool
isTrue# Int#
c# Bool -> Bool -> Bool
|| Int# -> Bool
isTrue# (GmpLimb#
z# GmpLimb# -> GmpLimb# -> Int#
`geWord#` GmpLimb#
m#) then GmpLimb# -> Natural
NatS# (GmpLimb#
z# GmpLimb# -> GmpLimb# -> GmpLimb#
`minusWord#` GmpLimb#
m#) else GmpLimb# -> Natural
NatS# GmpLimb#
z#
  where
    !(# GmpLimb#
z#, Int#
c# #) = GmpLimb#
x# GmpLimb# -> GmpLimb# -> (# GmpLimb#, Int# #)
`addWordC#` GmpLimb#
y#
addMod NatS#{} Natural
_ Natural
_ = Natural
forall a. a
brokenInvariant
addMod (NatJ# BigNat
m#) (NatS# GmpLimb#
x#) (NatS# GmpLimb#
y#) =
  if Int# -> Bool
isTrue# Int#
c# then BigNat -> BigNat -> Natural
subIfGe (GmpLimb# -> GmpLimb# -> BigNat
wordToBigNat2 GmpLimb#
1## GmpLimb#
z#) BigNat
m# else GmpLimb# -> Natural
NatS# GmpLimb#
z#
  where
    !(# GmpLimb#
z#, Int#
c# #) = GmpLimb#
x# GmpLimb# -> GmpLimb# -> (# GmpLimb#, Int# #)
`addWordC#` GmpLimb#
y#
addMod (NatJ# BigNat
m#) (NatS# GmpLimb#
x#) (NatJ# BigNat
y#) = BigNat -> BigNat -> Natural
subIfGe (BigNat
y# BigNat -> GmpLimb# -> BigNat
`plusBigNatWord` GmpLimb#
x#) BigNat
m#
addMod (NatJ# BigNat
m#) (NatJ# BigNat
x#) (NatS# GmpLimb#
y#) = BigNat -> BigNat -> Natural
subIfGe (BigNat
x# BigNat -> GmpLimb# -> BigNat
`plusBigNatWord` GmpLimb#
y#) BigNat
m#
addMod (NatJ# BigNat
m#) (NatJ# BigNat
x#) (NatJ# BigNat
y#) = BigNat -> BigNat -> Natural
subIfGe (BigNat
x# BigNat -> BigNat -> BigNat
`plusBigNat`     BigNat
y#) BigNat
m#

-- | modular multiplication
mulMod :: Natural -> Natural -> Natural -> Natural
mulMod :: Natural -> Natural -> Natural -> Natural
mulMod (NatS# GmpLimb#
m#) (NatS# GmpLimb#
x#) (NatS# GmpLimb#
y#) = GmpLimb# -> Natural
NatS# GmpLimb#
r#
  where
    !(# GmpLimb#
z1#, GmpLimb#
z2# #) = GmpLimb# -> GmpLimb# -> (# GmpLimb#, GmpLimb# #)
timesWord2# GmpLimb#
x# GmpLimb#
y#
    !(# GmpLimb#
_, GmpLimb#
r# #) = GmpLimb# -> GmpLimb# -> GmpLimb# -> (# GmpLimb#, GmpLimb# #)
quotRemWord2# GmpLimb#
z1# GmpLimb#
z2# GmpLimb#
m#
mulMod NatS#{} Natural
_ Natural
_ = Natural
forall a. a
brokenInvariant
mulMod (NatJ# BigNat
m#) (NatS# GmpLimb#
x#) (NatS# GmpLimb#
y#) =
  BigNat -> Natural
bigNatToNat (BigNat -> Natural) -> BigNat -> Natural
forall a b. (a -> b) -> a -> b
$ GmpLimb# -> GmpLimb# -> BigNat
wordToBigNat2 GmpLimb#
z1# GmpLimb#
z2# BigNat -> BigNat -> BigNat
`remBigNat` BigNat
m#
  where
    !(# GmpLimb#
z1#, GmpLimb#
z2# #) = GmpLimb# -> GmpLimb# -> (# GmpLimb#, GmpLimb# #)
timesWord2# GmpLimb#
x# GmpLimb#
y#
mulMod (NatJ# BigNat
m#) (NatS# GmpLimb#
x#) (NatJ# BigNat
y#) =
  BigNat -> Natural
bigNatToNat (BigNat -> Natural) -> BigNat -> Natural
forall a b. (a -> b) -> a -> b
$ (BigNat
y# BigNat -> GmpLimb# -> BigNat
`timesBigNatWord` GmpLimb#
x#) BigNat -> BigNat -> BigNat
`remBigNat` BigNat
m#
mulMod (NatJ# BigNat
m#) (NatJ# BigNat
x#) (NatS# GmpLimb#
y#) =
  BigNat -> Natural
bigNatToNat (BigNat -> Natural) -> BigNat -> Natural
forall a b. (a -> b) -> a -> b
$ (BigNat
x# BigNat -> GmpLimb# -> BigNat
`timesBigNatWord` GmpLimb#
y#) BigNat -> BigNat -> BigNat
`remBigNat` BigNat
m#
mulMod (NatJ# BigNat
m#) (NatJ# BigNat
x#) (NatJ# BigNat
y#) =
  BigNat -> Natural
bigNatToNat (BigNat -> Natural) -> BigNat -> Natural
forall a b. (a -> b) -> a -> b
$ (BigNat
x# BigNat -> BigNat -> BigNat
`timesBigNat` BigNat
y#) BigNat -> BigNat -> BigNat
`remBigNat` BigNat
m#

-- | modular multiplication for powers of 2, takes a mask instead of a
-- wrap-around point
mulMod2 :: Natural -> Natural -> Natural -> Natural
mulMod2 :: Natural -> Natural -> Natural -> Natural
mulMod2 (NatS# GmpLimb#
m#) (NatS# GmpLimb#
x#) (NatS# GmpLimb#
y#) = GmpLimb# -> Natural
NatS# (GmpLimb#
z2# GmpLimb# -> GmpLimb# -> GmpLimb#
`and#` GmpLimb#
m#)
  where
    !(# GmpLimb#
_, GmpLimb#
z2# #) = GmpLimb# -> GmpLimb# -> (# GmpLimb#, GmpLimb# #)
timesWord2# GmpLimb#
x# GmpLimb#
y#
mulMod2 NatS#{} Natural
_ Natural
_ = Natural
forall a. a
brokenInvariant
mulMod2 (NatJ# BigNat
m#) (NatS# GmpLimb#
x#) (NatS# GmpLimb#
y#) =
  BigNat -> Natural
bigNatToNat (BigNat -> Natural) -> BigNat -> Natural
forall a b. (a -> b) -> a -> b
$ GmpLimb# -> GmpLimb# -> BigNat
wordToBigNat2 GmpLimb#
z1# GmpLimb#
z2# BigNat -> BigNat -> BigNat
`andBigNat` BigNat
m#
  where
    !(# GmpLimb#
z1#, GmpLimb#
z2# #) = GmpLimb# -> GmpLimb# -> (# GmpLimb#, GmpLimb# #)
timesWord2# GmpLimb#
x# GmpLimb#
y#
mulMod2 (NatJ# BigNat
m#) (NatS# GmpLimb#
x#) (NatJ# BigNat
y#) =
  BigNat -> Natural
bigNatToNat (BigNat -> Natural) -> BigNat -> Natural
forall a b. (a -> b) -> a -> b
$ (BigNat
y# BigNat -> GmpLimb# -> BigNat
`timesBigNatWord` GmpLimb#
x#) BigNat -> BigNat -> BigNat
`andBigNat` BigNat
m#
mulMod2 (NatJ# BigNat
m#) (NatJ# BigNat
x#) (NatS# GmpLimb#
y#) =
  BigNat -> Natural
bigNatToNat (BigNat -> Natural) -> BigNat -> Natural
forall a b. (a -> b) -> a -> b
$ (BigNat
x# BigNat -> GmpLimb# -> BigNat
`timesBigNatWord` GmpLimb#
y#) BigNat -> BigNat -> BigNat
`andBigNat` BigNat
m#
mulMod2 (NatJ# BigNat
m#) (NatJ# BigNat
x#) (NatJ# BigNat
y#) =
  BigNat -> Natural
bigNatToNat (BigNat -> Natural) -> BigNat -> Natural
forall a b. (a -> b) -> a -> b
$ (BigNat
x# BigNat -> BigNat -> BigNat
`timesBigNat` BigNat
y#) BigNat -> BigNat -> BigNat
`andBigNat` BigNat
m#

-- | modular negations
negateMod :: Natural -> Natural -> Natural
negateMod :: Natural -> Natural -> Natural
negateMod Natural
_ (NatS# GmpLimb#
0##) = GmpLimb# -> Natural
NatS# GmpLimb#
0##
negateMod (NatS# GmpLimb#
m#) (NatS# GmpLimb#
x#) = GmpLimb# -> Natural
NatS# (GmpLimb#
m# GmpLimb# -> GmpLimb# -> GmpLimb#
`minusWord#` GmpLimb#
x#)
negateMod NatS#{} Natural
_ = Natural
forall a. a
brokenInvariant
negateMod (NatJ# BigNat
m#) (NatS# GmpLimb#
x#) = BigNat -> Natural
bigNatToNat (BigNat -> Natural) -> BigNat -> Natural
forall a b. (a -> b) -> a -> b
$ BigNat
m# BigNat -> GmpLimb# -> BigNat
`minusBigNatWord` GmpLimb#
x#
negateMod (NatJ# BigNat
m#) (NatJ# BigNat
x#) = BigNat -> Natural
bigNatToNat (BigNat -> Natural) -> BigNat -> Natural
forall a b. (a -> b) -> a -> b
$ BigNat
m# BigNat -> BigNat -> BigNat
`minusBigNat`     BigNat
x#

-- | Given a size in bits, return a function that complements the bits in a
-- 'Natural' up to that size.
complementMod
  :: Integer
  -> (Natural -> Natural)
complementMod :: Integer -> Natural -> Natural
complementMod (S# Int#
sz#) =
  if Int# -> Bool
isTrue# (Int#
sz# Int# -> Int# -> Int#
<=# WORD_SIZE_IN_BITS#) then
    let m# :: GmpLimb#
m# = if Int# -> Bool
isTrue# (Int#
sz# Int# -> Int# -> Int#
==# WORD_SIZE_IN_BITS#) then
#if WORD_SIZE_IN_BITS == 64
                GmpLimb#
0xFFFFFFFFFFFFFFFF##
#elif WORD_SIZE_IN_BITS == 32
                0xFFFFFFFF##
#else
#error Unhandled value for WORD_SIZE_IN_BITS
#endif
             else
               (GmpLimb#
1## GmpLimb# -> Int# -> GmpLimb#
`uncheckedShiftL#` Int#
sz#) GmpLimb# -> GmpLimb# -> GmpLimb#
`minusWord#` GmpLimb#
1##
        go :: Natural -> Natural
go (NatS# GmpLimb#
x#) = GmpLimb# -> Natural
NatS# (GmpLimb#
x# GmpLimb# -> GmpLimb# -> GmpLimb#
`xor#` GmpLimb#
m#)
        go (NatJ# BigNat
r#) = GmpLimb# -> Natural
NatS# (BigNat -> GmpLimb#
bigNatToWord BigNat
r# GmpLimb# -> GmpLimb# -> GmpLimb#
`xor#` GmpLimb#
m#)
    in  Natural -> Natural
go
  else
    let m# :: BigNat
m# = Int# -> BigNat
bitBigNat Int#
sz# BigNat -> GmpLimb# -> BigNat
`minusBigNatWord` GmpLimb#
1##

        go :: Natural -> Natural
go (NatS# GmpLimb#
x#) = BigNat -> Natural
bigNatToNat (BigNat -> BigNat -> BigNat
xorBigNat (GmpLimb# -> BigNat
wordToBigNat GmpLimb#
x#) BigNat
m#)
        go (NatJ# BigNat
x#) = BigNat -> Natural
bigNatToNat (BigNat -> BigNat -> BigNat
xorBigNat BigNat
x# BigNat
m#)
    in  Natural -> Natural
go
complementMod Integer
_ = [Char] -> Natural -> Natural
forall a. HasCallStack => [Char] -> a
error [Char]
"size too large"

-- | Keep all the bits up to a certain size
maskMod
  :: Integer
  -> (Natural -> Natural)
maskMod :: Integer -> Natural -> Natural
maskMod (S# Int#
sz#) =
  if Int# -> Bool
isTrue# (Int#
sz# Int# -> Int# -> Int#
<=# WORD_SIZE_IN_BITS#) then
    if Int# -> Bool
isTrue# (Int#
sz# Int# -> Int# -> Int#
==# WORD_SIZE_IN_BITS#) then
       -- Mask equal to the word size
       let go :: Natural -> Natural
go (NatJ# BigNat
x#) = GmpLimb# -> Natural
NatS# (BigNat -> GmpLimb#
bigNatToWord BigNat
x#)
           go Natural
n          = Natural
n
       in  Natural -> Natural
go
    else
       let m# :: GmpLimb#
m# = (GmpLimb#
1## GmpLimb# -> Int# -> GmpLimb#
`uncheckedShiftL#` Int#
sz#) GmpLimb# -> GmpLimb# -> GmpLimb#
`minusWord#` GmpLimb#
1##

           go :: Natural -> Natural
go (NatS# GmpLimb#
x#) = GmpLimb# -> Natural
NatS# (GmpLimb#
x# GmpLimb# -> GmpLimb# -> GmpLimb#
`and#` GmpLimb#
m#)
           go (NatJ# BigNat
x#) = GmpLimb# -> Natural
NatS# (BigNat -> GmpLimb#
bigNatToWord BigNat
x# GmpLimb# -> GmpLimb# -> GmpLimb#
`and#` GmpLimb#
m#)
       in  Natural -> Natural
go
  else
    let m# :: BigNat
m# = Int# -> BigNat
bitBigNat Int#
sz#

        -- faster than `andBigNat (m# `minuxBigNatWord` 1##)`
        go :: Natural -> Natural
go (NatJ# BigNat
x#) = BigNat -> Natural
bigNatToNat (BigNat -> BigNat -> BigNat
remBigNat BigNat
x# BigNat
m#)
        -- The mask is larger than the word size, so we can keep all the bits
        go Natural
x = Natural
x
    in  Natural -> Natural
go
maskMod Integer
_ = [Char] -> Natural -> Natural
forall a. HasCallStack => [Char] -> a
error [Char]
"size too large"

bigNatToNat :: BigNat -> Natural
bigNatToNat :: BigNat -> Natural
bigNatToNat BigNat
r# =
  if Int# -> Bool
isTrue# (BigNat -> Int#
sizeofBigNat# BigNat
r# Int# -> Int# -> Int#
==# Int#
1#) then
    GmpLimb# -> Natural
NatS# (BigNat -> GmpLimb#
bigNatToWord BigNat
r#)
  else
    BigNat -> Natural
NatJ# BigNat
r#

subIfGe :: BigNat -> BigNat -> Natural
subIfGe :: BigNat -> BigNat -> Natural
subIfGe BigNat
z# BigNat
m# = case BigNat
z# BigNat -> BigNat -> Ordering
`compareBigNat` BigNat
m# of
  Ordering
LT -> BigNat -> Natural
NatJ# BigNat
z#
  Ordering
EQ -> GmpLimb# -> Natural
NatS# GmpLimb#
0##
  Ordering
GT -> BigNat -> Natural
bigNatToNat (BigNat -> Natural) -> BigNat -> Natural
forall a b. (a -> b) -> a -> b
$ BigNat
z# BigNat -> BigNat -> BigNat
`minusBigNat` BigNat
m#

#if !MIN_VERSION_base(4,12,0)
addWordC# :: Word# -> Word# -> (# Word#, Int# #)
addWordC# x# y# = (# z#, word2Int# c# #)
  where
    !(# c#, z# #) = x# `plusWord2#` y#

naturalToInteger :: Natural -> Integer
naturalToInteger (NatS# w)  = wordToInteger w
naturalToInteger (NatJ# bn) = Jp# bn
#endif

brokenInvariant :: a
brokenInvariant :: a
brokenInvariant = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"argument is larger than modulo"