{-# LANGUAGE CPP                   #-}
{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MagicHash             #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE QuasiQuotes           #-}
{-# LANGUAGE RebindableSyntax      #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE UndecidableInstances  #-}
{-# LANGUAGE ViewPatterns          #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- |
-- Module      : Data.Array.Accelerate.Internal.Orphans.Base
-- Copyright   : [2016..2020] Trevor L. McDonell
-- License     : BSD3
--
-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--
-- Orphan instances for BigWord and BigInt for use with Accelerate. In
-- a separate module so that (a) we can use rebindable syntax; and (b) to avoid
-- excessive class constraints by placing instances next to each other.
--

#include "MachDeps.h"

module Data.Array.Accelerate.Internal.Orphans.Base ()
  where

import Data.Array.Accelerate.Internal.BigInt
import Data.Array.Accelerate.Internal.BigWord
import Data.Array.Accelerate.Internal.Num2
import Data.Array.Accelerate.Internal.Orphans.Elt

import qualified Data.Array.Accelerate.Internal.LLVM.Native         as CPU
import qualified Data.Array.Accelerate.Internal.LLVM.PTX            as PTX

import Data.Array.Accelerate                                        as A hiding ( fromInteger )
import Data.Array.Accelerate.Sugar.Elt
import Data.Array.Accelerate.Analysis.Match                         as A
import Data.Array.Accelerate.Data.Bits                              as A
import Data.Array.Accelerate.Smart

import Control.Monad
import Language.Haskell.TH                                          hiding ( Exp )
import Text.Printf
import Unsafe.Coerce
import Prelude                                                      ( id, fromInteger )
import qualified Prelude                                            as P


-- BigWord
-- -------

type BigWordCtx hi lo =
    ( Elt hi, Elt lo, Elt (BigWord hi lo)
    , hi ~ Unsigned hi
    , lo ~ Unsigned lo
    , Exp hi ~ Unsigned (Exp hi)
    , Exp lo ~ Unsigned (Exp lo)
    )


instance (Bounded a, Bounded b, Elt (BigWord a b)) => P.Bounded (Exp (BigWord a b)) where
  minBound :: Exp (BigWord a b)
minBound = Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ Exp a
forall a. Bounded a => a
minBound Exp b
forall a. Bounded a => a
minBound
  maxBound :: Exp (BigWord a b)
maxBound = Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ Exp a
forall a. Bounded a => a
maxBound Exp b
forall a. Bounded a => a
maxBound


instance (Eq a, Eq b, Elt (BigWord a b)) => Eq (BigWord a b) where
  W2_ Exp a
xh Exp b
xl == :: Exp (BigWord a b) -> Exp (BigWord a b) -> Exp Bool
== W2_ Exp a
yh Exp b
yl = Exp a
xh Exp a -> Exp a -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp a
yh Exp Bool -> Exp Bool -> Exp Bool
&& Exp b
xl Exp b -> Exp b -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp b
yl
  W2_ Exp a
xh Exp b
xl /= :: Exp (BigWord a b) -> Exp (BigWord a b) -> Exp Bool
/= W2_ Exp a
yh Exp b
yl = Exp a
xh Exp a -> Exp a -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
/= Exp a
yh Exp Bool -> Exp Bool -> Exp Bool
|| Exp b
xl Exp b -> Exp b -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
/= Exp b
yl


instance (Ord a, Ord b, Elt (BigWord a b)) => Ord (BigWord a b) where
  W2_ Exp a
xh Exp b
xl < :: Exp (BigWord a b) -> Exp (BigWord a b) -> Exp Bool
<  W2_ Exp a
yh Exp b
yl = Exp a
xh Exp a -> Exp a -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp a
yh Exp Bool -> (Exp Bool, Exp Bool) -> Exp Bool
forall t. Elt t => Exp Bool -> (Exp t, Exp t) -> Exp t
? ( Exp b
xl Exp b -> Exp b -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
< Exp b
yl,  Exp a
xh Exp a -> Exp a -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
< Exp a
yh )
  W2_ Exp a
xh Exp b
xl > :: Exp (BigWord a b) -> Exp (BigWord a b) -> Exp Bool
>  W2_ Exp a
yh Exp b
yl = Exp a
xh Exp a -> Exp a -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp a
yh Exp Bool -> (Exp Bool, Exp Bool) -> Exp Bool
forall t. Elt t => Exp Bool -> (Exp t, Exp t) -> Exp t
? ( Exp b
xl Exp b -> Exp b -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
> Exp b
yl,  Exp a
xh Exp a -> Exp a -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
> Exp a
yh )
  W2_ Exp a
xh Exp b
xl <= :: Exp (BigWord a b) -> Exp (BigWord a b) -> Exp Bool
<= W2_ Exp a
yh Exp b
yl = Exp a
xh Exp a -> Exp a -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp a
yh Exp Bool -> (Exp Bool, Exp Bool) -> Exp Bool
forall t. Elt t => Exp Bool -> (Exp t, Exp t) -> Exp t
? ( Exp b
xl Exp b -> Exp b -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
<= Exp b
yl, Exp a
xh Exp a -> Exp a -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
<= Exp a
yh )
  W2_ Exp a
xh Exp b
xl >= :: Exp (BigWord a b) -> Exp (BigWord a b) -> Exp Bool
>= W2_ Exp a
yh Exp b
yl = Exp a
xh Exp a -> Exp a -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp a
yh Exp Bool -> (Exp Bool, Exp Bool) -> Exp Bool
forall t. Elt t => Exp Bool -> (Exp t, Exp t) -> Exp t
? ( Exp b
xl Exp b -> Exp b -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
>= Exp b
yl, Exp a
xh Exp a -> Exp a -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
>= Exp a
yh )


instance ( Num a
         , Integral b, Num2 (Exp b), FromIntegral b a
         , Eq (BigWord a b)
         , P.Num (BigWord a b)
         , BigWordCtx a b
         )
    => P.Num (Exp (BigWord a b)) where
  negate :: Exp (BigWord a b) -> Exp (BigWord a b)
negate (W2_ Exp a
hi Exp b
lo) =
    if Exp b
lo Exp b -> Exp b -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp b
0
      then Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ (Exp a -> Exp a
forall a. Num a => a -> a
negate Exp a
hi) Exp b
0
      else Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ (Exp a -> Exp a
forall a. Num a => a -> a
negate (Exp a
hiExp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
+Exp a
1)) (Exp b -> Exp b
forall a. Num a => a -> a
negate Exp b
lo)

  abs :: Exp (BigWord a b) -> Exp (BigWord a b)
abs         = Exp (BigWord a b) -> Exp (BigWord a b)
forall a. a -> a
id
  signum :: Exp (BigWord a b) -> Exp (BigWord a b)
signum Exp (BigWord a b)
x    = Exp (BigWord a b)
x Exp (BigWord a b) -> Exp (BigWord a b) -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp (BigWord a b)
0 Exp Bool
-> (Exp (BigWord a b), Exp (BigWord a b)) -> Exp (BigWord a b)
forall t. Elt t => Exp Bool -> (Exp t, Exp t) -> Exp t
? (Exp (BigWord a b)
0,Exp (BigWord a b)
1)
  fromInteger :: Integer -> Exp (BigWord a b)
fromInteger = BigWord a b -> Exp (BigWord a b)
forall e. (HasCallStack, Elt e) => e -> Exp e
constant (BigWord a b -> Exp (BigWord a b))
-> (Integer -> BigWord a b) -> Integer -> Exp (BigWord a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> BigWord a b
forall a. Num a => Integer -> a
P.fromInteger

  {-# SPECIALIZE (+) :: Exp Word128 -> Exp Word128 -> Exp Word128 #-}
  + :: Exp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b)
(+) | Just BigWord a b :~: Word128
Refl <- Elt (BigWord a b) => Maybe (BigWord a b :~: Word128)
forall t. Elt t => Maybe (t :~: Word128)
matchWord128 @(BigWord a b) = (Exp Word128 -> Exp Word128 -> Exp Word128)
-> Exp Word128 -> Exp Word128 -> Exp Word128
CPU.addWord128# ((Exp Word128 -> Exp Word128 -> Exp Word128)
 -> Exp Word128 -> Exp Word128 -> Exp Word128)
-> (Exp Word128 -> Exp Word128 -> Exp Word128)
-> Exp Word128
-> Exp Word128
-> Exp Word128
forall a b. (a -> b) -> a -> b
$ (Exp Word128 -> Exp Word128 -> Exp Word128)
-> Exp Word128 -> Exp Word128 -> Exp Word128
PTX.addWord128# Exp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b)
Exp Word128 -> Exp Word128 -> Exp Word128
add
      | Bool
otherwise                                = Exp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b)
add
    where
      add :: Exp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b)
      add :: Exp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b)
add (W2_ Exp a
xh Exp b
xl) (W2_ Exp a
yh Exp b
yl) = Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ Exp a
hi Exp b
lo
        where
          lo :: Exp b
lo = Exp b
xl Exp b -> Exp b -> Exp b
forall a. Num a => a -> a -> a
+ Exp b
yl
          hi :: Exp a
hi = Exp a
xh Exp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
+ Exp a
yh Exp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
+ if Exp b
lo Exp b -> Exp b -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
< Exp b
xl then Exp a
1 else Exp a
0

  {-# SPECIALIZE (-) :: Exp Word128 -> Exp Word128 -> Exp Word128 #-}
  (-) | Just BigWord a b :~: Word128
Refl <- Elt (BigWord a b) => Maybe (BigWord a b :~: Word128)
forall t. Elt t => Maybe (t :~: Word128)
matchWord128 @(BigWord a b) = (Exp Word128 -> Exp Word128 -> Exp Word128)
-> Exp Word128 -> Exp Word128 -> Exp Word128
CPU.subWord128# ((Exp Word128 -> Exp Word128 -> Exp Word128)
 -> Exp Word128 -> Exp Word128 -> Exp Word128)
-> (Exp Word128 -> Exp Word128 -> Exp Word128)
-> Exp Word128
-> Exp Word128
-> Exp Word128
forall a b. (a -> b) -> a -> b
$ (Exp Word128 -> Exp Word128 -> Exp Word128)
-> Exp Word128 -> Exp Word128 -> Exp Word128
PTX.subWord128# (\Exp Word128
x Exp Word128
y -> Exp Word128
x Exp Word128 -> Exp Word128 -> Exp Word128
forall a. Num a => a -> a -> a
+ Exp Word128 -> Exp Word128
forall a. Num a => a -> a
negate Exp Word128
y)
      | Bool
otherwise                                = \Exp (BigWord a b)
x Exp (BigWord a b)
y -> Exp (BigWord a b)
x Exp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b)
forall a. Num a => a -> a -> a
+ Exp (BigWord a b) -> Exp (BigWord a b)
forall a. Num a => a -> a
negate Exp (BigWord a b)
y

  {-# SPECIALIZE (*) :: Exp Word128 -> Exp Word128 -> Exp Word128 #-}
  * :: Exp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b)
(*) | Just BigWord a b :~: Word128
Refl <- Elt (BigWord a b) => Maybe (BigWord a b :~: Word128)
forall t. Elt t => Maybe (t :~: Word128)
matchWord128 @(BigWord a b) = (Exp Word128 -> Exp Word128 -> Exp Word128)
-> Exp Word128 -> Exp Word128 -> Exp Word128
CPU.mulWord128# ((Exp Word128 -> Exp Word128 -> Exp Word128)
 -> Exp Word128 -> Exp Word128 -> Exp Word128)
-> (Exp Word128 -> Exp Word128 -> Exp Word128)
-> Exp Word128
-> Exp Word128
-> Exp Word128
forall a b. (a -> b) -> a -> b
$ (Exp Word128 -> Exp Word128 -> Exp Word128)
-> Exp Word128 -> Exp Word128 -> Exp Word128
PTX.mulWord128# Exp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b)
Exp Word128 -> Exp Word128 -> Exp Word128
mul
      | Bool
otherwise                                = Exp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b)
mul
    where
      mul :: Exp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b)
      mul :: Exp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b)
mul (W2_ Exp a
xh Exp b
xl) (W2_ Exp a
yh Exp b
yl) = Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ Exp a
hi Exp b
lo
        where
          hi :: Exp a
hi      = Exp a
xh Exp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
* Exp b -> Exp a
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp b
yl Exp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
+ Exp a
yh Exp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
* Exp b -> Exp a
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp b
xl Exp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
+ Exp b -> Exp a
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp b
c
          (Exp b
c,Exp b
lo)  = Exp b -> Exp b -> (Exp b, Unsigned (Exp b))
forall w. Num2 w => w -> w -> (w, Unsigned w)
mulWithCarry Exp b
xl Exp b
yl


instance ( Integral a, FiniteBits a, FromIntegral a b, Num2 (Exp a), Bounded a
         , Integral b, FiniteBits b, FromIntegral b a, Num2 (Exp b), Bounded b
         , Num (BigWord a b)
         , Num2 (Exp (BigWord a b))
         , BigWordCtx a b
#if MIN_VERSION_accelerate(1,2,0)
         , Enum (BigWord a b)
#endif
         )
    => P.Integral (Exp (BigWord a b)) where
  toInteger :: Exp (BigWord a b) -> Integer
toInteger = [Char] -> Exp (BigWord a b) -> Integer
forall a. HasCallStack => [Char] -> a
error [Char]
"Prelude.toInteger is not supported for Accelerate types"

  {-# SPECIALIZE div    :: Exp Word128 -> Exp Word128 -> Exp Word128 #-}
  {-# SPECIALIZE mod    :: Exp Word128 -> Exp Word128 -> Exp Word128 #-}
  {-# SPECIALIZE divMod :: Exp Word128 -> Exp Word128 -> (Exp Word128, Exp Word128) #-}
  div :: Exp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b)
div    = Exp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b)
forall a. Integral a => a -> a -> a
quot
  mod :: Exp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b)
mod    = Exp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b)
forall a. Integral a => a -> a -> a
rem
  divMod :: Exp (BigWord a b)
-> Exp (BigWord a b) -> (Exp (BigWord a b), Exp (BigWord a b))
divMod = Exp (BigWord a b)
-> Exp (BigWord a b) -> (Exp (BigWord a b), Exp (BigWord a b))
forall a. Integral a => a -> a -> (a, a)
quotRem

  {-# SPECIALISE quot :: Exp Word128 -> Exp Word128 -> Exp Word128 #-}
  quot :: Exp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b)
quot | Just BigWord a b :~: Word128
Refl <- Elt (BigWord a b) => Maybe (BigWord a b :~: Word128)
forall t. Elt t => Maybe (t :~: Word128)
matchWord128 @(BigWord a b) = (Exp Word128 -> Exp Word128 -> Exp Word128)
-> Exp Word128 -> Exp Word128 -> Exp Word128
CPU.quotWord128# ((Exp Word128 -> Exp Word128 -> Exp Word128)
 -> Exp Word128 -> Exp Word128 -> Exp Word128)
-> (Exp Word128 -> Exp Word128 -> Exp Word128)
-> Exp Word128
-> Exp Word128
-> Exp Word128
forall a b. (a -> b) -> a -> b
$ (Exp Word128 -> Exp Word128 -> Exp Word128)
-> Exp Word128 -> Exp Word128 -> Exp Word128
PTX.quotWord128# Exp Word128 -> Exp Word128 -> Exp Word128
forall a. Integral a => a -> a -> a
go
       | Bool
otherwise                                = Exp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b)
forall a. Integral a => a -> a -> a
go
    where
      go :: b -> b -> b
go b
x b
y = (b, b) -> b
forall a b. (a, b) -> a
P.fst (b -> b -> (b, b)
forall a. Integral a => a -> a -> (a, a)
quotRem b
x b
y)

  {-# SPECIALISE rem :: Exp Word128 -> Exp Word128 -> Exp Word128 #-}
  rem :: Exp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b)
rem | Just BigWord a b :~: Word128
Refl <- Elt (BigWord a b) => Maybe (BigWord a b :~: Word128)
forall t. Elt t => Maybe (t :~: Word128)
matchWord128 @(BigWord a b) = (Exp Word128 -> Exp Word128 -> Exp Word128)
-> Exp Word128 -> Exp Word128 -> Exp Word128
CPU.remWord128# ((Exp Word128 -> Exp Word128 -> Exp Word128)
 -> Exp Word128 -> Exp Word128 -> Exp Word128)
-> (Exp Word128 -> Exp Word128 -> Exp Word128)
-> Exp Word128
-> Exp Word128
-> Exp Word128
forall a b. (a -> b) -> a -> b
$ (Exp Word128 -> Exp Word128 -> Exp Word128)
-> Exp Word128 -> Exp Word128 -> Exp Word128
PTX.remWord128# Exp Word128 -> Exp Word128 -> Exp Word128
forall a. Integral a => a -> a -> a
go
      | Bool
otherwise                                = Exp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b)
forall a. Integral a => a -> a -> a
go
    where
      go :: b -> b -> b
go b
x b
y = (b, b) -> b
forall a b. (a, b) -> b
P.snd (b -> b -> (b, b)
forall a. Integral a => a -> a -> (a, a)
quotRem b
x b
y)

  {-# SPECIALISE quotRem :: Exp Word128 -> Exp Word128 -> (Exp Word128, Exp Word128) #-}
  quotRem :: Exp (BigWord a b)
-> Exp (BigWord a b) -> (Exp (BigWord a b), Exp (BigWord a b))
quotRem | Just BigWord a b :~: Word128
Refl <- Elt (BigWord a b) => Maybe (BigWord a b :~: Word128)
forall t. Elt t => Maybe (t :~: Word128)
matchWord128 @(BigWord a b) = Exp (Word128, Word128) -> (Exp Word128, Exp Word128)
forall a b. (Elt a, Elt b) => Exp (a, b) -> (Exp a, Exp b)
untup2 (Exp (Word128, Word128) -> (Exp Word128, Exp Word128))
-> (Exp Word128 -> Exp Word128 -> Exp (Word128, Word128))
-> Exp Word128
-> Exp Word128
-> (Exp Word128, Exp Word128)
forall b a c d. (b -> a) -> (c -> d -> b) -> c -> d -> a
$$ (Exp Word128 -> Exp Word128 -> Exp (Word128, Word128))
-> Exp Word128 -> Exp Word128 -> Exp (Word128, Word128)
CPU.quotRemWord128# ((Exp Word128 -> Exp Word128 -> Exp (Word128, Word128))
 -> Exp Word128 -> Exp Word128 -> Exp (Word128, Word128))
-> (Exp Word128 -> Exp Word128 -> Exp (Word128, Word128))
-> Exp Word128
-> Exp Word128
-> Exp (Word128, Word128)
forall a b. (a -> b) -> a -> b
$ (Exp Word128 -> Exp Word128 -> Exp (Word128, Word128))
-> Exp Word128 -> Exp Word128 -> Exp (Word128, Word128)
PTX.quotRemWord128# Exp (BigWord a b)
-> Exp (BigWord a b) -> Exp (BigWord a b, BigWord a b)
Exp Word128 -> Exp Word128 -> Exp (Word128, Word128)
quotRem'
          | Bool
otherwise                                = Exp (BigWord a b, BigWord a b)
-> (Exp (BigWord a b), Exp (BigWord a b))
forall a b. (Elt a, Elt b) => Exp (a, b) -> (Exp a, Exp b)
untup2 (Exp (BigWord a b, BigWord a b)
 -> (Exp (BigWord a b), Exp (BigWord a b)))
-> (Exp (BigWord a b)
    -> Exp (BigWord a b) -> Exp (BigWord a b, BigWord a b))
-> Exp (BigWord a b)
-> Exp (BigWord a b)
-> (Exp (BigWord a b), Exp (BigWord a b))
forall b a c d. (b -> a) -> (c -> d -> b) -> c -> d -> a
$$ Exp (BigWord a b)
-> Exp (BigWord a b) -> Exp (BigWord a b, BigWord a b)
quotRem'
    where
      quotRem' :: Exp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b, BigWord a b)
      quotRem' :: Exp (BigWord a b)
-> Exp (BigWord a b) -> Exp (BigWord a b, BigWord a b)
quotRem' x :: Exp (BigWord a b)
x@(W2_ Exp a
xh Exp b
xl) y :: Exp (BigWord a b)
y@(W2_ Exp a
yh Exp b
yl)
        = Exp a
xh Exp a -> Exp a -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
<  Exp a
yh Exp Bool
-> (Exp (BigWord a b, BigWord a b), Exp (BigWord a b, BigWord a b))
-> Exp (BigWord a b, BigWord a b)
forall t. Elt t => Exp Bool -> (Exp t, Exp t) -> Exp t
? ( Exp (BigWord a b)
-> Exp (BigWord a b) -> Exp (BigWord a b, BigWord a b)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 Exp (BigWord a b)
0 Exp (BigWord a b)
x
        , Exp a
xh Exp a -> Exp a -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp a
yh Exp Bool
-> (Exp (BigWord a b, BigWord a b), Exp (BigWord a b, BigWord a b))
-> Exp (BigWord a b, BigWord a b)
forall t. Elt t => Exp Bool -> (Exp t, Exp t) -> Exp t
? ( Exp b
xl Exp b -> Exp b -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
<  Exp b
yl Exp Bool
-> (Exp (BigWord a b, BigWord a b), Exp (BigWord a b, BigWord a b))
-> Exp (BigWord a b, BigWord a b)
forall t. Elt t => Exp Bool -> (Exp t, Exp t) -> Exp t
? ( Exp (BigWord a b)
-> Exp (BigWord a b) -> Exp (BigWord a b, BigWord a b)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 Exp (BigWord a b)
0 Exp (BigWord a b)
x
                     , Exp b
xl Exp b -> Exp b -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp b
yl Exp Bool
-> (Exp (BigWord a b, BigWord a b), Exp (BigWord a b, BigWord a b))
-> Exp (BigWord a b, BigWord a b)
forall t. Elt t => Exp Bool -> (Exp t, Exp t) -> Exp t
? ( Exp (BigWord a b)
-> Exp (BigWord a b) -> Exp (BigWord a b, BigWord a b)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 Exp (BigWord a b)
1 Exp (BigWord a b)
0
                     , {-xl > yl -} Exp a
yh Exp a -> Exp a -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp a
0 Exp Bool
-> (Exp (BigWord a b, BigWord a b), Exp (BigWord a b, BigWord a b))
-> Exp (BigWord a b, BigWord a b)
forall t. Elt t => Exp Bool -> (Exp t, Exp t) -> Exp t
? ( let (Exp b
t2,Exp b
t1) = Exp b -> Exp b -> (Exp b, Exp b)
forall a. Integral a => a -> a -> (a, a)
quotRem Exp b
xl Exp b
yl
                                                in  (Exp (BigWord a b), Exp (BigWord a b))
-> Exp (Plain (Exp (BigWord a b), Exp (BigWord a b)))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ Exp a
0 Exp b
t2, Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ Exp a
0 Exp b
t1)
                                              , Exp (BigWord a b)
-> Exp (BigWord a b) -> Exp (BigWord a b, BigWord a b)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 Exp (BigWord a b)
1 (Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ Exp a
0 (Exp b
xlExp b -> Exp b -> Exp b
forall a. Num a => a -> a -> a
-Exp b
yl))
                                              )
                     ))
        ,{- xh > yh -} Exp b
yl Exp b -> Exp b -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp b
0 Exp Bool
-> (Exp (BigWord a b, BigWord a b), Exp (BigWord a b, BigWord a b))
-> Exp (BigWord a b, BigWord a b)
forall t. Elt t => Exp Bool -> (Exp t, Exp t) -> Exp t
? ( let (Exp a
t2,Exp a
t1) = Exp a -> Exp a -> (Exp a, Exp a)
forall a. Integral a => a -> a -> (a, a)
quotRem Exp a
xh Exp a
yh
                                   in  (Exp (BigWord a b), BigWord (Exp a) (Exp b))
-> Exp (Plain (Exp (BigWord a b), BigWord (Exp a) (Exp b)))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ Exp a
0 (Exp a -> Exp b
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp a
t2), Exp a -> Exp b -> BigWord (Exp a) (Exp b)
forall hi lo. hi -> lo -> BigWord hi lo
W2 Exp a
t1 Exp b
xl)
                     , Exp a
yh Exp a -> Exp a -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp a
0 Exp Bool -> Exp Bool -> Exp Bool
&& Exp b
yl Exp b -> Exp b -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp b
forall a. Bounded a => a
maxBound
                               Exp Bool
-> (Exp (BigWord a b, BigWord a b), Exp (BigWord a b, BigWord a b))
-> Exp (BigWord a b, BigWord a b)
forall t. Elt t => Exp Bool -> (Exp t, Exp t) -> Exp t
? ( let z :: Exp b
z       = Exp a -> Exp b
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp a
xh
                                       (Exp b
t2,Exp b
t1) = Exp b -> Exp b -> (Exp b, Unsigned (Exp b))
forall w. Num2 w => w -> w -> (w, Unsigned w)
addWithCarry Exp b
z Exp b
xl
                                   in
                                   Exp b
t2 Exp b -> Exp b -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp b
0 Exp Bool
-> (Exp (BigWord a b, BigWord a b), Exp (BigWord a b, BigWord a b))
-> Exp (BigWord a b, BigWord a b)
forall t. Elt t => Exp Bool -> (Exp t, Exp t) -> Exp t
?
                                     ( Exp b
t1 Exp b -> Exp b -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp b
forall a. Bounded a => a
maxBound Exp Bool
-> (Exp (BigWord a b, BigWord a b), Exp (BigWord a b, BigWord a b))
-> Exp (BigWord a b, BigWord a b)
forall t. Elt t => Exp Bool -> (Exp t, Exp t) -> Exp t
?
                                       ( Exp (BigWord a b)
-> Exp (BigWord a b) -> Exp (BigWord a b, BigWord a b)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 ((Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ Exp a
0 Exp b
z) Exp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b)
forall a. Num a => a -> a -> a
+ Exp (BigWord a b)
1) Exp (BigWord a b)
0
                                       , Exp (BigWord a b)
-> Exp (BigWord a b) -> Exp (BigWord a b, BigWord a b)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 (Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ Exp a
0 Exp b
z) (Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ Exp a
0 Exp b
t1)
                                       )
                                     , Exp b
t1 Exp b -> Exp b -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp b
forall a. Bounded a => a
maxBound Exp Bool
-> (Exp (BigWord a b, BigWord a b), Exp (BigWord a b, BigWord a b))
-> Exp (BigWord a b, BigWord a b)
forall t. Elt t => Exp Bool -> (Exp t, Exp t) -> Exp t
?
                                       ( Exp (BigWord a b)
-> Exp (BigWord a b) -> Exp (BigWord a b, BigWord a b)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 ((Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ Exp a
0 Exp b
z) Exp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b)
forall a. Num a => a -> a -> a
+ Exp (BigWord a b)
2) Exp (BigWord a b)
1
                                       , Exp b
t1 Exp b -> Exp b -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp b -> Exp b -> Exp b
forall a. Bits a => Exp a -> Exp a -> Exp a
xor Exp b
forall a. Bounded a => a
maxBound Exp b
1 Exp Bool
-> (Exp (BigWord a b, BigWord a b), Exp (BigWord a b, BigWord a b))
-> Exp (BigWord a b, BigWord a b)
forall t. Elt t => Exp Bool -> (Exp t, Exp t) -> Exp t
?
                                           ( Exp (BigWord a b)
-> Exp (BigWord a b) -> Exp (BigWord a b, BigWord a b)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 ((Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ Exp a
0 Exp b
z) Exp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b)
forall a. Num a => a -> a -> a
+ Exp (BigWord a b)
2) Exp (BigWord a b)
0
                                           , Exp (BigWord a b)
-> Exp (BigWord a b) -> Exp (BigWord a b, BigWord a b)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 ((Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ Exp a
0 Exp b
z) Exp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b)
forall a. Num a => a -> a -> a
+ Exp (BigWord a b)
1) (Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ Exp a
0 (Exp b
t1Exp b -> Exp b -> Exp b
forall a. Num a => a -> a -> a
+Exp b
1))
                                           )
                                       )
                                     )
                     , Exp a
yh Exp a -> Exp a -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp a
0 Exp Bool
-> (Exp (BigWord a b, BigWord a b), Exp (BigWord a b, BigWord a b))
-> Exp (BigWord a b, BigWord a b)
forall t. Elt t => Exp Bool -> (Exp t, Exp t) -> Exp t
? ( let (Exp (BigWord a b)
t2,Exp b
t1) = Exp (BigWord a b, b) -> (Exp (BigWord a b), Exp b)
forall a b. (Elt a, Elt b) => Exp (a, b) -> (Exp a, Exp b)
untup2 (Exp a -> Exp b -> Exp b -> Exp (BigWord a b, b)
div1 Exp a
xh Exp b
xl Exp b
yl)
                                   in  Exp (BigWord a b)
-> Exp (BigWord a b) -> Exp (BigWord a b, BigWord a b)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 Exp (BigWord a b)
t2 (Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ Exp a
0 Exp b
t1)
                     , {- otherwise -}
                       let t1 :: Exp Int
t1               = Exp a -> Exp Int
forall b. FiniteBits b => Exp b -> Exp Int
countLeadingZeros Exp a
xh
                           t2 :: Exp Int
t2               = Exp a -> Exp Int
forall b. FiniteBits b => Exp b -> Exp Int
countLeadingZeros Exp a
yh
                           z :: Exp a
z                = Exp a -> Exp Int -> Exp a
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftR Exp a
xh (Exp a -> Exp Int
forall b. FiniteBits b => Exp b -> Exp Int
finiteBitSize (Exp a
forall a. HasCallStack => a
undefined::Exp a) Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
- Exp Int
t2)
                           u :: Exp (BigWord a b)
u                = Exp (BigWord a b) -> Exp Int -> Exp (BigWord a b)
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftL Exp (BigWord a b)
x Exp Int
t2
                           v :: Exp (BigWord a b)
v                = Exp (BigWord a b) -> Exp Int -> Exp (BigWord a b)
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftL Exp (BigWord a b)
y Exp Int
t2
                           W2_ Exp a
hhh Exp b
hll      = Exp (BigWord a b)
u
                           W2_ Exp a
lhh Exp b
lll      = Exp (BigWord a b)
v
                           -- z hhh hll / lhh lll
                           (Exp a
q1, Exp a
r1)         = Exp a -> Exp a -> Exp a -> (Exp a, Exp a)
div2 Exp a
z Exp a
hhh Exp a
lhh
                           (Exp b
t4, Exp b
t3)         = Exp b -> Exp b -> (Exp b, Unsigned (Exp b))
forall w. Num2 w => w -> w -> (w, Unsigned w)
mulWithCarry (Exp a -> Exp b
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp a
q1) Exp b
lll
                           t5 :: Exp (BigWord a b)
t5               = Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ (Exp b -> Exp a
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp b
t4) Exp b
t3
                           t6 :: Exp (BigWord a b)
t6               = Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ Exp a
r1 Exp b
hll
                           (Exp (BigWord a b)
t8, Exp (BigWord a b)
t7)         = Exp (BigWord a b)
-> Exp (BigWord a b)
-> (Exp (BigWord a b), Unsigned (Exp (BigWord a b)))
forall w. Num2 w => w -> w -> (w, Unsigned w)
addWithCarry Exp (BigWord a b)
t6 Exp (BigWord a b)
v
                           (Exp (BigWord a b)
t10, Exp (BigWord a b)
t9)        = Exp (BigWord a b)
-> Exp (BigWord a b)
-> (Exp (BigWord a b), Unsigned (Exp (BigWord a b)))
forall w. Num2 w => w -> w -> (w, Unsigned w)
addWithCarry Exp (BigWord a b)
t7 Exp (BigWord a b)
v
                           loWord :: Exp (BigWord a b) -> Exp b
loWord (W2_ Exp a
_ Exp b
l) = Exp b
l :: Exp b
                           qr2 :: Exp (a, BigWord a b)
qr2              = Exp (BigWord a b)
t5 Exp (BigWord a b) -> Exp (BigWord a b) -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
> Exp (BigWord a b)
t6 Exp Bool
-> (Exp (a, BigWord a b), Exp (a, BigWord a b))
-> Exp (a, BigWord a b)
forall t. Elt t => Exp Bool -> (Exp t, Exp t) -> Exp t
?
                                                ( Exp (BigWord a b) -> Exp b
loWord Exp (BigWord a b)
t8 Exp b -> Exp b -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp b
0 Exp Bool
-> (Exp (a, BigWord a b), Exp (a, BigWord a b))
-> Exp (a, BigWord a b)
forall t. Elt t => Exp Bool -> (Exp t, Exp t) -> Exp t
?
                                                  ( Exp (BigWord a b)
t7 Exp (BigWord a b) -> Exp (BigWord a b) -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
>= Exp (BigWord a b)
t5 Exp Bool
-> (Exp (a, BigWord a b), Exp (a, BigWord a b))
-> Exp (a, BigWord a b)
forall t. Elt t => Exp Bool -> (Exp t, Exp t) -> Exp t
?
                                                    ( Exp a -> Exp (BigWord a b) -> Exp (a, BigWord a b)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 (Exp a
q1Exp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
-Exp a
1) (Exp (BigWord a b)
t7Exp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b)
forall a. Num a => a -> a -> a
-Exp (BigWord a b)
t5)
                                                    , Exp (BigWord a b) -> Exp b
loWord Exp (BigWord a b)
t10 Exp b -> Exp b -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp b
0 Exp Bool
-> (Exp (a, BigWord a b), Exp (a, BigWord a b))
-> Exp (a, BigWord a b)
forall t. Elt t => Exp Bool -> (Exp t, Exp t) -> Exp t
?
                                                      ( Exp a -> Exp (BigWord a b) -> Exp (a, BigWord a b)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 (Exp a
q1Exp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
-Exp a
2) (Exp (BigWord a b)
t9Exp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b)
forall a. Num a => a -> a -> a
-Exp (BigWord a b)
t5)
                                                      , Exp a -> Exp (BigWord a b) -> Exp (a, BigWord a b)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 (Exp a
q1Exp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
-Exp a
2) ((Exp (BigWord a b)
forall a. Bounded a => a
maxBoundExp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b)
forall a. Num a => a -> a -> a
-Exp (BigWord a b)
t5) Exp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b)
forall a. Num a => a -> a -> a
+ Exp (BigWord a b)
t9 Exp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b)
forall a. Num a => a -> a -> a
+ Exp (BigWord a b)
1)
                                                      )
                                                    )
                                                  , Exp a -> Exp (BigWord a b) -> Exp (a, BigWord a b)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 (Exp a
q1Exp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
-Exp a
1) ((Exp (BigWord a b)
forall a. Bounded a => a
maxBoundExp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b)
forall a. Num a => a -> a -> a
-Exp (BigWord a b)
t5) Exp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b)
forall a. Num a => a -> a -> a
+ Exp (BigWord a b)
t7 Exp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b)
forall a. Num a => a -> a -> a
+ Exp (BigWord a b)
1)
                                                  )
                                                , Exp a -> Exp (BigWord a b) -> Exp (a, BigWord a b)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 (Exp a
q1) (Exp (BigWord a b)
t6Exp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b)
forall a. Num a => a -> a -> a
-Exp (BigWord a b)
t5)
                                                )
                           (Exp a
q2,Exp (BigWord a b)
r2)          = Exp (a, BigWord a b) -> (Exp a, Exp (BigWord a b))
forall a b. (Elt a, Elt b) => Exp (a, b) -> (Exp a, Exp b)
untup2 Exp (a, BigWord a b)
qr2
                       in
                       Exp Int
t1 Exp Int -> Exp Int -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp Int
t2 Exp Bool
-> (Exp (BigWord a b, BigWord a b), Exp (BigWord a b, BigWord a b))
-> Exp (BigWord a b, BigWord a b)
forall t. Elt t => Exp Bool -> (Exp t, Exp t) -> Exp t
? ( Exp (BigWord a b)
-> Exp (BigWord a b) -> Exp (BigWord a b, BigWord a b)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 Exp (BigWord a b)
1 (Exp (BigWord a b)
xExp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b)
forall a. Num a => a -> a -> a
-Exp (BigWord a b)
y)
                                  , (Exp (BigWord a b), Exp (BigWord a b))
-> Exp (Plain (Exp (BigWord a b), Exp (BigWord a b)))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ Exp a
0 (Exp a -> Exp b
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp a
q2), Exp (BigWord a b) -> Exp Int -> Exp (BigWord a b)
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftR Exp (BigWord a b)
r2 Exp Int
t2)
                                  )
                     )))
        ))

      -- TLM: This is really unfortunate that we can not share expressions
      --      between each part of the loop ): Maybe LLVM will be smart enough
      --      to share them.
      div1 :: Exp a -> Exp b -> Exp b -> Exp (BigWord a b, b)
      div1 :: Exp a -> Exp b -> Exp b -> Exp (BigWord a b, b)
div1 Exp a
hhh Exp b
hll Exp b
by = Exp a -> Exp b -> Exp (BigWord a b) -> Exp (BigWord a b, b)
go Exp a
hhh Exp b
hll Exp (BigWord a b)
0
        where
          go :: Exp a -> Exp b -> Exp (BigWord a b) -> Exp (BigWord a b, b)
          go :: Exp a -> Exp b -> Exp (BigWord a b) -> Exp (BigWord a b, b)
go Exp a
h Exp b
l Exp (BigWord a b)
c = (Exp a -> Exp b -> Exp (BigWord a b) -> Exp (BigWord a b, b))
-> Exp (a, b, BigWord a b) -> Exp (BigWord a b, b)
forall a b c t.
(Elt a, Elt b, Elt c) =>
(Exp a -> Exp b -> Exp c -> t) -> Exp (a, b, c) -> t
uncurry3 Exp a -> Exp b -> Exp (BigWord a b) -> Exp (BigWord a b, b)
Exp a
-> Exp b
-> Exp (BigWord a b)
-> Exp (Plain (Exp (BigWord a b), Exp b))
after (Exp (a, b, BigWord a b) -> Exp (BigWord a b, b))
-> Exp (a, b, BigWord a b) -> Exp (BigWord a b, b)
forall a b. (a -> b) -> a -> b
$ (Exp (a, b, BigWord a b) -> Exp Bool)
-> (Exp (a, b, BigWord a b) -> Exp (a, b, BigWord a b))
-> Exp (a, b, BigWord a b)
-> Exp (a, b, BigWord a b)
forall e.
Elt e =>
(Exp e -> Exp Bool) -> (Exp e -> Exp e) -> Exp e -> Exp e
while (Exp Bool -> Exp Bool
not (Exp Bool -> Exp Bool)
-> (Exp (a, b, BigWord a b) -> Exp Bool)
-> Exp (a, b, BigWord a b)
-> Exp Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Exp a -> Exp b -> Exp (BigWord a b) -> Exp Bool)
-> Exp (a, b, BigWord a b) -> Exp Bool
forall a b c t.
(Elt a, Elt b, Elt c) =>
(Exp a -> Exp b -> Exp c -> t) -> Exp (a, b, c) -> t
uncurry3 Exp a -> Exp b -> Exp (BigWord a b) -> Exp Bool
done) ((Exp a -> Exp b -> Exp (BigWord a b) -> Exp (a, b, BigWord a b))
-> Exp (a, b, BigWord a b) -> Exp (a, b, BigWord a b)
forall a b c t.
(Elt a, Elt b, Elt c) =>
(Exp a -> Exp b -> Exp c -> t) -> Exp (a, b, c) -> t
uncurry3 Exp a -> Exp b -> Exp (BigWord a b) -> Exp (a, b, BigWord a b)
Exp a
-> Exp b
-> Exp (BigWord a b)
-> Exp (Plain (Exp a, Exp b, Exp (BigWord a b)))
body) ((Exp a, Exp b, Exp (BigWord a b))
-> Exp (Plain (Exp a, Exp b, Exp (BigWord a b)))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp a
h,Exp b
l,Exp (BigWord a b)
c))

          (Exp b
t2, Exp b
t1)   = Exp b -> Exp b -> (Exp b, Exp b)
forall a. Integral a => a -> a -> (a, a)
quotRem Exp b
forall a. Bounded a => a
maxBound Exp b
by
          done :: Exp a -> Exp b -> Exp (BigWord a b) -> Exp Bool
done Exp a
h Exp b
l Exp (BigWord a b)
_ = Exp b
z Exp b -> Exp b -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp b
0
            where
              h1 :: Exp b
h1        = Exp a -> Exp b
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp a
h
              (Exp b
t4, Exp b
t3)  = Exp b -> Exp b -> (Exp b, Unsigned (Exp b))
forall w. Num2 w => w -> w -> (w, Unsigned w)
mulWithCarry Exp b
h1 (Exp b
t1 Exp b -> Exp b -> Exp b
forall a. Num a => a -> a -> a
+ Exp b
1)
              (Exp b
t6, Exp b
_t5) = Exp b -> Exp b -> (Exp b, Unsigned (Exp b))
forall w. Num2 w => w -> w -> (w, Unsigned w)
addWithCarry Exp b
t3 Exp b
l
              z :: Exp b
z         = Exp b
t4 Exp b -> Exp b -> Exp b
forall a. Num a => a -> a -> a
+ Exp b
t6

          body :: Exp a
-> Exp b
-> Exp (BigWord a b)
-> Exp (Plain (Exp a, Exp b, Exp (BigWord a b)))
body Exp a
h Exp b
l Exp (BigWord a b)
c = (Exp a, Exp b, Exp (BigWord a b))
-> Exp (Plain (Exp a, Exp b, Exp (BigWord a b)))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp b -> Exp a
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp b
z, Exp b
t5, Exp (BigWord a b)
c Exp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b)
forall a. Num a => a -> a -> a
+ (Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ (Exp b -> Exp a
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp b
t8) Exp b
t7))
            where
              h1 :: Exp b
h1        = Exp a -> Exp b
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp a
h
              (Exp b
t4, Exp b
t3)  = Exp b -> Exp b -> (Exp b, Unsigned (Exp b))
forall w. Num2 w => w -> w -> (w, Unsigned w)
mulWithCarry Exp b
h1 (Exp b
t1 Exp b -> Exp b -> Exp b
forall a. Num a => a -> a -> a
+ Exp b
1)
              (Exp b
t6, Exp b
t5)  = Exp b -> Exp b -> (Exp b, Unsigned (Exp b))
forall w. Num2 w => w -> w -> (w, Unsigned w)
addWithCarry Exp b
t3 Exp b
l
              z :: Exp b
z         = Exp b
t4 Exp b -> Exp b -> Exp b
forall a. Num a => a -> a -> a
+ Exp b
t6
              (Exp b
t8, Exp b
t7)  = Exp b -> Exp b -> (Exp b, Unsigned (Exp b))
forall w. Num2 w => w -> w -> (w, Unsigned w)
mulWithCarry Exp b
h1 Exp b
t2

          after :: Exp a
-> Exp b
-> Exp (BigWord a b)
-> Exp (Plain (Exp (BigWord a b), Exp b))
after Exp a
h Exp b
l Exp (BigWord a b)
c = (Exp (BigWord a b), Exp b)
-> Exp (Plain (Exp (BigWord a b), Exp b))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp (BigWord a b)
c Exp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b)
forall a. Num a => a -> a -> a
+ Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ (Exp b -> Exp a
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp b
t8) Exp b
t7 Exp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b)
forall a. Num a => a -> a -> a
+ Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ Exp a
0 Exp b
t10, Exp b
t9)
            where
              h1 :: Exp b
h1        = Exp a -> Exp b
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp a
h
              (Exp b
_t4, Exp b
t3) = Exp b -> Exp b -> (Exp b, Unsigned (Exp b))
forall w. Num2 w => w -> w -> (w, Unsigned w)
mulWithCarry Exp b
h1 (Exp b
t1 Exp b -> Exp b -> Exp b
forall a. Num a => a -> a -> a
+ Exp b
1)
              (Exp b
_t6, Exp b
t5) = Exp b -> Exp b -> (Exp b, Unsigned (Exp b))
forall w. Num2 w => w -> w -> (w, Unsigned w)
addWithCarry Exp b
t3 Exp b
l
              (Exp b
t8, Exp b
t7)  = Exp b -> Exp b -> (Exp b, Unsigned (Exp b))
forall w. Num2 w => w -> w -> (w, Unsigned w)
mulWithCarry Exp b
h1 Exp b
t2
              (Exp b
t10, Exp b
t9) = Exp b -> Exp b -> (Exp b, Exp b)
forall a. Integral a => a -> a -> (a, a)
quotRem Exp b
t5 Exp b
by


      div2 :: Exp a -> Exp a -> Exp a -> (Exp a, Exp a)
      div2 :: Exp a -> Exp a -> Exp a -> (Exp a, Exp a)
div2 Exp a
hhh Exp a
hll Exp a
by = Exp a -> Exp a -> Exp (a, a) -> (Exp a, Exp a)
go Exp a
hhh Exp a
hll (Exp a -> Exp a -> Exp (a, a)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 Exp a
0 Exp a
0)
        where
          go :: Exp a -> Exp a -> Exp (a,a) -> (Exp a, Exp a)
          go :: Exp a -> Exp a -> Exp (a, a) -> (Exp a, Exp a)
go Exp a
h Exp a
l Exp (a, a)
c = (Exp a -> Exp a -> Exp (a, a) -> (Exp a, Exp a))
-> Exp (a, a, (a, a)) -> (Exp a, Exp a)
forall a b c t.
(Elt a, Elt b, Elt c) =>
(Exp a -> Exp b -> Exp c -> t) -> Exp (a, b, c) -> t
uncurry3 Exp a -> Exp a -> Exp (a, a) -> (Exp a, Exp a)
after (Exp (a, a, (a, a)) -> (Exp a, Exp a))
-> Exp (a, a, (a, a)) -> (Exp a, Exp a)
forall a b. (a -> b) -> a -> b
$ (Exp (a, a, (a, a)) -> Exp Bool)
-> (Exp (a, a, (a, a)) -> Exp (a, a, (a, a)))
-> Exp (a, a, (a, a))
-> Exp (a, a, (a, a))
forall e.
Elt e =>
(Exp e -> Exp Bool) -> (Exp e -> Exp e) -> Exp e -> Exp e
while (Exp Bool -> Exp Bool
not (Exp Bool -> Exp Bool)
-> (Exp (a, a, (a, a)) -> Exp Bool)
-> Exp (a, a, (a, a))
-> Exp Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Exp a -> Exp a -> Exp (a, a) -> Exp Bool)
-> Exp (a, a, (a, a)) -> Exp Bool
forall a b c t.
(Elt a, Elt b, Elt c) =>
(Exp a -> Exp b -> Exp c -> t) -> Exp (a, b, c) -> t
uncurry3 Exp a -> Exp a -> Exp (a, a) -> Exp Bool
done) ((Exp a -> Exp a -> Exp (a, a) -> Exp (a, a, (a, a)))
-> Exp (a, a, (a, a)) -> Exp (a, a, (a, a))
forall a b c t.
(Elt a, Elt b, Elt c) =>
(Exp a -> Exp b -> Exp c -> t) -> Exp (a, b, c) -> t
uncurry3 Exp a -> Exp a -> Exp (a, a) -> Exp (a, a, (a, a))
body) ((Exp a, Exp a, Exp (a, a))
-> Exp (Plain (Exp a, Exp a, Exp (a, a)))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp a
h,Exp a
l,Exp (a, a)
c))

          (Exp a
t2, Exp a
t1) = Exp a -> Exp a -> (Exp a, Exp a)
forall a. Integral a => a -> a -> (a, a)
quotRem Exp a
forall a. Bounded a => a
maxBound Exp a
by

          done :: Exp a -> Exp a -> Exp (a,a) -> Exp Bool
          done :: Exp a -> Exp a -> Exp (a, a) -> Exp Bool
done Exp a
h Exp a
l Exp (a, a)
_ = Exp a
z Exp a -> Exp a -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp a
0
            where
              (Exp a
t4, Exp a
t3)  = Exp a -> Exp a -> (Exp a, Unsigned (Exp a))
forall w. Num2 w => w -> w -> (w, Unsigned w)
mulWithCarry Exp a
h (Exp a
t1 Exp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
+ Exp a
1)
              (Exp a
t6, Exp a
_t5) = Exp a -> Exp a -> (Exp a, Unsigned (Exp a))
forall w. Num2 w => w -> w -> (w, Unsigned w)
addWithCarry Exp a
t3 Exp a
l
              z :: Exp a
z         = Exp a
t4 Exp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
+ Exp a
t6

          body :: Exp a -> Exp a -> Exp (a,a) -> Exp (a, a, (a,a))
          body :: Exp a -> Exp a -> Exp (a, a) -> Exp (a, a, (a, a))
body Exp a
h Exp a
l Exp (a, a)
c = (Exp a, Exp a, Exp (a, a))
-> Exp (Plain (Exp a, Exp a, Exp (a, a)))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp a
z, Exp a
t5, ((Exp a, Exp a) -> (Exp a, Exp a) -> Exp (a, a)
addT (Exp (a, a) -> (Exp a, Exp a)
forall a b. (Elt a, Elt b) => Exp (a, b) -> (Exp a, Exp b)
untup2 Exp (a, a)
c) (Exp a
t8,Exp a
t7)))
            where
              (Exp a
t4, Exp a
t3)  = Exp a -> Exp a -> (Exp a, Unsigned (Exp a))
forall w. Num2 w => w -> w -> (w, Unsigned w)
mulWithCarry Exp a
h (Exp a
t1 Exp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
+ Exp a
1)
              (Exp a
t6, Exp a
t5)  = Exp a -> Exp a -> (Exp a, Unsigned (Exp a))
forall w. Num2 w => w -> w -> (w, Unsigned w)
addWithCarry Exp a
t3 Exp a
l
              z :: Exp a
z         = Exp a
t4 Exp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
+ Exp a
t6
              (Exp a
t8, Exp a
t7)  = Exp a -> Exp a -> (Exp a, Unsigned (Exp a))
forall w. Num2 w => w -> w -> (w, Unsigned w)
mulWithCarry Exp a
h Exp a
t2

          after :: Exp a -> Exp a -> Exp (a,a) -> (Exp a, Exp a)
          after :: Exp a -> Exp a -> Exp (a, a) -> (Exp a, Exp a)
after Exp a
h Exp a
l Exp (a, a)
c = (Exp (a, a) -> Exp a
forall a b. (Elt a, Elt b) => Exp (a, b) -> Exp b
snd Exp (a, a)
q, Exp a
t9)
            where
              (Exp a
_t4, Exp a
t3) = Exp a -> Exp a -> (Exp a, Unsigned (Exp a))
forall w. Num2 w => w -> w -> (w, Unsigned w)
mulWithCarry Exp a
h (Exp a
t1 Exp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
+ Exp a
1)
              (Exp a
_t6, Exp a
t5) = Exp a -> Exp a -> (Exp a, Unsigned (Exp a))
forall w. Num2 w => w -> w -> (w, Unsigned w)
addWithCarry Exp a
t3 Exp a
l
              (Exp a
t8, Exp a
t7)  = Exp a -> Exp a -> (Exp a, Unsigned (Exp a))
forall w. Num2 w => w -> w -> (w, Unsigned w)
mulWithCarry Exp a
h Exp a
t2
              (Exp a
t10, Exp a
t9) = Exp a -> Exp a -> (Exp a, Exp a)
forall a. Integral a => a -> a -> (a, a)
quotRem Exp a
t5 Exp a
by
              q :: Exp (a, a)
q         = (Exp a, Exp a) -> (Exp a, Exp a) -> Exp (a, a)
addT (Exp (a, a) -> (Exp a, Exp a)
forall a b. (Elt a, Elt b) => Exp (a, b) -> (Exp a, Exp b)
untup2 ((Exp a, Exp a) -> (Exp a, Exp a) -> Exp (a, a)
addT (Exp (a, a) -> (Exp a, Exp a)
forall a b. (Elt a, Elt b) => Exp (a, b) -> (Exp a, Exp b)
untup2 Exp (a, a)
c) (Exp a
t8, Exp a
t7))) (Exp a
0, Exp a
t10)

          addT :: (Exp a, Exp a) -> (Exp a, Exp a) -> Exp (a,a)
          addT :: (Exp a, Exp a) -> (Exp a, Exp a) -> Exp (a, a)
addT (Exp a
lhh, Exp a
lhl) (Exp a
llh, Exp a
lll) =
            let (Exp a
t4', Exp a
t3') = Exp a -> Exp a -> (Exp a, Unsigned (Exp a))
forall w. Num2 w => w -> w -> (w, Unsigned w)
addWithCarry Exp a
lhl Exp a
lll
            in  (Exp a, Exp a) -> Exp (Plain (Exp a, Exp a))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Exp a
lhh Exp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
+ Exp a
llh Exp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
+ Exp a
t4', Exp a
t3')

      uncurry3 :: (Exp a -> Exp b -> Exp c -> t) -> Exp (a, b, c) -> t
uncurry3 Exp a -> Exp b -> Exp c -> t
f (Exp (a, b, c) -> (Exp a, Exp b, Exp c)
forall a b c.
(Elt a, Elt b, Elt c) =>
Exp (a, b, c) -> (Exp a, Exp b, Exp c)
untup3 -> (Exp a
a,Exp b
b,Exp c
c)) = Exp a -> Exp b -> Exp c -> t
f Exp a
a Exp b
b Exp c
c


instance ( Integral a, FiniteBits a, FromIntegral a b, Num2 (Exp a)
         , Integral b, FiniteBits b, FromIntegral b a, Num2 (Exp b)
         , Elt (Signed a)
         , Elt (BigInt (Signed a) b)
         , Exp (Signed a) ~ Signed (Exp a)
         , BigWordCtx a b
         )
    => Num2 (Exp (BigWord a b)) where
  type Signed   (Exp (BigWord a b)) = Exp (BigInt (Signed a) b)
  type Unsigned (Exp (BigWord a b)) = Exp (BigWord a b)
  --
  signed :: Exp (BigWord a b) -> Signed (Exp (BigWord a b))
signed (W2_ Exp a
hi Exp b
lo) = Exp (Signed a) -> Exp b -> Exp (BigInt (Signed a) b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigInt a b)
I2_ (Exp a -> Signed (Exp a)
forall w. Num2 w => w -> Signed w
signed Exp a
hi) Exp b
lo
  unsigned :: Exp (BigWord a b) -> Unsigned (Exp (BigWord a b))
unsigned = Exp (BigWord a b) -> Unsigned (Exp (BigWord a b))
forall a. a -> a
id
  --
  addWithCarry :: Exp (BigWord a b)
-> Exp (BigWord a b)
-> (Exp (BigWord a b), Unsigned (Exp (BigWord a b)))
addWithCarry (W2_ Exp a
xh Exp b
xl) (W2_ Exp a
yh Exp b
yl) = (Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ Exp a
0 Exp b
w, Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ Exp a
v Exp b
u)
    where
      (Exp b
t1, Exp b
u)   = Exp b -> Exp b -> (Exp b, Unsigned (Exp b))
forall w. Num2 w => w -> w -> (w, Unsigned w)
addWithCarry Exp b
xl Exp b
yl
      (Exp a
t3, Exp a
t2)  = Exp a -> Exp a -> (Exp a, Unsigned (Exp a))
forall w. Num2 w => w -> w -> (w, Unsigned w)
addWithCarry Exp a
xh (Exp b -> Exp a
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp b
t1)
      (Exp a
t4, Exp a
v)   = Exp a -> Exp a -> (Exp a, Unsigned (Exp a))
forall w. Num2 w => w -> w -> (w, Unsigned w)
addWithCarry Exp a
t2 Exp a
yh
      w :: Exp b
w         = Exp a -> Exp b
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral (Exp a
t3 Exp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
+ Exp a
t4)

  mulWithCarry :: Exp (BigWord a b)
-> Exp (BigWord a b)
-> (Exp (BigWord a b), Unsigned (Exp (BigWord a b)))
mulWithCarry (W2_ Exp a
xh Exp b
xl) (W2_ Exp a
yh Exp b
yl) =
      ( Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ (Exp a
hhh Exp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
+ Exp b -> Exp a
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral (Exp b -> Exp Int -> Exp b
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftR Exp b
t9 Exp Int
y) Exp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
+ Exp a -> Exp Int -> Exp a
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftL Exp a
x Exp Int
z) (Exp b -> Exp Int -> Exp b
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftL Exp b
t9 Exp Int
z Exp b -> Exp b -> Exp b
forall a. Bits a => Exp a -> Exp a -> Exp a
.|. Exp b -> Exp Int -> Exp b
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftR Exp b
t3 Exp Int
y)
      , Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ (Exp b -> Exp a
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp b
t3) Exp b
lll)
    where
      (Exp b
llh, Exp b
lll) = Exp b -> Exp b -> (Exp b, Unsigned (Exp b))
forall w. Num2 w => w -> w -> (w, Unsigned w)
mulWithCarry Exp b
xl Exp b
yl
      (Exp b
hlh, Exp b
hll) = Exp b -> Exp b -> (Exp b, Unsigned (Exp b))
forall w. Num2 w => w -> w -> (w, Unsigned w)
mulWithCarry (Exp a -> Exp b
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp a
xh) Exp b
yl
      (Exp b
lhh, Exp b
lhl) = Exp b -> Exp b -> (Exp b, Unsigned (Exp b))
forall w. Num2 w => w -> w -> (w, Unsigned w)
mulWithCarry Exp b
xl (Exp a -> Exp b
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp a
yh)
      (Exp a
hhh, Exp a
hhl) = Exp a -> Exp a -> (Exp a, Unsigned (Exp a))
forall w. Num2 w => w -> w -> (w, Unsigned w)
mulWithCarry Exp a
xh Exp a
yh
      (Exp b
t2, Exp b
t1)   = Exp b -> Exp b -> (Exp b, Unsigned (Exp b))
forall w. Num2 w => w -> w -> (w, Unsigned w)
addWithCarry Exp b
llh Exp b
hll
      (Exp b
t4, Exp b
t3)   = Exp b -> Exp b -> (Exp b, Unsigned (Exp b))
forall w. Num2 w => w -> w -> (w, Unsigned w)
addWithCarry Exp b
t1 Exp b
lhl
      (Exp b
t6, Exp b
t5)   = Exp b -> Exp b -> (Exp b, Unsigned (Exp b))
forall w. Num2 w => w -> w -> (w, Unsigned w)
addWithCarry (Exp a -> Exp b
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp a
hhl) (Exp b
t2 Exp b -> Exp b -> Exp b
forall a. Num a => a -> a -> a
+ Exp b
t4)
      (Exp b
t8, Exp b
t7)   = Exp b -> Exp b -> (Exp b, Unsigned (Exp b))
forall w. Num2 w => w -> w -> (w, Unsigned w)
addWithCarry Exp b
t5 Exp b
lhh
      (Exp b
t10, Exp b
t9)  = Exp b -> Exp b -> (Exp b, Unsigned (Exp b))
forall w. Num2 w => w -> w -> (w, Unsigned w)
addWithCarry Exp b
t7 Exp b
hlh
      x :: Exp a
x          = Exp b -> Exp a
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral (Exp b
t6 Exp b -> Exp b -> Exp b
forall a. Num a => a -> a -> a
+ Exp b
t8 Exp b -> Exp b -> Exp b
forall a. Num a => a -> a -> a
+ Exp b
t10)
      y :: Exp Int
y          = Exp a -> Exp Int
forall b. FiniteBits b => Exp b -> Exp Int
finiteBitSize (Exp a
forall a. HasCallStack => a
undefined::Exp a)
      z :: Exp Int
z          = Exp b -> Exp Int
forall b. FiniteBits b => Exp b -> Exp Int
finiteBitSize (Exp b
forall a. HasCallStack => a
undefined::Exp b) Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
- Exp Int
y


instance ( Integral a, FiniteBits a, FromIntegral a b
         , Integral b, FiniteBits b, FromIntegral b a
         , BigWordCtx a b
         )
    => Bits (BigWord a b) where

  isSigned :: Exp (BigWord a b) -> Exp Bool
isSigned Exp (BigWord a b)
_ = Bool -> Exp Bool
forall e. (HasCallStack, Elt e) => e -> Exp e
constant Bool
False

  W2_ Exp a
xh Exp b
xl .&. :: Exp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b)
.&.   W2_ Exp a
yh Exp b
yl = Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ (Exp a
xh Exp a -> Exp a -> Exp a
forall a. Bits a => Exp a -> Exp a -> Exp a
.&. Exp a
yh) (Exp b
xl Exp b -> Exp b -> Exp b
forall a. Bits a => Exp a -> Exp a -> Exp a
.&. Exp b
yl)
  W2_ Exp a
xh Exp b
xl .|. :: Exp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b)
.|.   W2_ Exp a
yh Exp b
yl = Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ (Exp a
xh Exp a -> Exp a -> Exp a
forall a. Bits a => Exp a -> Exp a -> Exp a
.|. Exp a
yh) (Exp b
xl Exp b -> Exp b -> Exp b
forall a. Bits a => Exp a -> Exp a -> Exp a
.|. Exp b
yl)
  W2_ Exp a
xh Exp b
xl xor :: Exp (BigWord a b) -> Exp (BigWord a b) -> Exp (BigWord a b)
`xor` W2_ Exp a
yh Exp b
yl = Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ (Exp a
xh Exp a -> Exp a -> Exp a
forall a. Bits a => Exp a -> Exp a -> Exp a
`xor` Exp a
yh) (Exp b
xl Exp b -> Exp b -> Exp b
forall a. Bits a => Exp a -> Exp a -> Exp a
`xor` Exp b
yl)
  complement :: Exp (BigWord a b) -> Exp (BigWord a b)
complement (W2_ Exp a
hi Exp b
lo)    = Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ (Exp a -> Exp a
forall a. Bits a => Exp a -> Exp a
complement Exp a
hi) (Exp b -> Exp b
forall a. Bits a => Exp a -> Exp a
complement Exp b
lo)

  shiftL :: Exp (BigWord a b) -> Exp Int -> Exp (BigWord a b)
shiftL (W2_ Exp a
hi Exp b
lo) Exp Int
x =
    if Exp Int
y Exp Int -> Exp Int -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
> Exp Int
0
      then Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ (Exp a -> Exp Int -> Exp a
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftL Exp a
hi Exp Int
x Exp a -> Exp a -> Exp a
forall a. Bits a => Exp a -> Exp a -> Exp a
.|. Exp b -> Exp a
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral (Exp b -> Exp Int -> Exp b
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftR Exp b
lo Exp Int
y)) (Exp b -> Exp Int -> Exp b
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftL Exp b
lo Exp Int
x)
      else Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ (Exp b -> Exp a
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral (Exp b -> Exp Int -> Exp b
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftL Exp b
lo (Exp Int -> Exp Int
forall a. Num a => a -> a
negate Exp Int
y))) (Exp b
0::Exp b)
    where
      y :: Exp Int
y = Exp b -> Exp Int
forall b. FiniteBits b => Exp b -> Exp Int
finiteBitSize (Exp b
forall a. HasCallStack => a
undefined::Exp b) Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
- Exp Int
x

  shiftR :: Exp (BigWord a b) -> Exp Int -> Exp (BigWord a b)
shiftR (W2_ Exp a
hi Exp b
lo) Exp Int
x = Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ Exp a
hi' Exp b
lo'
    where
      hi' :: Exp a
hi' = Exp a -> Exp Int -> Exp a
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftR Exp a
hi Exp Int
x
      lo' :: Exp b
lo' = if Exp Int
y Exp Int -> Exp Int -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
>= Exp Int
0 then Exp b -> Exp Int -> Exp b
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftL (Exp a -> Exp b
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp a
hi) Exp Int
y Exp b -> Exp b -> Exp b
forall a. Bits a => Exp a -> Exp a -> Exp a
.|. Exp b -> Exp Int -> Exp b
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftR Exp b
lo Exp Int
x
                      else Exp b
z
      --
      y :: Exp Int
y   = Exp b -> Exp Int
forall b. FiniteBits b => Exp b -> Exp Int
finiteBitSize (Exp b
forall a. HasCallStack => a
undefined::Exp b) Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
- Exp Int
x
      z :: Exp b
z   = Exp b -> Exp Int -> Exp b
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftR (Exp a -> Exp b
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp a
hi) (Exp Int -> Exp Int
forall a. Num a => a -> a
negate Exp Int
y)

  rotateL :: Exp (BigWord a b) -> Exp Int -> Exp (BigWord a b)
rotateL (W2_ Exp a
hi Exp b
lo) Exp Int
x =
    if Exp Int
y Exp Int -> Exp Int -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
>= Exp Int
0
      then Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ (Exp b -> Exp a
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral (Exp b -> Exp Int -> Exp b
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftL Exp b
lo Exp Int
y) Exp a -> Exp a -> Exp a
forall a. Bits a => Exp a -> Exp a -> Exp a
.|. Exp a -> Exp Int -> Exp a
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftR Exp a
hi Exp Int
z)
               (Exp b -> Exp Int -> Exp b
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftL (Exp a -> Exp b
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp a
hi) (Exp b -> Exp Int
forall b. FiniteBits b => Exp b -> Exp Int
finiteBitSize (Exp b
forall a. HasCallStack => a
undefined::Exp b) Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
- Exp Int
z) Exp b -> Exp b -> Exp b
forall a. Bits a => Exp a -> Exp a -> Exp a
.|. Exp b -> Exp Int -> Exp b
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftR Exp b
lo Exp Int
z)
      else Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ (Exp b -> Exp a
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral (Exp b -> Exp Int -> Exp b
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftR Exp b
lo (Exp Int -> Exp Int
forall a. Num a => a -> a
negate Exp Int
y)) Exp a -> Exp a -> Exp a
forall a. Bits a => Exp a -> Exp a -> Exp a
.|. Exp a -> Exp Int -> Exp a
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftL Exp a
hi Exp Int
x)
               (Exp b -> Exp Int -> Exp b
forall a. Bits a => Exp a -> Exp Int -> Exp a
shift (Exp a -> Exp b
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp a
hi) (Exp b -> Exp Int
forall b. FiniteBits b => Exp b -> Exp Int
finiteBitSize (Exp b
forall a. HasCallStack => a
undefined::Exp b) Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
- Exp Int
z) Exp b -> Exp b -> Exp b
forall a. Bits a => Exp a -> Exp a -> Exp a
.|. Exp b -> Exp Int -> Exp b
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftL Exp b
lo Exp Int
x Exp b -> Exp b -> Exp b
forall a. Bits a => Exp a -> Exp a -> Exp a
.|. Exp b -> Exp Int -> Exp b
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftR Exp b
lo Exp Int
z)
    where
      y :: Exp Int
y = Exp Int
x Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
- Exp b -> Exp Int
forall b. FiniteBits b => Exp b -> Exp Int
finiteBitSize (Exp b
forall a. HasCallStack => a
undefined::Exp b)
      z :: Exp Int
z = Exp (BigWord a b) -> Exp Int
forall b. FiniteBits b => Exp b -> Exp Int
finiteBitSize (Exp (BigWord a b)
forall a. HasCallStack => a
undefined::Exp (BigWord a b)) Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
- Exp Int
x

  rotateR :: Exp (BigWord a b) -> Exp Int -> Exp (BigWord a b)
rotateR Exp (BigWord a b)
x Exp Int
y = Exp (BigWord a b) -> Exp Int -> Exp (BigWord a b)
forall a. Bits a => Exp a -> Exp Int -> Exp a
rotateL Exp (BigWord a b)
x (Exp (BigWord a b) -> Exp Int
forall b. FiniteBits b => Exp b -> Exp Int
finiteBitSize (Exp (BigWord a b)
forall a. HasCallStack => a
undefined::Exp (BigWord a b)) Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
- Exp Int
y)

  bit :: Exp Int -> Exp (BigWord a b)
bit Exp Int
n =
    if Exp Int
m Exp Int -> Exp Int -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
>= Exp Int
0
      then Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ (Exp Int -> Exp a
forall a. Bits a => Exp Int -> Exp a
bit Exp Int
m) Exp b
0
      else Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ Exp a
0 (Exp Int -> Exp b
forall a. Bits a => Exp Int -> Exp a
bit Exp Int
n)
    where
      m :: Exp Int
m = Exp Int
n Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
- Exp b -> Exp Int
forall b. FiniteBits b => Exp b -> Exp Int
finiteBitSize (Exp b
forall a. HasCallStack => a
undefined::Exp b)

  testBit :: Exp (BigWord a b) -> Exp Int -> Exp Bool
testBit (W2_ Exp a
hi Exp b
lo) Exp Int
n =
    if Exp Int
m Exp Int -> Exp Int -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
>= Exp Int
0
      then Exp a -> Exp Int -> Exp Bool
forall a. Bits a => Exp a -> Exp Int -> Exp Bool
testBit Exp a
hi Exp Int
m
      else Exp b -> Exp Int -> Exp Bool
forall a. Bits a => Exp a -> Exp Int -> Exp Bool
testBit Exp b
lo Exp Int
n
    where
      m :: Exp Int
m = Exp Int
n Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
- Exp b -> Exp Int
forall b. FiniteBits b => Exp b -> Exp Int
finiteBitSize (Exp b
forall a. HasCallStack => a
undefined::Exp b)

  setBit :: Exp (BigWord a b) -> Exp Int -> Exp (BigWord a b)
setBit (W2_ Exp a
hi Exp b
lo) Exp Int
n =
    if Exp Int
m Exp Int -> Exp Int -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
>= Exp Int
0
      then Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ (Exp a -> Exp Int -> Exp a
forall a. Bits a => Exp a -> Exp Int -> Exp a
setBit Exp a
hi Exp Int
m) Exp b
lo
      else Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ Exp a
hi (Exp b -> Exp Int -> Exp b
forall a. Bits a => Exp a -> Exp Int -> Exp a
setBit Exp b
lo Exp Int
n)
    where
      m :: Exp Int
m = Exp Int
n Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
- Exp b -> Exp Int
forall b. FiniteBits b => Exp b -> Exp Int
finiteBitSize (Exp b
forall a. HasCallStack => a
undefined::Exp b)

  clearBit :: Exp (BigWord a b) -> Exp Int -> Exp (BigWord a b)
clearBit (W2_ Exp a
hi Exp b
lo) Exp Int
n =
    if Exp Int
m Exp Int -> Exp Int -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
>= Exp Int
0
      then Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ (Exp a -> Exp Int -> Exp a
forall a. Bits a => Exp a -> Exp Int -> Exp a
clearBit Exp a
hi Exp Int
m) Exp b
lo
      else Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ Exp a
hi (Exp b -> Exp Int -> Exp b
forall a. Bits a => Exp a -> Exp Int -> Exp a
clearBit Exp b
lo Exp Int
n)
    where
      m :: Exp Int
m = Exp Int
n Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
- Exp b -> Exp Int
forall b. FiniteBits b => Exp b -> Exp Int
finiteBitSize (Exp b
forall a. HasCallStack => a
undefined::Exp b)

  complementBit :: Exp (BigWord a b) -> Exp Int -> Exp (BigWord a b)
complementBit (W2_ Exp a
hi Exp b
lo) Exp Int
n =
    if Exp Int
m Exp Int -> Exp Int -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
>= Exp Int
0
      then Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ (Exp a -> Exp Int -> Exp a
forall a. Bits a => Exp a -> Exp Int -> Exp a
complementBit Exp a
hi Exp Int
m) Exp b
lo
      else Exp a -> Exp b -> Exp (BigWord a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ Exp a
hi (Exp b -> Exp Int -> Exp b
forall a. Bits a => Exp a -> Exp Int -> Exp a
complementBit Exp b
lo Exp Int
n)
    where
      m :: Exp Int
m = Exp Int
n Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
- Exp b -> Exp Int
forall b. FiniteBits b => Exp b -> Exp Int
finiteBitSize (Exp b
forall a. HasCallStack => a
undefined::Exp b)

  popCount :: Exp (BigWord a b) -> Exp Int
popCount (W2_ Exp a
hi Exp b
lo) = Exp a -> Exp Int
forall a. Bits a => Exp a -> Exp Int
popCount Exp a
hi Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
+ Exp b -> Exp Int
forall a. Bits a => Exp a -> Exp Int
popCount Exp b
lo


instance ( Integral a, FiniteBits a, FromIntegral a b
         , Integral b, FiniteBits b, FromIntegral b a
         , BigWordCtx a b
         )
    => FiniteBits (BigWord a b) where
  finiteBitSize :: Exp (BigWord a b) -> Exp Int
finiteBitSize Exp (BigWord a b)
_ = Exp a -> Exp Int
forall b. FiniteBits b => Exp b -> Exp Int
finiteBitSize (Exp a
forall a. HasCallStack => a
undefined::Exp a)
                  Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
+ Exp b -> Exp Int
forall b. FiniteBits b => Exp b -> Exp Int
finiteBitSize (Exp b
forall a. HasCallStack => a
undefined::Exp b)

  countLeadingZeros :: Exp (BigWord a b) -> Exp Int
countLeadingZeros (W2_ Exp a
hi Exp b
lo) =
    Exp Int
hlz Exp Int -> Exp Int -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp Int
wsib Exp Bool -> (Exp Int, Exp Int) -> Exp Int
forall t. Elt t => Exp Bool -> (Exp t, Exp t) -> Exp t
? (Exp Int
wsib Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
+ Exp Int
llz, Exp Int
hlz)
    where
      hlz :: Exp Int
hlz   = Exp a -> Exp Int
forall b. FiniteBits b => Exp b -> Exp Int
countLeadingZeros Exp a
hi
      llz :: Exp Int
llz   = Exp b -> Exp Int
forall b. FiniteBits b => Exp b -> Exp Int
countLeadingZeros Exp b
lo
      wsib :: Exp Int
wsib  = Exp a -> Exp Int
forall b. FiniteBits b => Exp b -> Exp Int
finiteBitSize (Exp a
forall a. HasCallStack => a
undefined::Exp a)

  countTrailingZeros :: Exp (BigWord a b) -> Exp Int
countTrailingZeros (W2_ Exp a
hi Exp b
lo) =
    Exp Int
ltz Exp Int -> Exp Int -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp Int
wsib Exp Bool -> (Exp Int, Exp Int) -> Exp Int
forall t. Elt t => Exp Bool -> (Exp t, Exp t) -> Exp t
? (Exp Int
wsib Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
+ Exp Int
htz, Exp Int
ltz)
    where
      ltz :: Exp Int
ltz   = Exp b -> Exp Int
forall b. FiniteBits b => Exp b -> Exp Int
countTrailingZeros Exp b
lo
      htz :: Exp Int
htz   = Exp a -> Exp Int
forall b. FiniteBits b => Exp b -> Exp Int
countTrailingZeros Exp a
hi
      wsib :: Exp Int
wsib  = Exp b -> Exp Int
forall b. FiniteBits b => Exp b -> Exp Int
finiteBitSize (Exp b
forall a. HasCallStack => a
undefined::Exp b)


-- BigInt
-- ------

type BigIntCtx hi lo =
    ( Elt hi, Elt lo, Elt (BigInt hi lo)
    , hi ~ Signed hi
    , lo ~ Unsigned lo
    , hi ~ Signed (Unsigned hi)
    , Exp hi ~ Signed (Exp hi)
    , Exp lo ~ Unsigned (Exp lo)
    )


instance (Bounded a, Bounded b, Elt (BigInt a b)) => P.Bounded (Exp (BigInt a b)) where
  minBound :: Exp (BigInt a b)
minBound = Exp a -> Exp b -> Exp (BigInt a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigInt a b)
I2_ Exp a
forall a. Bounded a => a
minBound Exp b
forall a. Bounded a => a
minBound
  maxBound :: Exp (BigInt a b)
maxBound = Exp a -> Exp b -> Exp (BigInt a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigInt a b)
I2_ Exp a
forall a. Bounded a => a
maxBound Exp b
forall a. Bounded a => a
maxBound


instance (Eq a, Eq b, Elt (BigInt a b)) => Eq (BigInt a b) where
  I2_ Exp a
xh Exp b
xl == :: Exp (BigInt a b) -> Exp (BigInt a b) -> Exp Bool
== I2_ Exp a
yh Exp b
yl = Exp a
xh Exp a -> Exp a -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp a
yh Exp Bool -> Exp Bool -> Exp Bool
&& Exp b
xl Exp b -> Exp b -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp b
yl
  I2_ Exp a
xh Exp b
xl /= :: Exp (BigInt a b) -> Exp (BigInt a b) -> Exp Bool
/= I2_ Exp a
yh Exp b
yl = Exp a
xh Exp a -> Exp a -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
/= Exp a
yh Exp Bool -> Exp Bool -> Exp Bool
|| Exp b
xl Exp b -> Exp b -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
/= Exp b
yl


instance (Ord a, Ord b, Elt (BigInt a b)) => Ord (BigInt a b) where
  I2_ Exp a
xh Exp b
xl < :: Exp (BigInt a b) -> Exp (BigInt a b) -> Exp Bool
<  I2_ Exp a
yh Exp b
yl = Exp a
xh Exp a -> Exp a -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp a
yh Exp Bool -> (Exp Bool, Exp Bool) -> Exp Bool
forall t. Elt t => Exp Bool -> (Exp t, Exp t) -> Exp t
? ( Exp b
xl Exp b -> Exp b -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
< Exp b
yl,  Exp a
xh Exp a -> Exp a -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
< Exp a
yh )
  I2_ Exp a
xh Exp b
xl > :: Exp (BigInt a b) -> Exp (BigInt a b) -> Exp Bool
>  I2_ Exp a
yh Exp b
yl = Exp a
xh Exp a -> Exp a -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp a
yh Exp Bool -> (Exp Bool, Exp Bool) -> Exp Bool
forall t. Elt t => Exp Bool -> (Exp t, Exp t) -> Exp t
? ( Exp b
xl Exp b -> Exp b -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
> Exp b
yl,  Exp a
xh Exp a -> Exp a -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
> Exp a
yh )
  I2_ Exp a
xh Exp b
xl <= :: Exp (BigInt a b) -> Exp (BigInt a b) -> Exp Bool
<= I2_ Exp a
yh Exp b
yl = Exp a
xh Exp a -> Exp a -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp a
yh Exp Bool -> (Exp Bool, Exp Bool) -> Exp Bool
forall t. Elt t => Exp Bool -> (Exp t, Exp t) -> Exp t
? ( Exp b
xl Exp b -> Exp b -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
<= Exp b
yl, Exp a
xh Exp a -> Exp a -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
<= Exp a
yh )
  I2_ Exp a
xh Exp b
xl >= :: Exp (BigInt a b) -> Exp (BigInt a b) -> Exp Bool
>= I2_ Exp a
yh Exp b
yl = Exp a
xh Exp a -> Exp a -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp a
yh Exp Bool -> (Exp Bool, Exp Bool) -> Exp Bool
forall t. Elt t => Exp Bool -> (Exp t, Exp t) -> Exp t
? ( Exp b
xl Exp b -> Exp b -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
>= Exp b
yl, Exp a
xh Exp a -> Exp a -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
>= Exp a
yh )


instance ( Num a, Ord a
         , Num b, Ord b, Bounded b
         , Num2 (Exp (BigInt a b))
         , Num2 (Exp (BigWord (Unsigned a) b))
         , Num (BigWord (Unsigned a) b)
         , P.Num (BigInt a b)
         , BigIntCtx a b
         )
    => P.Num (Exp (BigInt a b)) where
  negate :: Exp (BigInt a b) -> Exp (BigInt a b)
negate (I2_ Exp a
hi Exp b
lo) =
    if Exp b
lo Exp b -> Exp b -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp b
0
      then Exp a -> Exp b -> Exp (BigInt a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigInt a b)
I2_ (Exp a -> Exp a
forall a. Num a => a -> a
negate Exp a
hi) Exp b
0
      else Exp a -> Exp b -> Exp (BigInt a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigInt a b)
I2_ (Exp a -> Exp a
forall a. Num a => a -> a
negate (Exp a
hiExp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
+Exp a
1)) (Exp b -> Exp b
forall a. Num a => a -> a
negate Exp b
lo)

  signum :: Exp (BigInt a b) -> Exp (BigInt a b)
signum (I2_ Exp a
hi Exp b
lo) =
    if Exp a
hi Exp a -> Exp a -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
<  Exp a
0 then Exp a -> Exp b -> Exp (BigInt a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigInt a b)
I2_ (-Exp a
1) Exp b
forall a. Bounded a => a
maxBound else
    if Exp a
hi Exp a -> Exp a -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp a
0 then if Exp b
lo Exp b -> Exp b -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp b
0 then Exp (BigInt a b)
0 else Exp (BigInt a b)
1
               else Exp a -> Exp b -> Exp (BigInt a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigInt a b)
I2_ Exp a
0 Exp b
1

  abs :: Exp (BigInt a b) -> Exp (BigInt a b)
abs Exp (BigInt a b)
x =
    if Exp (BigInt a b)
x Exp (BigInt a b) -> Exp (BigInt a b) -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
< Exp (BigInt a b)
0 then Exp (BigInt a b) -> Exp (BigInt a b)
forall a. Num a => a -> a
negate Exp (BigInt a b)
x
             else Exp (BigInt a b)
x

  fromInteger :: Integer -> Exp (BigInt a b)
fromInteger = BigInt a b -> Exp (BigInt a b)
forall e. (HasCallStack, Elt e) => e -> Exp e
constant (BigInt a b -> Exp (BigInt a b))
-> (Integer -> BigInt a b) -> Integer -> Exp (BigInt a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> BigInt a b
forall a. Num a => Integer -> a
fromInteger

  {-# SPECIALIZE (+) :: Exp Int128 -> Exp Int128 -> Exp Int128 #-}
  + :: Exp (BigInt a b) -> Exp (BigInt a b) -> Exp (BigInt a b)
(+) | Just BigInt a b :~: Int128
Refl <- Elt (BigInt a b) => Maybe (BigInt a b :~: Int128)
forall t. Elt t => Maybe (t :~: Int128)
matchInt128 @(BigInt a b) = (Exp Int128 -> Exp Int128 -> Exp Int128)
-> Exp Int128 -> Exp Int128 -> Exp Int128
CPU.addInt128# ((Exp Int128 -> Exp Int128 -> Exp Int128)
 -> Exp Int128 -> Exp Int128 -> Exp Int128)
-> (Exp Int128 -> Exp Int128 -> Exp Int128)
-> Exp Int128
-> Exp Int128
-> Exp Int128
forall a b. (a -> b) -> a -> b
$ (Exp Int128 -> Exp Int128 -> Exp Int128)
-> Exp Int128 -> Exp Int128 -> Exp Int128
PTX.addInt128# Exp (BigInt a b) -> Exp (BigInt a b) -> Exp (BigInt a b)
Exp Int128 -> Exp Int128 -> Exp Int128
add
      | Bool
otherwise                              = Exp (BigInt a b) -> Exp (BigInt a b) -> Exp (BigInt a b)
add
    where
      add :: Exp (BigInt a b) -> Exp (BigInt a b) -> Exp (BigInt a b)
      add :: Exp (BigInt a b) -> Exp (BigInt a b) -> Exp (BigInt a b)
add (I2_ Exp a
xh Exp b
xl) (I2_ Exp a
yh Exp b
yl) = Exp a -> Exp b -> Exp (BigInt a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigInt a b)
I2_ Exp a
hi Exp b
lo
        where
          lo :: Exp b
lo = Exp b
xl Exp b -> Exp b -> Exp b
forall a. Num a => a -> a -> a
+ Exp b
yl
          hi :: Exp a
hi = Exp a
xh Exp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
+ Exp a
yh Exp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
+ if Exp b
lo Exp b -> Exp b -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
< Exp b
xl then Exp a
1 else Exp a
0

  {-# SPECIALIZE (-) :: Exp Int128 -> Exp Int128 -> Exp Int128 #-}
  (-) | Just BigInt a b :~: Int128
Refl <- Elt (BigInt a b) => Maybe (BigInt a b :~: Int128)
forall t. Elt t => Maybe (t :~: Int128)
matchInt128 @(BigInt a b) = (Exp Int128 -> Exp Int128 -> Exp Int128)
-> Exp Int128 -> Exp Int128 -> Exp Int128
CPU.subInt128# ((Exp Int128 -> Exp Int128 -> Exp Int128)
 -> Exp Int128 -> Exp Int128 -> Exp Int128)
-> (Exp Int128 -> Exp Int128 -> Exp Int128)
-> Exp Int128
-> Exp Int128
-> Exp Int128
forall a b. (a -> b) -> a -> b
$ (Exp Int128 -> Exp Int128 -> Exp Int128)
-> Exp Int128 -> Exp Int128 -> Exp Int128
PTX.subInt128# (\Exp Int128
x Exp Int128
y -> Exp Int128
x Exp Int128 -> Exp Int128 -> Exp Int128
forall a. Num a => a -> a -> a
+ Exp Int128 -> Exp Int128
forall a. Num a => a -> a
negate Exp Int128
y)
      | Bool
otherwise                              = \Exp (BigInt a b)
x Exp (BigInt a b)
y -> Exp (BigInt a b)
x Exp (BigInt a b) -> Exp (BigInt a b) -> Exp (BigInt a b)
forall a. Num a => a -> a -> a
+ Exp (BigInt a b) -> Exp (BigInt a b)
forall a. Num a => a -> a
negate Exp (BigInt a b)
y

  {-# SPECIALIZE (*) :: Exp Int128 -> Exp Int128 -> Exp Int128 #-}
  * :: Exp (BigInt a b) -> Exp (BigInt a b) -> Exp (BigInt a b)
(*) | Just BigInt a b :~: Int128
Refl <- Elt (BigInt a b) => Maybe (BigInt a b :~: Int128)
forall t. Elt t => Maybe (t :~: Int128)
matchInt128 @(BigInt a b) = (Exp Int128 -> Exp Int128 -> Exp Int128)
-> Exp Int128 -> Exp Int128 -> Exp Int128
CPU.mulInt128# ((Exp Int128 -> Exp Int128 -> Exp Int128)
 -> Exp Int128 -> Exp Int128 -> Exp Int128)
-> (Exp Int128 -> Exp Int128 -> Exp Int128)
-> Exp Int128
-> Exp Int128
-> Exp Int128
forall a b. (a -> b) -> a -> b
$ (Exp Int128 -> Exp Int128 -> Exp Int128)
-> Exp Int128 -> Exp Int128 -> Exp Int128
PTX.mulInt128# Exp (BigInt a b) -> Exp (BigInt a b) -> Exp (BigInt a b)
Exp Int128 -> Exp Int128 -> Exp Int128
mul
      | Bool
otherwise                              = Exp (BigInt a b) -> Exp (BigInt a b) -> Exp (BigInt a b)
mul
    where
      mul :: Exp (BigInt a b) -> Exp (BigInt a b) -> Exp (BigInt a b)
      mul :: Exp (BigInt a b) -> Exp (BigInt a b) -> Exp (BigInt a b)
mul Exp (BigInt a b)
x Exp (BigInt a b)
y = Exp (BigWord (Unsigned a) b)
-> Signed (Exp (BigWord (Unsigned a) b))
forall w. Num2 w => w -> Signed w
signed (Exp (BigInt a b) -> Unsigned (Exp (BigInt a b))
forall w. Num2 w => w -> Unsigned w
unsigned Exp (BigInt a b)
x Exp (BigWord (Unsigned a) b)
-> Exp (BigWord (Unsigned a) b) -> Exp (BigWord (Unsigned a) b)
forall a. Num a => a -> a -> a
* Exp (BigInt a b) -> Unsigned (Exp (BigInt a b))
forall w. Num2 w => w -> Unsigned w
unsigned Exp (BigInt a b)
y)


instance ( Integral a
         , Integral b
         , Num (BigInt a b)
         , Eq (BigWord (Unsigned a) b)
         , Integral (BigWord (Unsigned a) b)
         , Num2 (Exp (BigInt a b))
         , Num2 (Exp (BigWord (Unsigned a) b))
         , BigIntCtx a b
#if MIN_VERSION_accelerate(1,2,0)
         , Enum (BigInt a b)
#endif
         )
    => P.Integral (Exp (BigInt a b)) where
  toInteger :: Exp (BigInt a b) -> Integer
toInteger = [Char] -> Exp (BigInt a b) -> Integer
forall a. HasCallStack => [Char] -> a
error [Char]
"Prelude.toInteger is not supported for Accelerate types"

  {-# SPECIALIZE quot :: Exp Int128 -> Exp Int128 -> Exp Int128 #-}
  quot :: Exp (BigInt a b) -> Exp (BigInt a b) -> Exp (BigInt a b)
quot | Just BigInt a b :~: Int128
Refl <- Elt (BigInt a b) => Maybe (BigInt a b :~: Int128)
forall t. Elt t => Maybe (t :~: Int128)
matchInt128 @(BigInt a b) = (Exp Int128 -> Exp Int128 -> Exp Int128)
-> Exp Int128 -> Exp Int128 -> Exp Int128
CPU.quotInt128# ((Exp Int128 -> Exp Int128 -> Exp Int128)
 -> Exp Int128 -> Exp Int128 -> Exp Int128)
-> (Exp Int128 -> Exp Int128 -> Exp Int128)
-> Exp Int128
-> Exp Int128
-> Exp Int128
forall a b. (a -> b) -> a -> b
$ (Exp Int128 -> Exp Int128 -> Exp Int128)
-> Exp Int128 -> Exp Int128 -> Exp Int128
PTX.quotInt128# Exp Int128 -> Exp Int128 -> Exp Int128
forall a. Integral a => a -> a -> a
go
       | Bool
otherwise                              = Exp (BigInt a b) -> Exp (BigInt a b) -> Exp (BigInt a b)
forall a. Integral a => a -> a -> a
go
    where
      go :: b -> b -> b
go b
x b
y = (b, b) -> b
forall a b. (a, b) -> a
P.fst (b -> b -> (b, b)
forall a. Integral a => a -> a -> (a, a)
quotRem b
x b
y)

  {-# SPECIALIZE rem :: Exp Int128 -> Exp Int128 -> Exp Int128 #-}
  rem :: Exp (BigInt a b) -> Exp (BigInt a b) -> Exp (BigInt a b)
rem | Just BigInt a b :~: Int128
Refl <- Elt (BigInt a b) => Maybe (BigInt a b :~: Int128)
forall t. Elt t => Maybe (t :~: Int128)
matchInt128 @(BigInt a b) = (Exp Int128 -> Exp Int128 -> Exp Int128)
-> Exp Int128 -> Exp Int128 -> Exp Int128
CPU.remInt128# ((Exp Int128 -> Exp Int128 -> Exp Int128)
 -> Exp Int128 -> Exp Int128 -> Exp Int128)
-> (Exp Int128 -> Exp Int128 -> Exp Int128)
-> Exp Int128
-> Exp Int128
-> Exp Int128
forall a b. (a -> b) -> a -> b
$ (Exp Int128 -> Exp Int128 -> Exp Int128)
-> Exp Int128 -> Exp Int128 -> Exp Int128
PTX.remInt128# Exp Int128 -> Exp Int128 -> Exp Int128
forall a. Integral a => a -> a -> a
go
      | Bool
otherwise                              = Exp (BigInt a b) -> Exp (BigInt a b) -> Exp (BigInt a b)
forall a. Integral a => a -> a -> a
go
    where
      go :: b -> b -> b
go b
x b
y = (b, b) -> b
forall a b. (a, b) -> b
P.snd (b -> b -> (b, b)
forall a. Integral a => a -> a -> (a, a)
quotRem b
x b
y)

  {-# SPECIALISE quotRem :: Exp Int128 -> Exp Int128 -> (Exp Int128, Exp Int128) #-}
  quotRem :: Exp (BigInt a b)
-> Exp (BigInt a b) -> (Exp (BigInt a b), Exp (BigInt a b))
quotRem | Just BigInt a b :~: Int128
Refl <- Elt (BigInt a b) => Maybe (BigInt a b :~: Int128)
forall t. Elt t => Maybe (t :~: Int128)
matchInt128 @(BigInt a b) = Exp (Int128, Int128) -> (Exp Int128, Exp Int128)
forall a b. (Elt a, Elt b) => Exp (a, b) -> (Exp a, Exp b)
untup2 (Exp (Int128, Int128) -> (Exp Int128, Exp Int128))
-> (Exp Int128 -> Exp Int128 -> Exp (Int128, Int128))
-> Exp Int128
-> Exp Int128
-> (Exp Int128, Exp Int128)
forall b a c d. (b -> a) -> (c -> d -> b) -> c -> d -> a
$$ (Exp Int128 -> Exp Int128 -> Exp (Int128, Int128))
-> Exp Int128 -> Exp Int128 -> Exp (Int128, Int128)
CPU.quotRemInt128# ((Exp Int128 -> Exp Int128 -> Exp (Int128, Int128))
 -> Exp Int128 -> Exp Int128 -> Exp (Int128, Int128))
-> (Exp Int128 -> Exp Int128 -> Exp (Int128, Int128))
-> Exp Int128
-> Exp Int128
-> Exp (Int128, Int128)
forall a b. (a -> b) -> a -> b
$ (Exp Int128 -> Exp Int128 -> Exp (Int128, Int128))
-> Exp Int128 -> Exp Int128 -> Exp (Int128, Int128)
PTX.quotRemInt128# Exp Int128 -> Exp Int128 -> Exp (Int128, Int128)
forall (t :: * -> *) x1 a a.
(EltT t (x1, x1), IfThenElse t, Ord a, Ord a,
 Integral (Unsigned (Exp a)), Num (Exp a), Num (Exp a),
 IsPattern t (x1, x1) (t x1, t x1), Num2 (Unsigned (Exp a)),
 Num2 (Exp a), Num2 (Exp a), Unsigned (Exp a) ~ Unsigned (Exp a),
 Signed (Unsigned (Exp a)) ~ t x1) =>
Exp a -> Exp a -> t (x1, x1)
quotRem'
          | Bool
otherwise                              = Exp (BigInt a b, BigInt a b)
-> (Exp (BigInt a b), Exp (BigInt a b))
forall a b. (Elt a, Elt b) => Exp (a, b) -> (Exp a, Exp b)
untup2 (Exp (BigInt a b, BigInt a b)
 -> (Exp (BigInt a b), Exp (BigInt a b)))
-> (Exp (BigInt a b)
    -> Exp (BigInt a b) -> Exp (BigInt a b, BigInt a b))
-> Exp (BigInt a b)
-> Exp (BigInt a b)
-> (Exp (BigInt a b), Exp (BigInt a b))
forall b a c d. (b -> a) -> (c -> d -> b) -> c -> d -> a
$$ Exp (BigInt a b)
-> Exp (BigInt a b) -> Exp (BigInt a b, BigInt a b)
forall (t :: * -> *) x1 a a.
(EltT t (x1, x1), IfThenElse t, Ord a, Ord a,
 Integral (Unsigned (Exp a)), Num (Exp a), Num (Exp a),
 IsPattern t (x1, x1) (t x1, t x1), Num2 (Unsigned (Exp a)),
 Num2 (Exp a), Num2 (Exp a), Unsigned (Exp a) ~ Unsigned (Exp a),
 Signed (Unsigned (Exp a)) ~ t x1) =>
Exp a -> Exp a -> t (x1, x1)
quotRem'
    where
      quotRem' :: Exp a -> Exp a -> t (x1, x1)
quotRem' Exp a
x Exp a
y =
        if Exp a
x Exp a -> Exp a -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
< Exp a
0
          then if Exp a
y Exp a -> Exp a -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
< Exp a
0
                 then
                   let (Unsigned (Exp a)
q,Unsigned (Exp a)
r) = Unsigned (Exp a)
-> Unsigned (Exp a) -> (Unsigned (Exp a), Unsigned (Exp a))
forall a. Integral a => a -> a -> (a, a)
quotRem (Unsigned (Exp a) -> Unsigned (Exp a)
forall a. Num a => a -> a
negate (Exp a -> Unsigned (Exp a)
forall w. Num2 w => w -> Unsigned w
unsigned Exp a
x)) (Unsigned (Exp a) -> Unsigned (Exp a)
forall a. Num a => a -> a
negate (Exp a -> Unsigned (Exp a)
forall w. Num2 w => w -> Unsigned w
unsigned Exp a
y))
                   in  t x1 -> t x1 -> t (x1, x1)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 (Unsigned (Exp a) -> Signed (Unsigned (Exp a))
forall w. Num2 w => w -> Signed w
signed Unsigned (Exp a)
q) (Unsigned (Exp a) -> Signed (Unsigned (Exp a))
forall w. Num2 w => w -> Signed w
signed (Unsigned (Exp a) -> Unsigned (Exp a)
forall a. Num a => a -> a
negate Unsigned (Exp a)
r))
                 else
                   let (Unsigned (Exp a)
q,Unsigned (Exp a)
r) = Unsigned (Exp a)
-> Unsigned (Exp a) -> (Unsigned (Exp a), Unsigned (Exp a))
forall a. Integral a => a -> a -> (a, a)
quotRem (Unsigned (Exp a) -> Unsigned (Exp a)
forall a. Num a => a -> a
negate (Exp a -> Unsigned (Exp a)
forall w. Num2 w => w -> Unsigned w
unsigned Exp a
x)) (Exp a -> Unsigned (Exp a)
forall w. Num2 w => w -> Unsigned w
unsigned Exp a
y)
                   in  t x1 -> t x1 -> t (x1, x1)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 (Unsigned (Exp a) -> Signed (Unsigned (Exp a))
forall w. Num2 w => w -> Signed w
signed (Unsigned (Exp a) -> Unsigned (Exp a)
forall a. Num a => a -> a
negate Unsigned (Exp a)
q)) (Unsigned (Exp a) -> Signed (Unsigned (Exp a))
forall w. Num2 w => w -> Signed w
signed (Unsigned (Exp a) -> Unsigned (Exp a)
forall a. Num a => a -> a
negate Unsigned (Exp a)
r))
          else if Exp a
y Exp a -> Exp a -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
< Exp a
0
                 then
                   let (Unsigned (Exp a)
q,Unsigned (Exp a)
r) = Unsigned (Exp a)
-> Unsigned (Exp a) -> (Unsigned (Exp a), Unsigned (Exp a))
forall a. Integral a => a -> a -> (a, a)
quotRem (Exp a -> Unsigned (Exp a)
forall w. Num2 w => w -> Unsigned w
unsigned Exp a
x) (Unsigned (Exp a) -> Unsigned (Exp a)
forall a. Num a => a -> a
negate (Exp a -> Unsigned (Exp a)
forall w. Num2 w => w -> Unsigned w
unsigned Exp a
y))
                   in  t x1 -> t x1 -> t (x1, x1)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 (Unsigned (Exp a) -> Signed (Unsigned (Exp a))
forall w. Num2 w => w -> Signed w
signed (Unsigned (Exp a) -> Unsigned (Exp a)
forall a. Num a => a -> a
negate Unsigned (Exp a)
q)) (Unsigned (Exp a) -> Signed (Unsigned (Exp a))
forall w. Num2 w => w -> Signed w
signed Unsigned (Exp a)
r)
                 else
                   let (Unsigned (Exp a)
q,Unsigned (Exp a)
r) = Unsigned (Exp a)
-> Unsigned (Exp a) -> (Unsigned (Exp a), Unsigned (Exp a))
forall a. Integral a => a -> a -> (a, a)
quotRem (Exp a -> Unsigned (Exp a)
forall w. Num2 w => w -> Unsigned w
unsigned Exp a
x) (Exp a -> Unsigned (Exp a)
forall w. Num2 w => w -> Unsigned w
unsigned Exp a
y)
                   in  t x1 -> t x1 -> t (x1, x1)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 (Unsigned (Exp a) -> Signed (Unsigned (Exp a))
forall w. Num2 w => w -> Signed w
signed Unsigned (Exp a)
q) (Unsigned (Exp a) -> Signed (Unsigned (Exp a))
forall w. Num2 w => w -> Signed w
signed Unsigned (Exp a)
r)

  {-# SPECIALIZE div :: Exp Int128 -> Exp Int128 -> Exp Int128 #-}
  {-# SPECIALIZE mod :: Exp Int128 -> Exp Int128 -> Exp Int128 #-}
  div :: Exp (BigInt a b) -> Exp (BigInt a b) -> Exp (BigInt a b)
div Exp (BigInt a b)
x Exp (BigInt a b)
y = (Exp (BigInt a b), Exp (BigInt a b)) -> Exp (BigInt a b)
forall a b. (a, b) -> a
P.fst (Exp (BigInt a b)
-> Exp (BigInt a b) -> (Exp (BigInt a b), Exp (BigInt a b))
forall a. Integral a => a -> a -> (a, a)
divMod Exp (BigInt a b)
x Exp (BigInt a b)
y)
  mod :: Exp (BigInt a b) -> Exp (BigInt a b) -> Exp (BigInt a b)
mod Exp (BigInt a b)
x Exp (BigInt a b)
y = (Exp (BigInt a b), Exp (BigInt a b)) -> Exp (BigInt a b)
forall a b. (a, b) -> b
P.snd (Exp (BigInt a b)
-> Exp (BigInt a b) -> (Exp (BigInt a b), Exp (BigInt a b))
forall a. Integral a => a -> a -> (a, a)
divMod Exp (BigInt a b)
x Exp (BigInt a b)
y)

  {-# SPECIALIZE divMod :: Exp Int128 -> Exp Int128 -> (Exp Int128, Exp Int128) #-}
  divMod :: Exp (BigInt a b)
-> Exp (BigInt a b) -> (Exp (BigInt a b), Exp (BigInt a b))
divMod Exp (BigInt a b)
x Exp (BigInt a b)
y = Exp (BigInt a b, BigInt a b)
-> (Exp (BigInt a b), Exp (BigInt a b))
forall a b. (Elt a, Elt b) => Exp (a, b) -> (Exp a, Exp b)
untup2 (Exp (BigInt a b, BigInt a b)
 -> (Exp (BigInt a b), Exp (BigInt a b)))
-> Exp (BigInt a b, BigInt a b)
-> (Exp (BigInt a b), Exp (BigInt a b))
forall a b. (a -> b) -> a -> b
$
    if Exp (BigInt a b)
x Exp (BigInt a b) -> Exp (BigInt a b) -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
< Exp (BigInt a b)
0
      then if Exp (BigInt a b)
y Exp (BigInt a b) -> Exp (BigInt a b) -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
< Exp (BigInt a b)
0
             then let (Exp (BigWord (Unsigned a) b)
q,Exp (BigWord (Unsigned a) b)
r) = Exp (BigWord (Unsigned a) b)
-> Exp (BigWord (Unsigned a) b)
-> (Exp (BigWord (Unsigned a) b), Exp (BigWord (Unsigned a) b))
forall a. Integral a => a -> a -> (a, a)
quotRem (Exp (BigWord (Unsigned a) b) -> Exp (BigWord (Unsigned a) b)
forall a. Num a => a -> a
negate (Exp (BigInt a b) -> Unsigned (Exp (BigInt a b))
forall w. Num2 w => w -> Unsigned w
unsigned Exp (BigInt a b)
x)) (Exp (BigWord (Unsigned a) b) -> Exp (BigWord (Unsigned a) b)
forall a. Num a => a -> a
negate (Exp (BigInt a b) -> Unsigned (Exp (BigInt a b))
forall w. Num2 w => w -> Unsigned w
unsigned Exp (BigInt a b)
y))
                  in  Exp (BigInt a b)
-> Exp (BigInt a b) -> Exp (BigInt a b, BigInt a b)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 (Exp (BigWord (Unsigned a) b)
-> Signed (Exp (BigWord (Unsigned a) b))
forall w. Num2 w => w -> Signed w
signed Exp (BigWord (Unsigned a) b)
q) (Exp (BigWord (Unsigned a) b)
-> Signed (Exp (BigWord (Unsigned a) b))
forall w. Num2 w => w -> Signed w
signed (Exp (BigWord (Unsigned a) b) -> Exp (BigWord (Unsigned a) b)
forall a. Num a => a -> a
negate Exp (BigWord (Unsigned a) b)
r))
             else let (Exp (BigWord (Unsigned a) b)
q,Exp (BigWord (Unsigned a) b)
r) = Exp (BigWord (Unsigned a) b)
-> Exp (BigWord (Unsigned a) b)
-> (Exp (BigWord (Unsigned a) b), Exp (BigWord (Unsigned a) b))
forall a. Integral a => a -> a -> (a, a)
quotRem (Exp (BigWord (Unsigned a) b) -> Exp (BigWord (Unsigned a) b)
forall a. Num a => a -> a
negate (Exp (BigInt a b) -> Unsigned (Exp (BigInt a b))
forall w. Num2 w => w -> Unsigned w
unsigned Exp (BigInt a b)
x)) (Exp (BigInt a b) -> Unsigned (Exp (BigInt a b))
forall w. Num2 w => w -> Unsigned w
unsigned Exp (BigInt a b)
y)
                      q' :: Signed (Exp (BigWord (Unsigned a) b))
q'    = Exp (BigWord (Unsigned a) b)
-> Signed (Exp (BigWord (Unsigned a) b))
forall w. Num2 w => w -> Signed w
signed (Exp (BigWord (Unsigned a) b) -> Exp (BigWord (Unsigned a) b)
forall a. Num a => a -> a
negate Exp (BigWord (Unsigned a) b)
q)
                      r' :: Signed (Exp (BigWord (Unsigned a) b))
r'    = Exp (BigWord (Unsigned a) b)
-> Signed (Exp (BigWord (Unsigned a) b))
forall w. Num2 w => w -> Signed w
signed (Exp (BigWord (Unsigned a) b) -> Exp (BigWord (Unsigned a) b)
forall a. Num a => a -> a
negate Exp (BigWord (Unsigned a) b)
r)
                  in
                  if Exp (BigWord (Unsigned a) b)
r Exp (BigWord (Unsigned a) b)
-> Exp (BigWord (Unsigned a) b) -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp (BigWord (Unsigned a) b)
0 then Exp (BigInt a b)
-> Exp (BigInt a b) -> Exp (BigInt a b, BigInt a b)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 Exp (BigInt a b)
Signed (Exp (BigWord (Unsigned a) b))
q' Exp (BigInt a b)
Signed (Exp (BigWord (Unsigned a) b))
r'
                            else Exp (BigInt a b)
-> Exp (BigInt a b) -> Exp (BigInt a b, BigInt a b)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 (Exp (BigInt a b)
Signed (Exp (BigWord (Unsigned a) b))
q'Exp (BigInt a b) -> Exp (BigInt a b) -> Exp (BigInt a b)
forall a. Num a => a -> a -> a
-Exp (BigInt a b)
1) ( Exp (BigInt a b)
Signed (Exp (BigWord (Unsigned a) b))
r'Exp (BigInt a b) -> Exp (BigInt a b) -> Exp (BigInt a b)
forall a. Num a => a -> a -> a
+Exp (BigInt a b)
y)
      else if Exp (BigInt a b)
y Exp (BigInt a b) -> Exp (BigInt a b) -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
< Exp (BigInt a b)
0
             then let (Exp (BigWord (Unsigned a) b)
q,Exp (BigWord (Unsigned a) b)
r) = Exp (BigWord (Unsigned a) b)
-> Exp (BigWord (Unsigned a) b)
-> (Exp (BigWord (Unsigned a) b), Exp (BigWord (Unsigned a) b))
forall a. Integral a => a -> a -> (a, a)
quotRem (Exp (BigInt a b) -> Unsigned (Exp (BigInt a b))
forall w. Num2 w => w -> Unsigned w
unsigned Exp (BigInt a b)
x) (Exp (BigWord (Unsigned a) b) -> Exp (BigWord (Unsigned a) b)
forall a. Num a => a -> a
negate (Exp (BigInt a b) -> Unsigned (Exp (BigInt a b))
forall w. Num2 w => w -> Unsigned w
unsigned Exp (BigInt a b)
y))
                      q' :: Signed (Exp (BigWord (Unsigned a) b))
q'    = Exp (BigWord (Unsigned a) b)
-> Signed (Exp (BigWord (Unsigned a) b))
forall w. Num2 w => w -> Signed w
signed (Exp (BigWord (Unsigned a) b) -> Exp (BigWord (Unsigned a) b)
forall a. Num a => a -> a
negate Exp (BigWord (Unsigned a) b)
q)
                      r' :: Signed (Exp (BigWord (Unsigned a) b))
r'    = Exp (BigWord (Unsigned a) b)
-> Signed (Exp (BigWord (Unsigned a) b))
forall w. Num2 w => w -> Signed w
signed Exp (BigWord (Unsigned a) b)
r
                  in
                  if Exp (BigWord (Unsigned a) b)
r Exp (BigWord (Unsigned a) b)
-> Exp (BigWord (Unsigned a) b) -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp (BigWord (Unsigned a) b)
0
                    then Exp (BigInt a b)
-> Exp (BigInt a b) -> Exp (BigInt a b, BigInt a b)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 Exp (BigInt a b)
Signed (Exp (BigWord (Unsigned a) b))
q' Exp (BigInt a b)
Signed (Exp (BigWord (Unsigned a) b))
r'
                    else Exp (BigInt a b)
-> Exp (BigInt a b) -> Exp (BigInt a b, BigInt a b)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 (Exp (BigInt a b)
Signed (Exp (BigWord (Unsigned a) b))
q'Exp (BigInt a b) -> Exp (BigInt a b) -> Exp (BigInt a b)
forall a. Num a => a -> a -> a
-Exp (BigInt a b)
1) (Exp (BigInt a b)
Signed (Exp (BigWord (Unsigned a) b))
r'Exp (BigInt a b) -> Exp (BigInt a b) -> Exp (BigInt a b)
forall a. Num a => a -> a -> a
+Exp (BigInt a b)
y)
             else let (Exp (BigWord (Unsigned a) b)
q,Exp (BigWord (Unsigned a) b)
r) = Exp (BigWord (Unsigned a) b)
-> Exp (BigWord (Unsigned a) b)
-> (Exp (BigWord (Unsigned a) b), Exp (BigWord (Unsigned a) b))
forall a. Integral a => a -> a -> (a, a)
quotRem (Exp (BigInt a b) -> Unsigned (Exp (BigInt a b))
forall w. Num2 w => w -> Unsigned w
unsigned Exp (BigInt a b)
x) (Exp (BigInt a b) -> Unsigned (Exp (BigInt a b))
forall w. Num2 w => w -> Unsigned w
unsigned Exp (BigInt a b)
y)
                  in  Exp (BigInt a b)
-> Exp (BigInt a b) -> Exp (BigInt a b, BigInt a b)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 (Exp (BigWord (Unsigned a) b)
-> Signed (Exp (BigWord (Unsigned a) b))
forall w. Num2 w => w -> Signed w
signed Exp (BigWord (Unsigned a) b)
q) (Exp (BigWord (Unsigned a) b)
-> Signed (Exp (BigWord (Unsigned a) b))
forall w. Num2 w => w -> Signed w
signed Exp (BigWord (Unsigned a) b)
r)


instance ( FiniteBits a, Integral a, FromIntegral a b, FromIntegral a (Signed b)
         , FiniteBits b, Integral b, FromIntegral b a
         , Bits (Signed b), Integral (Signed b), FromIntegral (Signed b) b
         , Num2 (Exp (BigInt a b))
         , Num2 (Exp (BigWord (Unsigned a) b))
         , Bits (BigWord (Unsigned a) b)
         , FiniteBits (BigInt a b)
         , BigIntCtx a b
         )
    => Bits (BigInt a b) where
  isSigned :: Exp (BigInt a b) -> Exp Bool
isSigned Exp (BigInt a b)
_ = Bool -> Exp Bool
forall e. (HasCallStack, Elt e) => e -> Exp e
constant Bool
True

  I2_ Exp a
xh Exp b
xl .&. :: Exp (BigInt a b) -> Exp (BigInt a b) -> Exp (BigInt a b)
.&.   I2_ Exp a
yh Exp b
yl = Exp a -> Exp b -> Exp (BigInt a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigInt a b)
I2_ (Exp a
xh Exp a -> Exp a -> Exp a
forall a. Bits a => Exp a -> Exp a -> Exp a
.&. Exp a
yh) (Exp b
xl Exp b -> Exp b -> Exp b
forall a. Bits a => Exp a -> Exp a -> Exp a
.&. Exp b
yl)
  I2_ Exp a
xh Exp b
xl .|. :: Exp (BigInt a b) -> Exp (BigInt a b) -> Exp (BigInt a b)
.|.   I2_ Exp a
yh Exp b
yl = Exp a -> Exp b -> Exp (BigInt a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigInt a b)
I2_ (Exp a
xh Exp a -> Exp a -> Exp a
forall a. Bits a => Exp a -> Exp a -> Exp a
.|. Exp a
yh) (Exp b
xl Exp b -> Exp b -> Exp b
forall a. Bits a => Exp a -> Exp a -> Exp a
.|. Exp b
yl)
  I2_ Exp a
xh Exp b
xl xor :: Exp (BigInt a b) -> Exp (BigInt a b) -> Exp (BigInt a b)
`xor` I2_ Exp a
yh Exp b
yl = Exp a -> Exp b -> Exp (BigInt a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigInt a b)
I2_ (Exp a
xh Exp a -> Exp a -> Exp a
forall a. Bits a => Exp a -> Exp a -> Exp a
`xor` Exp a
yh) (Exp b
xl Exp b -> Exp b -> Exp b
forall a. Bits a => Exp a -> Exp a -> Exp a
`xor` Exp b
yl)
  complement :: Exp (BigInt a b) -> Exp (BigInt a b)
complement (I2_ Exp a
hi Exp b
lo)    = Exp a -> Exp b -> Exp (BigInt a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigInt a b)
I2_ (Exp a -> Exp a
forall a. Bits a => Exp a -> Exp a
complement Exp a
hi) (Exp b -> Exp b
forall a. Bits a => Exp a -> Exp a
complement Exp b
lo)

  shiftL :: Exp (BigInt a b) -> Exp Int -> Exp (BigInt a b)
shiftL (I2_ Exp a
hi Exp b
lo) Exp Int
x =
    if Exp Int
y Exp Int -> Exp Int -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
> Exp Int
0
      then Exp a -> Exp b -> Exp (BigInt a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigInt a b)
I2_ (Exp a -> Exp Int -> Exp a
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftL Exp a
hi Exp Int
x Exp a -> Exp a -> Exp a
forall a. Bits a => Exp a -> Exp a -> Exp a
.|. Exp b -> Exp a
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral (Exp b -> Exp Int -> Exp b
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftR Exp b
lo Exp Int
y)) (Exp b -> Exp Int -> Exp b
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftL Exp b
lo Exp Int
x)
      else Exp a -> Exp b -> Exp (BigInt a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigInt a b)
I2_ (Exp b -> Exp a
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral (Exp b -> Exp Int -> Exp b
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftL Exp b
lo (Exp Int -> Exp Int
forall a. Num a => a -> a
negate Exp Int
y))) Exp b
0
    where
      y :: Exp Int
y = Exp b -> Exp Int
forall b. FiniteBits b => Exp b -> Exp Int
finiteBitSize (Exp b
forall a. HasCallStack => a
undefined::Exp b) Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
- Exp Int
x

  shiftR :: Exp (BigInt a b) -> Exp Int -> Exp (BigInt a b)
shiftR (I2_ Exp a
hi Exp b
lo) Exp Int
x = Exp a -> Exp b -> Exp (BigInt a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigInt a b)
I2_ Exp a
hi' Exp b
lo'
    where
      hi' :: Exp a
hi' = Exp a -> Exp Int -> Exp a
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftR Exp a
hi Exp Int
x
      lo' :: Exp b
lo' = if Exp Int
y Exp Int -> Exp Int -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
>= Exp Int
0 then Exp b -> Exp Int -> Exp b
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftL (Exp a -> Exp b
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp a
hi) Exp Int
y Exp b -> Exp b -> Exp b
forall a. Bits a => Exp a -> Exp a -> Exp a
.|. Exp b -> Exp Int -> Exp b
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftR Exp b
lo Exp Int
x
                      else Exp b
z
      --
      y :: Exp Int
y = Exp b -> Exp Int
forall b. FiniteBits b => Exp b -> Exp Int
finiteBitSize (Exp b
forall a. HasCallStack => a
undefined::Exp b) Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
- Exp Int
x
      z :: Exp b
z = Exp (Signed b) -> Exp b
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral (Exp (Signed b) -> Exp Int -> Exp (Signed b)
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftR (Exp a -> Exp (Signed b)
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp a
hi :: Exp (Signed b)) (Exp Int -> Exp Int
forall a. Num a => a -> a
negate Exp Int
y))

  rotateL :: Exp (BigInt a b) -> Exp Int -> Exp (BigInt a b)
rotateL Exp (BigInt a b)
x Exp Int
y = Exp (BigWord (Unsigned a) b)
-> Signed (Exp (BigWord (Unsigned a) b))
forall w. Num2 w => w -> Signed w
signed (Exp (BigWord (Unsigned a) b)
-> Exp Int -> Exp (BigWord (Unsigned a) b)
forall a. Bits a => Exp a -> Exp Int -> Exp a
rotateL (Exp (BigInt a b) -> Unsigned (Exp (BigInt a b))
forall w. Num2 w => w -> Unsigned w
unsigned Exp (BigInt a b)
x) Exp Int
y)
  rotateR :: Exp (BigInt a b) -> Exp Int -> Exp (BigInt a b)
rotateR Exp (BigInt a b)
x Exp Int
y = Exp (BigInt a b) -> Exp Int -> Exp (BigInt a b)
forall a. Bits a => Exp a -> Exp Int -> Exp a
rotateL Exp (BigInt a b)
x (Exp (BigInt a b) -> Exp Int
forall b. FiniteBits b => Exp b -> Exp Int
finiteBitSize (Exp (BigInt a b)
forall a. HasCallStack => a
undefined::Exp (BigInt a b)) Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
- Exp Int
y)

  bit :: Exp Int -> Exp (BigInt a b)
bit Exp Int
n =
    if Exp Int
m Exp Int -> Exp Int -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
>= Exp Int
0 then Exp a -> Exp b -> Exp (BigInt a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigInt a b)
I2_ (Exp Int -> Exp a
forall a. Bits a => Exp Int -> Exp a
bit Exp Int
m) Exp b
0
              else Exp a -> Exp b -> Exp (BigInt a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigInt a b)
I2_ Exp a
0 (Exp Int -> Exp b
forall a. Bits a => Exp Int -> Exp a
bit Exp Int
n)
    where
      m :: Exp Int
m = Exp Int
n Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
- Exp b -> Exp Int
forall b. FiniteBits b => Exp b -> Exp Int
finiteBitSize (Exp b
forall a. HasCallStack => a
undefined::Exp b)

  testBit :: Exp (BigInt a b) -> Exp Int -> Exp Bool
testBit (I2_ Exp a
hi Exp b
lo) Exp Int
n =
    if Exp Int
m Exp Int -> Exp Int -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
>= Exp Int
0 then Exp a -> Exp Int -> Exp Bool
forall a. Bits a => Exp a -> Exp Int -> Exp Bool
testBit Exp a
hi Exp Int
m
              else Exp b -> Exp Int -> Exp Bool
forall a. Bits a => Exp a -> Exp Int -> Exp Bool
testBit Exp b
lo Exp Int
n
    where
      m :: Exp Int
m = Exp Int
n Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
- Exp b -> Exp Int
forall b. FiniteBits b => Exp b -> Exp Int
finiteBitSize (Exp b
forall a. HasCallStack => a
undefined::Exp b)

  setBit :: Exp (BigInt a b) -> Exp Int -> Exp (BigInt a b)
setBit (I2_ Exp a
hi Exp b
lo) Exp Int
n =
    if Exp Int
m Exp Int -> Exp Int -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
>= Exp Int
0 then Exp a -> Exp b -> Exp (BigInt a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigInt a b)
I2_ (Exp a -> Exp Int -> Exp a
forall a. Bits a => Exp a -> Exp Int -> Exp a
setBit Exp a
hi Exp Int
m) Exp b
lo
              else Exp a -> Exp b -> Exp (BigInt a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigInt a b)
I2_ Exp a
hi (Exp b -> Exp Int -> Exp b
forall a. Bits a => Exp a -> Exp Int -> Exp a
setBit Exp b
lo Exp Int
n)
    where
      m :: Exp Int
m = Exp Int
n Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
- Exp b -> Exp Int
forall b. FiniteBits b => Exp b -> Exp Int
finiteBitSize (Exp b
forall a. HasCallStack => a
undefined::Exp b)

  clearBit :: Exp (BigInt a b) -> Exp Int -> Exp (BigInt a b)
clearBit (I2_ Exp a
hi Exp b
lo) Exp Int
n =
    if Exp Int
m Exp Int -> Exp Int -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
>= Exp Int
0 then Exp a -> Exp b -> Exp (BigInt a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigInt a b)
I2_ (Exp a -> Exp Int -> Exp a
forall a. Bits a => Exp a -> Exp Int -> Exp a
clearBit Exp a
hi Exp Int
m) Exp b
lo
              else Exp a -> Exp b -> Exp (BigInt a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigInt a b)
I2_ Exp a
hi (Exp b -> Exp Int -> Exp b
forall a. Bits a => Exp a -> Exp Int -> Exp a
clearBit Exp b
lo Exp Int
n)
    where
      m :: Exp Int
m = Exp Int
n Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
- Exp b -> Exp Int
forall b. FiniteBits b => Exp b -> Exp Int
finiteBitSize (Exp b
forall a. HasCallStack => a
undefined::Exp b)

  complementBit :: Exp (BigInt a b) -> Exp Int -> Exp (BigInt a b)
complementBit (I2_ Exp a
hi Exp b
lo) Exp Int
n =
    if Exp Int
m Exp Int -> Exp Int -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
>= Exp Int
0 then Exp a -> Exp b -> Exp (BigInt a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigInt a b)
I2_ (Exp a -> Exp Int -> Exp a
forall a. Bits a => Exp a -> Exp Int -> Exp a
complementBit Exp a
hi Exp Int
m) Exp b
lo
              else Exp a -> Exp b -> Exp (BigInt a b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigInt a b)
I2_ Exp a
hi (Exp b -> Exp Int -> Exp b
forall a. Bits a => Exp a -> Exp Int -> Exp a
complementBit Exp b
lo Exp Int
n)
    where
      m :: Exp Int
m = Exp Int
n Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
- Exp b -> Exp Int
forall b. FiniteBits b => Exp b -> Exp Int
finiteBitSize (Exp b
forall a. HasCallStack => a
undefined::Exp b)

  popCount :: Exp (BigInt a b) -> Exp Int
popCount (I2_ Exp a
hi Exp b
lo) = Exp a -> Exp Int
forall a. Bits a => Exp a -> Exp Int
popCount Exp a
hi Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
+ Exp b -> Exp Int
forall a. Bits a => Exp a -> Exp Int
popCount Exp b
lo


instance ( FiniteBits a
         , FiniteBits b
         , Bits (BigInt a b)
         , Num2 (Exp (BigInt a b))
         , FiniteBits (BigWord (Unsigned a) b)
         , BigIntCtx a b
         )
    => FiniteBits (BigInt a b) where
  finiteBitSize :: Exp (BigInt a b) -> Exp Int
finiteBitSize Exp (BigInt a b)
_ = Exp a -> Exp Int
forall b. FiniteBits b => Exp b -> Exp Int
finiteBitSize (Exp a
forall a. HasCallStack => a
undefined::Exp a)
                  Exp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
+ Exp b -> Exp Int
forall b. FiniteBits b => Exp b -> Exp Int
finiteBitSize (Exp b
forall a. HasCallStack => a
undefined::Exp b)

  countLeadingZeros :: Exp (BigInt a b) -> Exp Int
countLeadingZeros  = Exp (BigWord (Unsigned a) b) -> Exp Int
forall b. FiniteBits b => Exp b -> Exp Int
countLeadingZeros (Exp (BigWord (Unsigned a) b) -> Exp Int)
-> (Exp (BigInt a b) -> Exp (BigWord (Unsigned a) b))
-> Exp (BigInt a b)
-> Exp Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp (BigInt a b) -> Exp (BigWord (Unsigned a) b)
forall w. Num2 w => w -> Unsigned w
unsigned
  countTrailingZeros :: Exp (BigInt a b) -> Exp Int
countTrailingZeros = Exp (BigWord (Unsigned a) b) -> Exp Int
forall b. FiniteBits b => Exp b -> Exp Int
countTrailingZeros (Exp (BigWord (Unsigned a) b) -> Exp Int)
-> (Exp (BigInt a b) -> Exp (BigWord (Unsigned a) b))
-> Exp (BigInt a b)
-> Exp Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp (BigInt a b) -> Exp (BigWord (Unsigned a) b)
forall w. Num2 w => w -> Unsigned w
unsigned


instance ( Ord a
         , Num a
         , Num2 (Exp a)
         , Ord (BigInt a b)
         , Num (BigInt a b)
         , Bits (BigInt a b)
         , Bounded (BigWord (Unsigned a) b)
         , Num (BigWord (Unsigned a) b)
         , Num2 (Exp (BigWord (Unsigned a) b))
         , Elt (Unsigned a)
         , Exp (Unsigned a) ~ Unsigned (Exp a)
         , BigIntCtx a b
         )
    => Num2 (Exp (BigInt a b)) where
  type Signed   (Exp (BigInt a b)) = Exp (BigInt a b)
  type Unsigned (Exp (BigInt a b)) = Exp (BigWord (Unsigned a) b)
  --
  signed :: Exp (BigInt a b) -> Signed (Exp (BigInt a b))
signed = Exp (BigInt a b) -> Signed (Exp (BigInt a b))
forall a. a -> a
id
  unsigned :: Exp (BigInt a b) -> Unsigned (Exp (BigInt a b))
unsigned (I2_ Exp a
hi Exp b
lo) = Exp (Unsigned a) -> Exp b -> Exp (BigWord (Unsigned a) b)
forall a b. (Elt a, Elt b) => Exp a -> Exp b -> Exp (BigWord a b)
W2_ (Exp a -> Unsigned (Exp a)
forall w. Num2 w => w -> Unsigned w
unsigned Exp a
hi) Exp b
lo
  --
  addWithCarry :: Exp (BigInt a b)
-> Exp (BigInt a b)
-> (Exp (BigInt a b), Unsigned (Exp (BigInt a b)))
addWithCarry Exp (BigInt a b)
x Exp (BigInt a b)
y = (Exp (BigInt a b)
Signed (Exp (BigWord (Unsigned a) b))
c, Exp (BigWord (Unsigned a) b)
Unsigned (Exp (BigInt a b))
r)
    where
      t1 :: Exp (BigWord (Unsigned a) b)
t1      = if Exp (BigInt a b)
x Exp (BigInt a b) -> Exp (BigInt a b) -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
< Exp (BigInt a b)
0 then Exp (BigWord (Unsigned a) b)
forall a. Bounded a => a
maxBound else Exp (BigWord (Unsigned a) b)
forall a. Bounded a => a
minBound
      t2 :: Exp (BigWord (Unsigned a) b)
t2      = if Exp (BigInt a b)
y Exp (BigInt a b) -> Exp (BigInt a b) -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
< Exp (BigInt a b)
0 then Exp (BigWord (Unsigned a) b)
forall a. Bounded a => a
maxBound else Exp (BigWord (Unsigned a) b)
forall a. Bounded a => a
minBound
      (Exp (BigWord (Unsigned a) b)
t3, Exp (BigWord (Unsigned a) b)
r) = Exp (BigWord (Unsigned a) b)
-> Exp (BigWord (Unsigned a) b)
-> (Exp (BigWord (Unsigned a) b),
    Unsigned (Exp (BigWord (Unsigned a) b)))
forall w. Num2 w => w -> w -> (w, Unsigned w)
addWithCarry (Exp (BigInt a b) -> Unsigned (Exp (BigInt a b))
forall w. Num2 w => w -> Unsigned w
unsigned Exp (BigInt a b)
x) (Exp (BigInt a b) -> Unsigned (Exp (BigInt a b))
forall w. Num2 w => w -> Unsigned w
unsigned Exp (BigInt a b)
y)
      c :: Signed (Exp (BigWord (Unsigned a) b))
c       = Exp (BigWord (Unsigned a) b)
-> Signed (Exp (BigWord (Unsigned a) b))
forall w. Num2 w => w -> Signed w
signed (Exp (BigWord (Unsigned a) b)
t1Exp (BigWord (Unsigned a) b)
-> Exp (BigWord (Unsigned a) b) -> Exp (BigWord (Unsigned a) b)
forall a. Num a => a -> a -> a
+Exp (BigWord (Unsigned a) b)
t2Exp (BigWord (Unsigned a) b)
-> Exp (BigWord (Unsigned a) b) -> Exp (BigWord (Unsigned a) b)
forall a. Num a => a -> a -> a
+Exp (BigWord (Unsigned a) b)
t3)

  mulWithCarry :: Exp (BigInt a b)
-> Exp (BigInt a b)
-> (Exp (BigInt a b), Unsigned (Exp (BigInt a b)))
mulWithCarry x :: Exp (BigInt a b)
x@(I2_ Exp a
xh Exp b
_) y :: Exp (BigInt a b)
y@(I2_ Exp a
yh Exp b
_) = (Exp (BigInt a b)
hi,Exp (BigWord (Unsigned a) b)
Unsigned (Exp (BigInt a b))
lo)
    where
      t1 :: Exp (BigInt a b)
t1        = Exp (BigInt a b) -> Exp (BigInt a b)
forall a. Bits a => Exp a -> Exp a
complement Exp (BigInt a b)
y Exp (BigInt a b) -> Exp (BigInt a b) -> Exp (BigInt a b)
forall a. Num a => a -> a -> a
+ Exp (BigInt a b)
1
      t2 :: Exp (BigInt a b)
t2        = Exp (BigInt a b) -> Exp (BigInt a b)
forall a. Bits a => Exp a -> Exp a
complement Exp (BigInt a b)
x Exp (BigInt a b) -> Exp (BigInt a b) -> Exp (BigInt a b)
forall a. Num a => a -> a -> a
+ Exp (BigInt a b)
1
      (Exp (BigWord (Unsigned a) b)
t3, Exp (BigWord (Unsigned a) b)
lo)  = Exp (BigWord (Unsigned a) b)
-> Exp (BigWord (Unsigned a) b)
-> (Exp (BigWord (Unsigned a) b),
    Unsigned (Exp (BigWord (Unsigned a) b)))
forall w. Num2 w => w -> w -> (w, Unsigned w)
mulWithCarry (Exp (BigInt a b) -> Unsigned (Exp (BigInt a b))
forall w. Num2 w => w -> Unsigned w
unsigned Exp (BigInt a b)
x) (Exp (BigInt a b) -> Unsigned (Exp (BigInt a b))
forall w. Num2 w => w -> Unsigned w
unsigned Exp (BigInt a b)
y)
      t4 :: Signed (Exp (BigWord (Unsigned a) b))
t4        = Exp (BigWord (Unsigned a) b)
-> Signed (Exp (BigWord (Unsigned a) b))
forall w. Num2 w => w -> Signed w
signed Exp (BigWord (Unsigned a) b)
t3
      hi :: Exp (BigInt a b)
hi        = if Exp a
xh Exp a -> Exp a -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
< Exp a
0
                    then if Exp a
yh Exp a -> Exp a -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
< Exp a
0
                           then Exp (BigInt a b)
Signed (Exp (BigWord (Unsigned a) b))
t4 Exp (BigInt a b) -> Exp (BigInt a b) -> Exp (BigInt a b)
forall a. Num a => a -> a -> a
+ Exp (BigInt a b)
t1 Exp (BigInt a b) -> Exp (BigInt a b) -> Exp (BigInt a b)
forall a. Num a => a -> a -> a
+ Exp (BigInt a b)
t2
                           else Exp (BigInt a b)
Signed (Exp (BigWord (Unsigned a) b))
t4 Exp (BigInt a b) -> Exp (BigInt a b) -> Exp (BigInt a b)
forall a. Num a => a -> a -> a
+ Exp (BigInt a b)
t1
                    else if Exp a
yh Exp a -> Exp a -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
< Exp a
0
                           then Exp (BigInt a b)
Signed (Exp (BigWord (Unsigned a) b))
t4 Exp (BigInt a b) -> Exp (BigInt a b) -> Exp (BigInt a b)
forall a. Num a => a -> a -> a
+ Exp (BigInt a b)
t2
                           else Exp (BigInt a b)
Signed (Exp (BigWord (Unsigned a) b))
t4


-- Num2
-- ----

instance Num2 (Exp Int8) where
  type Signed   (Exp Int8) = Exp Int8
  type Unsigned (Exp Int8) = Exp Word8
  --
  signed :: Exp Int8 -> Signed (Exp Int8)
signed       = Exp Int8 -> Signed (Exp Int8)
forall a. a -> a
id
  unsigned :: Exp Int8 -> Unsigned (Exp Int8)
unsigned     = Exp Int8 -> Unsigned (Exp Int8)
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral
  addWithCarry :: Exp Int8 -> Exp Int8 -> (Exp Int8, Unsigned (Exp Int8))
addWithCarry = (Exp Int16 -> Exp Int16 -> Exp Int16)
-> Exp Int8 -> Exp Int8 -> (Exp Int8, Unsigned (Exp Int8))
forall w ww w'.
(FiniteBits w, Bits ww, Integral w, Integral ww, FromIntegral w ww,
 FromIntegral ww w, FromIntegral ww w',
 Unsigned (Exp w) ~ Exp w') =>
(Exp ww -> Exp ww -> Exp ww)
-> Exp w -> Exp w -> (Exp w, Unsigned (Exp w))
defaultUnwrapped (Exp Int16 -> Exp Int16 -> Exp Int16
forall a. Num a => a -> a -> a
(+) :: Exp Int16 -> Exp Int16 -> Exp Int16)
  mulWithCarry :: Exp Int8 -> Exp Int8 -> (Exp Int8, Unsigned (Exp Int8))
mulWithCarry = (Exp Int16 -> Exp Int16 -> Exp Int16)
-> Exp Int8 -> Exp Int8 -> (Exp Int8, Unsigned (Exp Int8))
forall w ww w'.
(FiniteBits w, Bits ww, Integral w, Integral ww, FromIntegral w ww,
 FromIntegral ww w, FromIntegral ww w',
 Unsigned (Exp w) ~ Exp w') =>
(Exp ww -> Exp ww -> Exp ww)
-> Exp w -> Exp w -> (Exp w, Unsigned (Exp w))
defaultUnwrapped (Exp Int16 -> Exp Int16 -> Exp Int16
forall a. Num a => a -> a -> a
(*) :: Exp Int16 -> Exp Int16 -> Exp Int16)

instance Num2 (Exp Word8) where
  type Signed   (Exp Word8) = Exp Int8
  type Unsigned (Exp Word8) = Exp Word8
  --
  signed :: Exp Word8 -> Signed (Exp Word8)
signed       = Exp Word8 -> Signed (Exp Word8)
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral
  unsigned :: Exp Word8 -> Unsigned (Exp Word8)
unsigned     = Exp Word8 -> Unsigned (Exp Word8)
forall a. a -> a
id
  addWithCarry :: Exp Word8 -> Exp Word8 -> (Exp Word8, Unsigned (Exp Word8))
addWithCarry = (Exp Word16 -> Exp Word16 -> Exp Word16)
-> Exp Word8 -> Exp Word8 -> (Exp Word8, Unsigned (Exp Word8))
forall w ww w'.
(FiniteBits w, Bits ww, Integral w, Integral ww, FromIntegral w ww,
 FromIntegral ww w, FromIntegral ww w',
 Unsigned (Exp w) ~ Exp w') =>
(Exp ww -> Exp ww -> Exp ww)
-> Exp w -> Exp w -> (Exp w, Unsigned (Exp w))
defaultUnwrapped (Exp Word16 -> Exp Word16 -> Exp Word16
forall a. Num a => a -> a -> a
(+) :: Exp Word16 -> Exp Word16 -> Exp Word16)
  mulWithCarry :: Exp Word8 -> Exp Word8 -> (Exp Word8, Unsigned (Exp Word8))
mulWithCarry = (Exp Word16 -> Exp Word16 -> Exp Word16)
-> Exp Word8 -> Exp Word8 -> (Exp Word8, Unsigned (Exp Word8))
forall w ww w'.
(FiniteBits w, Bits ww, Integral w, Integral ww, FromIntegral w ww,
 FromIntegral ww w, FromIntegral ww w',
 Unsigned (Exp w) ~ Exp w') =>
(Exp ww -> Exp ww -> Exp ww)
-> Exp w -> Exp w -> (Exp w, Unsigned (Exp w))
defaultUnwrapped (Exp Word16 -> Exp Word16 -> Exp Word16
forall a. Num a => a -> a -> a
(*) :: Exp Word16 -> Exp Word16 -> Exp Word16)

instance Num2 (Exp Int16) where
  type Signed   (Exp Int16) = Exp Int16
  type Unsigned (Exp Int16) = Exp Word16
  --
  signed :: Exp Int16 -> Signed (Exp Int16)
signed       = Exp Int16 -> Signed (Exp Int16)
forall a. a -> a
id
  unsigned :: Exp Int16 -> Unsigned (Exp Int16)
unsigned     = Exp Int16 -> Unsigned (Exp Int16)
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral
  addWithCarry :: Exp Int16 -> Exp Int16 -> (Exp Int16, Unsigned (Exp Int16))
addWithCarry = (Exp Int32 -> Exp Int32 -> Exp Int32)
-> Exp Int16 -> Exp Int16 -> (Exp Int16, Unsigned (Exp Int16))
forall w ww w'.
(FiniteBits w, Bits ww, Integral w, Integral ww, FromIntegral w ww,
 FromIntegral ww w, FromIntegral ww w',
 Unsigned (Exp w) ~ Exp w') =>
(Exp ww -> Exp ww -> Exp ww)
-> Exp w -> Exp w -> (Exp w, Unsigned (Exp w))
defaultUnwrapped (Exp Int32 -> Exp Int32 -> Exp Int32
forall a. Num a => a -> a -> a
(+) :: Exp Int32 -> Exp Int32 -> Exp Int32)
  mulWithCarry :: Exp Int16 -> Exp Int16 -> (Exp Int16, Unsigned (Exp Int16))
mulWithCarry = (Exp Int32 -> Exp Int32 -> Exp Int32)
-> Exp Int16 -> Exp Int16 -> (Exp Int16, Unsigned (Exp Int16))
forall w ww w'.
(FiniteBits w, Bits ww, Integral w, Integral ww, FromIntegral w ww,
 FromIntegral ww w, FromIntegral ww w',
 Unsigned (Exp w) ~ Exp w') =>
(Exp ww -> Exp ww -> Exp ww)
-> Exp w -> Exp w -> (Exp w, Unsigned (Exp w))
defaultUnwrapped (Exp Int32 -> Exp Int32 -> Exp Int32
forall a. Num a => a -> a -> a
(*) :: Exp Int32 -> Exp Int32 -> Exp Int32)

instance Num2 (Exp Word16) where
  type Signed   (Exp Word16) = Exp Int16
  type Unsigned (Exp Word16) = Exp Word16
  --
  signed :: Exp Word16 -> Signed (Exp Word16)
signed       = Exp Word16 -> Signed (Exp Word16)
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral
  unsigned :: Exp Word16 -> Unsigned (Exp Word16)
unsigned     = Exp Word16 -> Unsigned (Exp Word16)
forall a. a -> a
id
  addWithCarry :: Exp Word16 -> Exp Word16 -> (Exp Word16, Unsigned (Exp Word16))
addWithCarry = (Exp Word32 -> Exp Word32 -> Exp Word32)
-> Exp Word16 -> Exp Word16 -> (Exp Word16, Unsigned (Exp Word16))
forall w ww w'.
(FiniteBits w, Bits ww, Integral w, Integral ww, FromIntegral w ww,
 FromIntegral ww w, FromIntegral ww w',
 Unsigned (Exp w) ~ Exp w') =>
(Exp ww -> Exp ww -> Exp ww)
-> Exp w -> Exp w -> (Exp w, Unsigned (Exp w))
defaultUnwrapped (Exp Word32 -> Exp Word32 -> Exp Word32
forall a. Num a => a -> a -> a
(+) :: Exp Word32 -> Exp Word32 -> Exp Word32)
  mulWithCarry :: Exp Word16 -> Exp Word16 -> (Exp Word16, Unsigned (Exp Word16))
mulWithCarry = (Exp Word32 -> Exp Word32 -> Exp Word32)
-> Exp Word16 -> Exp Word16 -> (Exp Word16, Unsigned (Exp Word16))
forall w ww w'.
(FiniteBits w, Bits ww, Integral w, Integral ww, FromIntegral w ww,
 FromIntegral ww w, FromIntegral ww w',
 Unsigned (Exp w) ~ Exp w') =>
(Exp ww -> Exp ww -> Exp ww)
-> Exp w -> Exp w -> (Exp w, Unsigned (Exp w))
defaultUnwrapped (Exp Word32 -> Exp Word32 -> Exp Word32
forall a. Num a => a -> a -> a
(*) :: Exp Word32 -> Exp Word32 -> Exp Word32)

instance Num2 (Exp Int32) where
  type Signed   (Exp Int32) = Exp Int32
  type Unsigned (Exp Int32) = Exp Word32
  --
  signed :: Exp Int32 -> Signed (Exp Int32)
signed       = Exp Int32 -> Signed (Exp Int32)
forall a. a -> a
id
  unsigned :: Exp Int32 -> Unsigned (Exp Int32)
unsigned     = Exp Int32 -> Unsigned (Exp Int32)
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral
  addWithCarry :: Exp Int32 -> Exp Int32 -> (Exp Int32, Unsigned (Exp Int32))
addWithCarry = (Exp Int64 -> Exp Int64 -> Exp Int64)
-> Exp Int32 -> Exp Int32 -> (Exp Int32, Unsigned (Exp Int32))
forall w ww w'.
(FiniteBits w, Bits ww, Integral w, Integral ww, FromIntegral w ww,
 FromIntegral ww w, FromIntegral ww w',
 Unsigned (Exp w) ~ Exp w') =>
(Exp ww -> Exp ww -> Exp ww)
-> Exp w -> Exp w -> (Exp w, Unsigned (Exp w))
defaultUnwrapped (Exp Int64 -> Exp Int64 -> Exp Int64
forall a. Num a => a -> a -> a
(+) :: Exp Int64 -> Exp Int64 -> Exp Int64)
  mulWithCarry :: Exp Int32 -> Exp Int32 -> (Exp Int32, Unsigned (Exp Int32))
mulWithCarry = (Exp Int64 -> Exp Int64 -> Exp Int64)
-> Exp Int32 -> Exp Int32 -> (Exp Int32, Unsigned (Exp Int32))
forall w ww w'.
(FiniteBits w, Bits ww, Integral w, Integral ww, FromIntegral w ww,
 FromIntegral ww w, FromIntegral ww w',
 Unsigned (Exp w) ~ Exp w') =>
(Exp ww -> Exp ww -> Exp ww)
-> Exp w -> Exp w -> (Exp w, Unsigned (Exp w))
defaultUnwrapped (Exp Int64 -> Exp Int64 -> Exp Int64
forall a. Num a => a -> a -> a
(*) :: Exp Int64 -> Exp Int64 -> Exp Int64)

instance Num2 (Exp Word32) where
  type Signed   (Exp Word32) = Exp Int32
  type Unsigned (Exp Word32) = Exp Word32
  --
  signed :: Exp Word32 -> Signed (Exp Word32)
signed       = Exp Word32 -> Signed (Exp Word32)
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral
  unsigned :: Exp Word32 -> Unsigned (Exp Word32)
unsigned     = Exp Word32 -> Unsigned (Exp Word32)
forall a. a -> a
id
  addWithCarry :: Exp Word32 -> Exp Word32 -> (Exp Word32, Unsigned (Exp Word32))
addWithCarry = (Exp Word64 -> Exp Word64 -> Exp Word64)
-> Exp Word32 -> Exp Word32 -> (Exp Word32, Unsigned (Exp Word32))
forall w ww w'.
(FiniteBits w, Bits ww, Integral w, Integral ww, FromIntegral w ww,
 FromIntegral ww w, FromIntegral ww w',
 Unsigned (Exp w) ~ Exp w') =>
(Exp ww -> Exp ww -> Exp ww)
-> Exp w -> Exp w -> (Exp w, Unsigned (Exp w))
defaultUnwrapped (Exp Word64 -> Exp Word64 -> Exp Word64
forall a. Num a => a -> a -> a
(+) :: Exp Word64 -> Exp Word64 -> Exp Word64)
  mulWithCarry :: Exp Word32 -> Exp Word32 -> (Exp Word32, Unsigned (Exp Word32))
mulWithCarry = (Exp Word64 -> Exp Word64 -> Exp Word64)
-> Exp Word32 -> Exp Word32 -> (Exp Word32, Unsigned (Exp Word32))
forall w ww w'.
(FiniteBits w, Bits ww, Integral w, Integral ww, FromIntegral w ww,
 FromIntegral ww w, FromIntegral ww w',
 Unsigned (Exp w) ~ Exp w') =>
(Exp ww -> Exp ww -> Exp ww)
-> Exp w -> Exp w -> (Exp w, Unsigned (Exp w))
defaultUnwrapped (Exp Word64 -> Exp Word64 -> Exp Word64
forall a. Num a => a -> a -> a
(*) :: Exp Word64 -> Exp Word64 -> Exp Word64)

instance Num2 (Exp Int64) where
  type Signed   (Exp Int64) = Exp Int64
  type Unsigned (Exp Int64) = Exp Word64
  --
  signed :: Exp Int64 -> Signed (Exp Int64)
signed       = Exp Int64 -> Signed (Exp Int64)
forall a. a -> a
id
  unsigned :: Exp Int64 -> Unsigned (Exp Int64)
unsigned     = Exp Int64 -> Unsigned (Exp Int64)
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral
  addWithCarry :: Exp Int64 -> Exp Int64 -> (Exp Int64, Unsigned (Exp Int64))
addWithCarry = Exp (Int64, Word64) -> (Exp Int64, Exp Word64)
forall a b. (Elt a, Elt b) => Exp (a, b) -> (Exp a, Exp b)
untup2 (Exp (Int64, Word64) -> (Exp Int64, Exp Word64))
-> (Exp Int64 -> Exp Int64 -> Exp (Int64, Word64))
-> Exp Int64
-> Exp Int64
-> (Exp Int64, Exp Word64)
forall b a c d. (b -> a) -> (c -> d -> b) -> c -> d -> a
$$ (Exp Int64 -> Exp Int64 -> Exp (Int64, Word64))
-> Exp Int64 -> Exp Int64 -> Exp (Int64, Word64)
CPU.addWithCarryInt64# ((Exp Int64 -> Exp Int64 -> Exp (Int64, Word64))
 -> Exp Int64 -> Exp Int64 -> Exp (Int64, Word64))
-> (Exp Int64 -> Exp Int64 -> Exp (Int64, Word64))
-> Exp Int64
-> Exp Int64
-> Exp (Int64, Word64)
forall a b. (a -> b) -> a -> b
$ (Exp Int64 -> Exp Int64 -> Exp (Int64, Word64))
-> Exp Int64 -> Exp Int64 -> Exp (Int64, Word64)
PTX.addWithCarryInt64# Exp Int64 -> Exp Int64 -> Exp (Int64, Word64)
forall t a a (con :: * -> *) x0 x1.
(Num2 (Exp t), Num2 (Exp a), Num2 (Exp a), Bounded (Exp t), Ord a,
 Ord a, Num (Exp a), Num (Exp t), Num (Exp a),
 IsPattern con (x0, x1) (con x0, con x1), Elt t,
 Unsigned (Exp a) ~ Exp t, Unsigned (Exp t) ~ con x1,
 Unsigned (Exp a) ~ Exp t, Signed (Exp t) ~ con x0) =>
Exp a -> Exp a -> con (x0, x1)
awc
    where
      awc :: Exp a -> Exp a -> con (x0, x1)
awc Exp a
x Exp a
y = con x0 -> con x1 -> con (x0, x1)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 con x0
Signed (Exp t)
hi con x1
lo
        where
          extX :: Exp t
extX      = Exp a
x Exp a -> Exp a -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
< Exp a
0 Exp Bool -> (Exp t, Exp t) -> Exp t
forall t. Elt t => Exp Bool -> (Exp t, Exp t) -> Exp t
? (Exp t
forall a. Bounded a => a
maxBound, Exp t
0)
          extY :: Exp t
extY      = Exp a
y Exp a -> Exp a -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
< Exp a
0 Exp Bool -> (Exp t, Exp t) -> Exp t
forall t. Elt t => Exp Bool -> (Exp t, Exp t) -> Exp t
? (Exp t
forall a. Bounded a => a
maxBound, Exp t
0)
          (Exp t
hi',con x1
lo)  = Exp a -> Unsigned (Exp a)
forall w. Num2 w => w -> Unsigned w
unsigned Exp a
x Exp t -> Exp t -> (Exp t, Unsigned (Exp t))
forall w. Num2 w => w -> w -> (w, Unsigned w)
`addWithCarry` Exp a -> Unsigned (Exp a)
forall w. Num2 w => w -> Unsigned w
unsigned Exp a
y
          hi :: Signed (Exp t)
hi        = Exp t -> Signed (Exp t)
forall w. Num2 w => w -> Signed w
signed (Exp t
hi' Exp t -> Exp t -> Exp t
forall a. Num a => a -> a -> a
+ Exp t
extX Exp t -> Exp t -> Exp t
forall a. Num a => a -> a -> a
+ Exp t
extY)

  mulWithCarry :: Exp Int64 -> Exp Int64 -> (Exp Int64, Unsigned (Exp Int64))
mulWithCarry = Exp (Int64, Word64) -> (Exp Int64, Exp Word64)
forall a b. (Elt a, Elt b) => Exp (a, b) -> (Exp a, Exp b)
untup2 (Exp (Int64, Word64) -> (Exp Int64, Exp Word64))
-> (Exp Int64 -> Exp Int64 -> Exp (Int64, Word64))
-> Exp Int64
-> Exp Int64
-> (Exp Int64, Exp Word64)
forall b a c d. (b -> a) -> (c -> d -> b) -> c -> d -> a
$$ (Exp Int64 -> Exp Int64 -> Exp (Int64, Word64))
-> Exp Int64 -> Exp Int64 -> Exp (Int64, Word64)
CPU.mulWithCarryInt64# ((Exp Int64 -> Exp Int64 -> Exp (Int64, Word64))
 -> Exp Int64 -> Exp Int64 -> Exp (Int64, Word64))
-> (Exp Int64 -> Exp Int64 -> Exp (Int64, Word64))
-> Exp Int64
-> Exp Int64
-> Exp (Int64, Word64)
forall a b. (a -> b) -> a -> b
$ (Exp Int64 -> Exp Int64 -> Exp (Int64, Word64))
-> Exp Int64 -> Exp Int64 -> Exp (Int64, Word64)
PTX.mulWithCarryInt64# Exp Int64 -> Exp Int64 -> Exp (Int64, Word64)
forall x0 x1.
(Num2 (Unsigned (Exp x0)), Num2 (Exp x0), Ord x0, Num (Exp x0),
 Elt x1, Unsigned (Unsigned (Exp x0)) ~ Exp x1,
 Signed (Unsigned (Exp x0)) ~ Exp x0) =>
Exp x0 -> Exp x0 -> Exp (x0, x1)
mwc
    where
      mwc :: Exp x0 -> Exp x0 -> Exp (x0, x1)
mwc Exp x0
x Exp x0
y = Exp x0 -> Exp x1 -> Exp (x0, x1)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 Exp x0
hi Exp x1
lo
        where
          extX :: Exp x0
extX      = Exp x0
x Exp x0 -> Exp x0 -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
< Exp x0
0 Exp Bool -> (Exp x0, Exp x0) -> Exp x0
forall t. Elt t => Exp Bool -> (Exp t, Exp t) -> Exp t
? (Exp x0 -> Exp x0
forall a. Num a => a -> a
negate Exp x0
y, Exp x0
0)
          extY :: Exp x0
extY      = Exp x0
y Exp x0 -> Exp x0 -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
< Exp x0
0 Exp Bool -> (Exp x0, Exp x0) -> Exp x0
forall t. Elt t => Exp Bool -> (Exp t, Exp t) -> Exp t
? (Exp x0 -> Exp x0
forall a. Num a => a -> a
negate Exp x0
x, Exp x0
0)
          (Unsigned (Exp x0)
hi',Exp x1
lo)  = Exp x0 -> Unsigned (Exp x0)
forall w. Num2 w => w -> Unsigned w
unsigned Exp x0
x Unsigned (Exp x0)
-> Unsigned (Exp x0)
-> (Unsigned (Exp x0), Unsigned (Unsigned (Exp x0)))
forall w. Num2 w => w -> w -> (w, Unsigned w)
`mulWithCarry` Exp x0 -> Unsigned (Exp x0)
forall w. Num2 w => w -> Unsigned w
unsigned Exp x0
y
          hi :: Exp x0
hi        = Unsigned (Exp x0) -> Signed (Unsigned (Exp x0))
forall w. Num2 w => w -> Signed w
signed Unsigned (Exp x0)
hi' Exp x0 -> Exp x0 -> Exp x0
forall a. Num a => a -> a -> a
+ Exp x0
extX Exp x0 -> Exp x0 -> Exp x0
forall a. Num a => a -> a -> a
+ Exp x0
extY

instance Num2 (Exp Word64) where
  type Signed   (Exp Word64) = Exp Int64
  type Unsigned (Exp Word64) = Exp Word64
  --
  signed :: Exp Word64 -> Signed (Exp Word64)
signed       = Exp Word64 -> Signed (Exp Word64)
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral
  unsigned :: Exp Word64 -> Unsigned (Exp Word64)
unsigned     = Exp Word64 -> Unsigned (Exp Word64)
forall a. a -> a
id
  addWithCarry :: Exp Word64 -> Exp Word64 -> (Exp Word64, Unsigned (Exp Word64))
addWithCarry = Exp (Word64, Word64) -> (Exp Word64, Exp Word64)
forall a b. (Elt a, Elt b) => Exp (a, b) -> (Exp a, Exp b)
untup2 (Exp (Word64, Word64) -> (Exp Word64, Exp Word64))
-> (Exp Word64 -> Exp Word64 -> Exp (Word64, Word64))
-> Exp Word64
-> Exp Word64
-> (Exp Word64, Exp Word64)
forall b a c d. (b -> a) -> (c -> d -> b) -> c -> d -> a
$$ (Exp Word64 -> Exp Word64 -> Exp (Word64, Word64))
-> Exp Word64 -> Exp Word64 -> Exp (Word64, Word64)
CPU.addWithCarryWord64# ((Exp Word64 -> Exp Word64 -> Exp (Word64, Word64))
 -> Exp Word64 -> Exp Word64 -> Exp (Word64, Word64))
-> (Exp Word64 -> Exp Word64 -> Exp (Word64, Word64))
-> Exp Word64
-> Exp Word64
-> Exp (Word64, Word64)
forall a b. (a -> b) -> a -> b
$ (Exp Word64 -> Exp Word64 -> Exp (Word64, Word64))
-> Exp Word64 -> Exp Word64 -> Exp (Word64, Word64)
PTX.addWithCarryWord64# Exp Word64 -> Exp Word64 -> Exp (Word64, Word64)
forall x1 x0.
(Ord x1, Num (Exp x1), Num (Exp x0), Elt x0) =>
Exp x1 -> Exp x1 -> Exp (x0, x1)
awc
    where
      awc :: Exp x1 -> Exp x1 -> Exp (x0, x1)
awc Exp x1
x Exp x1
y = Exp x0 -> Exp x1 -> Exp (x0, x1)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 Exp x0
hi Exp x1
lo
        where
          lo :: Exp x1
lo = Exp x1
x Exp x1 -> Exp x1 -> Exp x1
forall a. Num a => a -> a -> a
+ Exp x1
y
          hi :: Exp x0
hi = Exp x1
lo Exp x1 -> Exp x1 -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
< Exp x1
x Exp Bool -> (Exp x0, Exp x0) -> Exp x0
forall t. Elt t => Exp Bool -> (Exp t, Exp t) -> Exp t
? (Exp x0
1,Exp x0
0)

  mulWithCarry :: Exp Word64 -> Exp Word64 -> (Exp Word64, Unsigned (Exp Word64))
mulWithCarry = Exp (Word64, Word64) -> (Exp Word64, Exp Word64)
forall a b. (Elt a, Elt b) => Exp (a, b) -> (Exp a, Exp b)
untup2 (Exp (Word64, Word64) -> (Exp Word64, Exp Word64))
-> (Exp Word64 -> Exp Word64 -> Exp (Word64, Word64))
-> Exp Word64
-> Exp Word64
-> (Exp Word64, Exp Word64)
forall b a c d. (b -> a) -> (c -> d -> b) -> c -> d -> a
$$ (Exp Word64 -> Exp Word64 -> Exp (Word64, Word64))
-> Exp Word64 -> Exp Word64 -> Exp (Word64, Word64)
CPU.mulWithCarryWord64# ((Exp Word64 -> Exp Word64 -> Exp (Word64, Word64))
 -> Exp Word64 -> Exp Word64 -> Exp (Word64, Word64))
-> (Exp Word64 -> Exp Word64 -> Exp (Word64, Word64))
-> Exp Word64
-> Exp Word64
-> Exp (Word64, Word64)
forall a b. (a -> b) -> a -> b
$ (Exp Word64 -> Exp Word64 -> Exp (Word64, Word64))
-> Exp Word64 -> Exp Word64 -> Exp (Word64, Word64)
PTX.mulWithCarryWord64# Exp Word64 -> Exp Word64 -> Exp (Word64, Word64)
forall x1.
(Bits x1, Ord x1, Integral (Exp x1), FromIntegral x1 Word32,
 FromIntegral Word32 x1) =>
Exp x1 -> Exp x1 -> Exp (x1, x1)
mwc
    where
      mwc :: Exp x1 -> Exp x1 -> Exp (x1, x1)
mwc Exp x1
x Exp x1
y = Exp x1 -> Exp x1 -> Exp (x1, x1)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 Exp x1
hi Exp x1
lo
        where
          xHi :: Exp x1
xHi         = Exp x1 -> Exp Int -> Exp x1
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftR Exp x1
x Exp Int
32
          yHi :: Exp x1
yHi         = Exp x1 -> Exp Int -> Exp x1
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftR Exp x1
y Exp Int
32
          xLo :: Exp x1
xLo         = Exp x1
x Exp x1 -> Exp x1 -> Exp x1
forall a. Bits a => Exp a -> Exp a -> Exp a
.&. Exp x1
0xFFFFFFFF
          yLo :: Exp x1
yLo         = Exp x1
y Exp x1 -> Exp x1 -> Exp x1
forall a. Bits a => Exp a -> Exp a -> Exp a
.&. Exp x1
0xFFFFFFFF
          hi0 :: Exp x1
hi0         = Exp x1
xHi Exp x1 -> Exp x1 -> Exp x1
forall a. Num a => a -> a -> a
* Exp x1
yHi
          lo0 :: Exp x1
lo0         = Exp x1
xLo Exp x1 -> Exp x1 -> Exp x1
forall a. Num a => a -> a -> a
* Exp x1
yLo
          p1 :: Exp x1
p1          = Exp x1
xHi Exp x1 -> Exp x1 -> Exp x1
forall a. Num a => a -> a -> a
* Exp x1
yLo
          p2 :: Exp x1
p2          = Exp x1
xLo Exp x1 -> Exp x1 -> Exp x1
forall a. Num a => a -> a -> a
* Exp x1
yHi
          (Exp Word32
uHi1, Exp Word32
uLo) = Exp Word32 -> Exp Word32 -> (Exp Word32, Unsigned (Exp Word32))
forall w. Num2 w => w -> w -> (w, Unsigned w)
addWithCarry (Exp x1 -> Exp Word32
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp x1
p1) (Exp x1 -> Exp Word32
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp x1
p2)
          (Exp Word32
uHi2, Exp Word32
lo') = Exp Word32 -> Exp Word32 -> (Exp Word32, Unsigned (Exp Word32))
forall w. Num2 w => w -> w -> (w, Unsigned w)
addWithCarry (Exp x1 -> Exp Word32
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral (Exp x1 -> Exp Int -> Exp x1
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftR Exp x1
lo0 Exp Int
32)) Exp Word32
uLo
          hi :: Exp x1
hi          = Exp x1
hi0 Exp x1 -> Exp x1 -> Exp x1
forall a. Num a => a -> a -> a
+ Exp Word32 -> Exp x1
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral (Exp Word32
uHi1::Exp Word32) Exp x1 -> Exp x1 -> Exp x1
forall a. Num a => a -> a -> a
+ Exp Word32 -> Exp x1
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp Word32
uHi2 Exp x1 -> Exp x1 -> Exp x1
forall a. Num a => a -> a -> a
+ Exp x1 -> Exp Int -> Exp x1
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftR Exp x1
p1 Exp Int
32 Exp x1 -> Exp x1 -> Exp x1
forall a. Num a => a -> a -> a
+ Exp x1 -> Exp Int -> Exp x1
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftR Exp x1
p2 Exp Int
32
          lo :: Exp x1
lo          = Exp x1 -> Exp Int -> Exp x1
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftL (Exp Word32 -> Exp x1
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp Word32
lo') Exp Int
32 Exp x1 -> Exp x1 -> Exp x1
forall a. Bits a => Exp a -> Exp a -> Exp a
.|. (Exp x1
lo0 Exp x1 -> Exp x1 -> Exp x1
forall a. Bits a => Exp a -> Exp a -> Exp a
.&. Exp x1
0xFFFFFFFF)


defaultUnwrapped
    :: ( FiniteBits w, Bits ww, Integral w, Integral ww
       , FromIntegral w ww, FromIntegral ww w, FromIntegral ww w', Unsigned (Exp w) ~ Exp w'
       )
    => (Exp ww -> Exp ww -> Exp ww)
    -> Exp w
    -> Exp w
    -> (Exp w, Unsigned (Exp w))
defaultUnwrapped :: (Exp ww -> Exp ww -> Exp ww)
-> Exp w -> Exp w -> (Exp w, Unsigned (Exp w))
defaultUnwrapped Exp ww -> Exp ww -> Exp ww
op Exp w
x Exp w
y = (Exp w
hi, Exp w'
Unsigned (Exp w)
lo)
  where
    r :: Exp ww
r  = Exp w -> Exp ww
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp w
x Exp ww -> Exp ww -> Exp ww
`op` Exp w -> Exp ww
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp w
y
    lo :: Exp w'
lo = Exp ww -> Exp w'
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp ww
r
    hi :: Exp w
hi = Exp ww -> Exp w
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral (Exp ww
r Exp ww -> Exp Int -> Exp ww
forall a. Bits a => Exp a -> Exp Int -> Exp a
`shiftR` Exp w -> Exp Int
forall b. FiniteBits b => Exp b -> Exp Int
finiteBitSize Exp w
x)


-- Utilities
-- ---------

untup2 :: (Elt a, Elt b) => Exp (a, b) -> (Exp a, Exp b)
untup2 :: Exp (a, b) -> (Exp a, Exp b)
untup2 (T2 Exp a
a Exp b
b) = (Exp a
a, Exp b
b)

untup3 :: (Elt a, Elt b, Elt c) => Exp (a, b, c) -> (Exp a, Exp b, Exp c)
untup3 :: Exp (a, b, c) -> (Exp a, Exp b, Exp c)
untup3 (T3 Exp a
a Exp b
b Exp c
c) = (Exp a
a, Exp b
b, Exp c
c)

matchInt128 :: forall t. Elt t => Maybe (t :~: Int128)
matchInt128 :: Maybe (t :~: Int128)
matchInt128
  | Just EltR t :~: (((), Int64), Word64)
Refl <- TypeR (EltR t)
-> TypeR (((), Int64), Word64)
-> Maybe (EltR t :~: (((), Int64), Word64))
forall s t. TypeR s -> TypeR t -> Maybe (s :~: t)
matchTypeR (Elt t => TypeR (EltR t)
forall a. Elt a => TypeR (EltR a)
eltR @t) (Elt Int128 => TypeR (EltR Int128)
forall a. Elt a => TypeR (EltR a)
eltR @Int128)
  = (t :~: Int128) -> Maybe (t :~: Int128)
forall a. a -> Maybe a
Just ((Any :~: Any) -> t :~: Int128
forall a b. a -> b
unsafeCoerce Any :~: Any
forall k (a :: k). a :~: a
Refl)
  | Bool
otherwise
  = Maybe (t :~: Int128)
forall a. Maybe a
Nothing

matchWord128 :: forall t. Elt t => Maybe (t :~: Word128)
matchWord128 :: Maybe (t :~: Word128)
matchWord128
  | Just EltR t :~: (((), Word64), Word64)
Refl <- TypeR (EltR t)
-> TypeR (((), Word64), Word64)
-> Maybe (EltR t :~: (((), Word64), Word64))
forall s t. TypeR s -> TypeR t -> Maybe (s :~: t)
matchTypeR (Elt t => TypeR (EltR t)
forall a. Elt a => TypeR (EltR a)
eltR @t) (Elt Word128 => TypeR (EltR Word128)
forall a. Elt a => TypeR (EltR a)
eltR @Word128)
  = (t :~: Word128) -> Maybe (t :~: Word128)
forall a. a -> Maybe a
Just ((Any :~: Any) -> t :~: Word128
forall a b. a -> b
unsafeCoerce Any :~: Any
forall k (a :: k). a :~: a
Refl)
  | Bool
otherwise
  = Maybe (t :~: Word128)
forall a. Maybe a
Nothing


-- FromIntegral conversions
-- ------------------------

$(runQ $ do
    let
        lilNums = [ 32, 64 ]
        bigNums = [ (32,64), (64,64), (32,128), (64,128), (32,192), (128,128), (256,256) ]

        wordT :: Int -> Q Type
        wordT = return . ConT . mkName . printf "Word%d"

        intT :: Int -> Q Type
        intT = return . ConT . mkName . printf "Int%d"

        bigWordT :: (Int,Int) -> Q Type
        bigWordT (hi,lo) = wordT (hi+lo)

        bigIntT :: (Int,Int) -> Q Type
        bigIntT (hi,lo) = intT (hi+lo)

#if MIN_VERSION_accelerate(1,2,0)
        thEnum :: (Int,Int) -> Q [Dec]
        thEnum big =
          [d|
              instance P.Enum (Exp $(bigIntT big)) where
                succ x   = x + 1
                pred x   = x - 1
                toEnum   = error "Prelude.toEnum is not supported for Accelerate types"
                fromEnum = error "Prelude.fromEnum is not supported for Accelerate types"

              instance P.Enum (Exp $(bigWordT big)) where
                succ x   = x + 1
                pred x   = x - 1
                toEnum   = error "Prelude.toEnum is not supported for Accelerate types"
                fromEnum = error "Prelude.fromEnum is not supported for Accelerate types"
            |]
#endif

        thFromIntegral1 :: (Int,Int) -> Q [Dec]
        thFromIntegral1 big =
          [d|
              -- signed/unsigned bignum conversions at same width
              instance FromIntegral $(bigIntT big) $(bigIntT big) where
                fromIntegral = id

              instance FromIntegral $(bigWordT big) $(bigWordT big) where
                fromIntegral = id

              instance FromIntegral $(bigIntT big) $(bigWordT big) where
                fromIntegral (I2_ hi lo) = W2_ (fromIntegral hi) lo

              instance FromIntegral $(bigWordT big) $(bigIntT big) where
                fromIntegral (W2_ hi lo) = I2_ (fromIntegral hi) lo

              instance FromIntegral Int $(bigIntT big) where
                fromIntegral x =
#if   WORD_SIZE_IN_BITS == 32
                    fromIntegral (fromIntegral x :: Exp Int32)
#elif WORD_SIZE_IN_BITS == 64
                    fromIntegral (fromIntegral x :: Exp Int64)
#endif

              instance FromIntegral Int $(bigWordT big) where
                fromIntegral x =
#if   WORD_SIZE_IN_BITS == 32
                    fromIntegral (fromIntegral x :: Exp Int32)
#elif WORD_SIZE_IN_BITS == 64
                    fromIntegral (fromIntegral x :: Exp Int64)
#endif

              instance FromIntegral Word $(bigIntT big) where
                fromIntegral x =
#if   WORD_SIZE_IN_BITS == 32
                    fromIntegral (fromIntegral x :: Exp Word32)
#elif WORD_SIZE_IN_BITS == 64
                    fromIntegral (fromIntegral x :: Exp Word64)
#endif

              instance FromIntegral Word $(bigWordT big) where
                fromIntegral x =
#if   WORD_SIZE_IN_BITS == 32
                    fromIntegral (fromIntegral x :: Exp Word32)
#elif WORD_SIZE_IN_BITS == 64
                    fromIntegral (fromIntegral x :: Exp Word64)
#endif
            |]

        thFromIntegral2 :: (Int,Int) -> Int -> Q [Dec]
        thFromIntegral2 big little =
          [d|
              -- convert from primitive type to bignum type
              instance FromIntegral $(wordT little) $(bigWordT big) where
                fromIntegral x = W2_ 0 (fromIntegral x)

              instance FromIntegral $(wordT little) $(bigIntT big) where
                fromIntegral x = I2_ 0 (fromIntegral x)

              instance FromIntegral $(intT little) $(bigWordT big) where
                fromIntegral x@(fromIntegral -> x') =
                  if x < 0 then W2_ maxBound x'
                           else W2_ 0        x'

              instance FromIntegral $(intT little) $(bigIntT big) where
                fromIntegral x@(fromIntegral -> x') =
                  if x < 0 then I2_ (-1) x'
                           else I2_ 0    x'

              -- convert from bignum type to primitive type
              instance FromIntegral $(bigWordT big) $(wordT little) where
                fromIntegral (W2_ _ lo) = fromIntegral lo

              instance FromIntegral $(bigWordT big) $(intT little) where
                fromIntegral (W2_ _ lo) = fromIntegral lo

              instance FromIntegral $(bigIntT big) $(wordT little) where
                fromIntegral (I2_ _ lo) = fromIntegral lo

              instance FromIntegral $(bigIntT big) $(intT little) where
                fromIntegral (I2_ _ lo) = fromIntegral lo
            |]

        thToFloating :: (Int,Int) -> Q [Dec]
        thToFloating big@(_,b) =
          [d|
              instance ToFloating $(bigIntT big) Half where
                toFloating (I2_ hi lo) =
                  toFloating hi * (P.fromIntegral (maxBound :: $(wordT b)) + 1) + toFloating lo

              instance ToFloating $(bigIntT big) Float where
                toFloating (I2_ hi lo) =
                  toFloating hi * (P.fromIntegral (maxBound :: $(wordT b)) + 1) + toFloating lo

              instance ToFloating $(bigIntT big) Double where
                toFloating (I2_ hi lo) =
                  toFloating hi * (P.fromIntegral (maxBound :: $(wordT b)) + 1) + toFloating lo

              instance ToFloating $(bigWordT big) Half where
                toFloating (W2_ hi lo) =
                  toFloating hi * (P.fromIntegral (maxBound :: $(wordT b)) + 1) + toFloating lo

              instance ToFloating $(bigWordT big) Float where
                toFloating (W2_ hi lo) =
                  toFloating hi * (P.fromIntegral (maxBound :: $(wordT b)) + 1) + toFloating lo

              instance ToFloating $(bigWordT big) Double where
                toFloating (W2_ hi lo) =
                  toFloating hi * (P.fromIntegral (maxBound :: $(wordT b)) + 1) + toFloating lo
            |]
    --
#if MIN_VERSION_accelerate(1,2,0)
    e1 <- sequence [ thEnum x            | x <- bigNums ]
#else
    e1 <- return   []
#endif
    d1 <- sequence [ thFromIntegral1 x   | x <- bigNums ]
    d2 <- sequence [ thFromIntegral2 x y | x <- bigNums, y <- lilNums ]
    d3 <- sequence [ thToFloating x      | x <- bigNums ]
    --
    return $ P.concat (e1 P.++ d1 P.++ d2 P.++ d3)
 )