{-# LANGUAGE UnicodeSyntax #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}

-- | Template Haskell utilities for generating double words declarations
module Data.DoubleWord.TH
  ( mkDoubleWord
  , mkUnpackedDoubleWord
  ) where

import GHC.Arr (Ix(..))
import Data.Ratio ((%))
import Data.Bits (Bits(..))
#if MIN_VERSION_base(4,7,0)
import Data.Bits (FiniteBits(..))
#endif
import Data.Word (Word8, Word16, Word32, Word64)
import Data.Int (Int8, Int16, Int32, Int64)
#if MIN_VERSION_hashable(1,2,0)
import Data.Hashable (Hashable(..), hashWithSalt)
#else
import Data.Hashable (Hashable(..), combine)
#endif
#if !MIN_VERSION_base(4,12,0)
import Control.Applicative ((<$>), (<*>))
#endif
import Language.Haskell.TH hiding (unpacked, match, conP)
import Data.BinaryWord (BinaryWord(..))
import Data.DoubleWord.Base

tup ∷ [Exp] → Exp
#if MIN_VERSION_template_haskell(2,16,0)
tup :: [Exp] -> Exp
tup = [Maybe Exp] -> Exp
TupE ([Maybe Exp] -> Exp) -> ([Exp] -> [Maybe Exp]) -> [Exp] -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Exp -> Maybe Exp) -> [Exp] -> [Maybe Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Exp -> Maybe Exp
forall a. a -> Maybe a
Just
#else
tup = TupE
#endif

-- | Declare signed and unsigned binary word types built from
--   the specified low and high halves. The high halves /must/ have
--   less or equal bit-length than the lover half. For each data type
--   the following instances are declared: 'DoubleWord', 'Eq', 'Ord',
--   'Bounded', 'Enum', 'Num', 'Real', 'Integral', 'Show', 'Read',
--   'Hashable', 'Ix', 'Bits', 'BinaryWord'.
mkDoubleWord ∷ String -- ^ Unsigned variant type name
             → String -- ^ Unsigned variant constructor name
#if MIN_VERSION_template_haskell(2,11,0)
             → Bang   -- ^ Unsigned variant higher half strictness
#else
             → Strict -- ^ Unsigned variant higher half strictness
#endif
             → Name   -- ^ Unsigned variant higher half type
             → String -- ^ Signed variant type name
             → String -- ^ Signed variant constructor name
#if MIN_VERSION_template_haskell(2,11,0)
             → Bang   -- ^ Signed variant higher half strictness
#else
             → Strict -- ^ Signed variant higher half strictness
#endif
             → Name   -- ^ Signed variant higher half type
#if MIN_VERSION_template_haskell(2,11,0)
             → Bang   -- ^ Lower half strictness
#else
             → Strict -- ^ Lower half strictness
#endif
             → Name   -- ^ Lower half type
             → [Name] -- ^ List of instances for automatic derivation
             → Q [Dec]
mkDoubleWord :: String
-> String
-> Bang
-> Name
-> String
-> String
-> Bang
-> Name
-> Bang
-> Name
-> [Name]
-> Q [Dec]
mkDoubleWord String
un String
uc Bang
uhs Name
uhn String
sn String
sc Bang
shs Name
shn Bang
ls Name
ln [Name]
ad =
    [Dec] -> [Dec] -> [Dec]
forall a. [a] -> [a] -> [a]
(++) ([Dec] -> [Dec] -> [Dec]) -> Q [Dec] -> Q ([Dec] -> [Dec])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool
-> Name
-> Name
-> Name
-> Name
-> Bang
-> Type
-> Bang
-> Type
-> [Name]
-> Q [Dec]
mkDoubleWord' Bool
False Name
un' Name
uc' Name
sn' Name
sc' Bang
uhs (Name -> Type
ConT Name
uhn) Bang
ls Type
lt [Name]
ad
         Q ([Dec] -> [Dec]) -> Q [Dec] -> Q [Dec]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool
-> Name
-> Name
-> Name
-> Name
-> Bang
-> Type
-> Bang
-> Type
-> [Name]
-> Q [Dec]
mkDoubleWord' Bool
True  Name
sn' Name
sc' Name
un' Name
uc' Bang
shs (Name -> Type
ConT Name
shn) Bang
ls Type
lt [Name]
ad
  where un' :: Name
un' = String -> Name
mkName String
un
        uc' :: Name
uc' = String -> Name
mkName String
uc
        sn' :: Name
sn' = String -> Name
mkName String
sn
        sc' :: Name
sc' = String -> Name
mkName String
sc
        lt :: Type
lt  = Name -> Type
ConT Name
ln

-- | @'mkUnpackedDoubleWord' u uh s sh l@ is an alias for
--   @'mkDoubleWord' u u 'Unpacked' uh s s 'Unpacked' sh 'Unpacked' l@
mkUnpackedDoubleWord ∷ String -- ^ Unsigned variant type name
                     → Name   -- ^ Unsigned variant higher half type
                     → String -- ^ Signed variant type name
                     → Name   -- ^ Signed variant higher half type
                     → Name   -- ^ Lower half type
                     → [Name] -- ^ List of instances for automatic derivation
                     → Q [Dec]
mkUnpackedDoubleWord :: String -> Name -> String -> Name -> Name -> [Name] -> Q [Dec]
mkUnpackedDoubleWord String
un Name
uhn String
sn Name
shn Name
ln [Name]
ad =
    String
-> String
-> Bang
-> Name
-> String
-> String
-> Bang
-> Name
-> Bang
-> Name
-> [Name]
-> Q [Dec]
mkDoubleWord String
un String
un Bang
unpacked Name
uhn String
sn String
sn Bang
unpacked Name
shn Bang
unpacked Name
ln [Name]
ad
  where unpacked :: Bang
unpacked =
#if MIN_VERSION_template_haskell(2,11,0)
                   SourceUnpackedness -> SourceStrictness -> Bang
Bang SourceUnpackedness
SourceUnpack SourceStrictness
SourceStrict
#else
                   Unpacked
#endif

mkDoubleWord' ∷ Bool
              → Name → Name
              → Name → Name
#if MIN_VERSION_template_haskell(2,11,0)
              → Bang
#else
              → Strict
#endif
              → Type
#if MIN_VERSION_template_haskell(2,11,0)
              → Bang
#else
              → Strict
#endif
              → Type
              → [Name]
              → Q [Dec]
mkDoubleWord' :: Bool
-> Name
-> Name
-> Name
-> Name
-> Bang
-> Type
-> Bang
-> Type
-> [Name]
-> Q [Dec]
mkDoubleWord' Bool
signed Name
tp Name
cn Name
otp Name
ocn Bang
hiS Type
hiT Bang
loS Type
loT [Name]
ad = (([Dec] -> [Dec]) -> Q [Dec] -> Q [Dec]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q [Dec]
mkRules) (([Dec] -> [Dec]) -> Q [Dec]) -> ([Dec] -> [Dec]) -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ [Dec] -> [Dec] -> [Dec]
forall a. [a] -> [a] -> [a]
(++) ([Dec] -> [Dec] -> [Dec]) -> [Dec] -> [Dec] -> [Dec]
forall a b. (a -> b) -> a -> b
$
    [ Cxt
-> Name
-> [TyVarBndr]
-> Maybe Type
-> [Con]
-> [DerivClause]
-> Dec
DataD [] Name
tp []
#if MIN_VERSION_template_haskell(2,11,0)
            Maybe Type
forall a. Maybe a
Nothing
#endif
            [Name -> [BangType] -> Con
NormalC Name
cn [(Bang
hiS, Type
hiT), (Bang
loS, Type
loT)]]
#if MIN_VERSION_template_haskell(2,12,0)
            [Maybe DerivStrategy -> Cxt -> DerivClause
DerivClause Maybe DerivStrategy
forall a. Maybe a
Nothing ((Name -> Type) -> [Name] -> Cxt
forall a b. (a -> b) -> [a] -> [b]
map Name -> Type
ConT [Name]
ad)]
#elif MIN_VERSION_template_haskell(2,11,0)
            (ConT <$> ad)
#else
            ad
#endif
    , Name -> [Name] -> [Dec] -> Dec
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> [Dec] -> Dec
inst ''DoubleWord [Name
tp]
        [ Name -> Cxt -> Type -> Dec
forall (t :: * -> *). Foldable t => Name -> t Type -> Type -> Dec
tySynInst ''LoWord [Type
tpT] Type
loT
        , Name -> Cxt -> Type -> Dec
forall (t :: * -> *). Foldable t => Name -> t Type -> Type -> Dec
tySynInst ''HiWord [Type
tpT] Type
hiT
        , Name -> Exp -> Dec
funLo 'loWord (Name -> Exp
VarE Name
lo)
        , Name -> Dec
inline 'loWord
        , Name -> Exp -> Dec
funHi 'hiWord (Name -> Exp
VarE Name
hi)
        , Name -> Dec
inline 'hiWord
        , Name -> Exp -> Dec
fun 'fromHiAndLo (Name -> Exp
ConE Name
cn)
        , Name -> Dec
inline 'fromHiAndLo
        {- extendLo x = W allZeroes x -}
        , Name -> Exp -> Dec
funX 'extendLo (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ [Name] -> Exp
appWN ['allZeroes, Name
x]
        , Name -> Dec
inline 'extendLo
        {-
          signExtendLo x = W (if x < 0 then allOnes else allZeroes)
                             (unsignedWord x)
        -}
        , Name -> Exp -> Dec
funX 'signExtendLo (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
            [Exp] -> Exp
appW [ Exp -> Exp -> Exp -> Exp
CondE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'testMsb [Name
x])
                         (Name -> Exp
VarE 'allOnes) (Name -> Exp
VarE 'allZeroes)
                 , Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'unsignedWord [Name
x] ]
        , Name -> Dec
inlinable 'signExtendLo
        ]
    , Name -> [Name] -> [Dec] -> Dec
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> [Dec] -> Dec
inst ''Eq [Name
tp] ([Dec] -> Dec) -> [Dec] -> Dec
forall a b. (a -> b) -> a -> b
$
        {- (W hi lo) == (W hi' lo') = hi == hi' && lo == lo' -}
        [ Name -> Exp -> Dec
funHiLo2 '(==) (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
            Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(&&) [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(==) [Name
hi, Name
hi'], Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(==) [Name
lo, Name
lo']]
        , Name -> Dec
inline '(==) ]
    , Name -> [Name] -> [Dec] -> Dec
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> [Dec] -> Dec
inst ''Ord [Name
tp]
        {-
          compare (W hi lo) (W hi' lo') = case hi `compare` hi' of
            EQ → lo `compare` lo'
            x  → x
        -}
        [ Name -> Exp -> Dec
funHiLo2 'compare (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
            Exp -> [Match] -> Exp
CaseE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'compare [Name
hi, Name
hi'])
              [ Pat -> Body -> [Dec] -> Match
Match (Name -> [Pat] -> Pat
conP 'EQ []) (Exp -> Body
NormalB (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'compare [Name
lo, Name
lo'])) []
              , Pat -> Body -> [Dec] -> Match
Match (Name -> Pat
VarP Name
x) (Exp -> Body
NormalB (Name -> Exp
VarE Name
x)) [] ]
        , Name -> Dec
inlinable 'compare ]
    , Name -> [Name] -> [Dec] -> Dec
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> [Dec] -> Dec
inst ''Bounded [Name
tp]
        {- minBound = W minBound minBound -}
        [ Name -> Exp -> Dec
fun 'minBound (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ [Name] -> Exp
appWN ['minBound, 'minBound]
        , Name -> Dec
inline 'minBound
        {- maxBound = W maxBound maxBound -}
        , Name -> Exp -> Dec
fun 'maxBound (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ [Name] -> Exp
appWN ['maxBound, 'maxBound]
        , Name -> Dec
inline 'maxBound ]
    , Name -> [Name] -> [Dec] -> Dec
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> [Dec] -> Dec
inst ''Enum [Name
tp]
        {-
          succ (W hi lo) = if lo == maxBound then W (succ hi) minBound
                                             else W hi (succ lo)
        -}
        [ Name -> Exp -> Dec
funHiLo 'succ (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Exp -> Exp -> Exp -> Exp
CondE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(==) [Name
lo, 'maxBound])
                                ([Exp] -> Exp
appW [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'succ [Name
hi], Name -> Exp
VarE 'minBound])
                                ([Exp] -> Exp
appW [Name -> Exp
VarE Name
hi, Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'succ [Name
lo]])
        , Name -> Dec
inlinable 'succ
        {-
          pred (W hi lo) = if lo == minBound then W (pred hi) maxBound
                                             else W hi (pred lo)
        -}
        , Name -> Exp -> Dec
funHiLo 'pred (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Exp -> Exp -> Exp -> Exp
CondE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(==) [Name
lo, 'minBound])
                                ([Exp] -> Exp
appW [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'pred [Name
hi], Name -> Exp
VarE 'maxBound])
                                ([Exp] -> Exp
appW [Name -> Exp
VarE Name
hi, Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'pred [Name
lo]])
        , Name -> Dec
inlinable 'pred
        {-
          toEnum x
            | x < 0     = if signed
                          then W (-1) (negate $ 1 + toEnum (negate (x + 1)))
                          else ERROR
            | otherwise = W 0 (toEnum x)
        -}
        , Name -> Exp -> Dec
funX 'toEnum (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
            Exp -> Exp -> Exp -> Exp
CondE (Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(<) [Name -> Exp
VarE Name
x, Integer -> Exp
litI Integer
0])
                  (if Bool
signed
                   then [Exp] -> Exp
appW [ Name -> Exp
VarE 'allOnes
                             , Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'negate
                                 [ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(+)
                                     [ Exp
oneE
                                     , Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'toEnum
                                         [ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'negate
                                             [Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(+) [Name -> Exp
VarE Name
x, Integer -> Exp
litI Integer
1]] ]
                                     ]
                                 ]
                             ]
                   else Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'error [String -> Exp
litS String
"toEnum: nagative value"])
                  ([Exp] -> Exp
appW [Name -> Exp
VarE 'allZeroes, Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'toEnum [Name
x]])
        {-
          fromEnum (W 0 lo)    = fromEnum lo
          fromEnum (W (-1) lo) = if signed then negate $ fromEnum $ negate lo
                                           else ERROR
          fromEnum _           = ERROR
        -}
        , Name -> [Clause] -> Dec
FunD 'fromEnum ([Clause] -> Dec) -> [Clause] -> Dec
forall a b. (a -> b) -> a -> b
$
            [Pat] -> Body -> [Dec] -> Clause
Clause [Name -> [Pat] -> Pat
conP Name
cn [Lit -> Pat
LitP (Lit -> Pat) -> Lit -> Pat
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
IntegerL Integer
0, Name -> Pat
VarP Name
lo]]
                   (Exp -> Body
NormalB (Exp -> Body) -> Exp -> Body
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'fromEnum [Name
lo]) [] Clause -> [Clause] -> [Clause]
forall a. a -> [a] -> [a]
:
            if Bool
signed
            then [ [Pat] -> Body -> [Dec] -> Clause
Clause [Name -> [Pat] -> Pat
conP Name
cn [Lit -> Pat
LitP (Lit -> Pat) -> Lit -> Pat
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
IntegerL (-Integer
1), Name -> Pat
VarP Name
lo]]
                          (Exp -> Body
NormalB (Exp -> Body) -> Exp -> Body
forall a b. (a -> b) -> a -> b
$
                             Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'negate
                               [Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'fromEnum [Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'negate [Name -> Exp
VarE Name
lo]]])
                          []
                 , [Pat] -> Body -> [Dec] -> Clause
Clause [Pat
WildP]
                          (Exp -> Body
NormalB (Exp -> Body) -> Exp -> Body
forall a b. (a -> b) -> a -> b
$
                             Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'error [String -> Exp
litS String
"fromEnum: out of bounds"])
                          []
                 ]
            else [ [Pat] -> Body -> [Dec] -> Clause
Clause [Pat
WildP]
                          (Exp -> Body
NormalB (Exp -> Body) -> Exp -> Body
forall a b. (a -> b) -> a -> b
$
                             Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'error [String -> Exp
litS String
"fromEnum: out of bounds"])
                          [] ]
        {- enumFrom x = enumFromTo x maxBound -}
        , Name -> Exp -> Dec
funX 'enumFrom (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'enumFromTo [Name
x, 'maxBound]
        , Name -> Dec
inline 'enumFrom
        {-
          enumFromThen x y =
            enumFromThenTo x y $ if y >= x then maxBound else minBound
        -}
        , Name -> Exp -> Dec
funXY 'enumFromThen (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
            Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'enumFromThenTo
              [ Name -> Exp
VarE Name
x
              , Name -> Exp
VarE Name
y
              , Exp -> Exp -> Exp -> Exp
CondE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(>=) [Name
y, Name
x]) (Name -> Exp
VarE 'maxBound) (Name -> Exp
VarE 'minBound)
              ]
        , Name -> Dec
inlinable 'enumFromThen
        {-
          enumFromTo x y = case y `compare` x of
              LT → []
              EQ → [x]
              GT → x : up y x
            where up to c = next : if next == to then [] else up to next
                    where next = c + 1
        -}
        , Name -> [Clause] -> Dec
FunD 'enumFromTo ([Clause] -> Dec) -> [Clause] -> Dec
forall a b. (a -> b) -> a -> b
$ Clause -> [Clause]
forall (m :: * -> *) a. Monad m => a -> m a
return (Clause -> [Clause]) -> Clause -> [Clause]
forall a b. (a -> b) -> a -> b
$
            [Pat] -> Body -> [Dec] -> Clause
Clause
              [Name -> Pat
VarP Name
x, Name -> Pat
VarP Name
y]
              (Exp -> Body
NormalB (Exp -> Body) -> Exp -> Body
forall a b. (a -> b) -> a -> b
$
                 Exp -> [Match] -> Exp
CaseE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'compare [Name
y, Name
x])
                   [ Pat -> Exp -> Match
match (Name -> [Pat] -> Pat
conP 'LT []) (Name -> Exp
ConE '[])
                   , Pat -> Exp -> Match
match (Name -> [Pat] -> Pat
conP 'EQ []) (Exp -> Exp
singE (Exp -> Exp) -> Exp -> Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE Name
x)
                   , Pat -> Exp -> Match
match (Name -> [Pat] -> Pat
conP 'GT []) (Exp -> Match) -> Exp -> Match
forall a b. (a -> b) -> a -> b
$ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appC '(:) [Name -> Exp
VarE Name
x, Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN Name
up [Name
y, Name
x]]
                   ])
              [ Name -> [Clause] -> Dec
FunD Name
up ([Clause] -> Dec) -> [Clause] -> Dec
forall a b. (a -> b) -> a -> b
$ Clause -> [Clause]
forall (m :: * -> *) a. Monad m => a -> m a
return (Clause -> [Clause]) -> Clause -> [Clause]
forall a b. (a -> b) -> a -> b
$
                  [Pat] -> Body -> [Dec] -> Clause
Clause [Name -> Pat
VarP Name
to, Name -> Pat
VarP Name
c]
                    (Exp -> Body
NormalB (Exp -> Body) -> Exp -> Body
forall a b. (a -> b) -> a -> b
$
                       Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appC '(:)
                         [ Name -> Exp
VarE Name
next
                         , Exp -> Exp -> Exp -> Exp
CondE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(==) [Name
next, Name
to])
                                 (Name -> Exp
ConE '[]) (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN Name
up [Name
to, Name
next])
                         ])
                    [Name -> Exp -> Dec
val Name
next (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(+) [Name
c, 'lsb]]
              ]
        {-
          enumFromThenTo x y z = case y `compare` x of
              LT → if z > y then (if z > x then [] else [x])
                            else x : down step (z + step) y
                where step = x - y
                      to = z + step
                      down c | c < to    = [c]
                             | otherwise = c : down (c - step)
              EQ → if z < x then [] else repeat x
              GT → if z < y then (if z < x then [] else [x])
                            else x : up step (z - step) y
                where step = y - x
                      to = z - step
                      up c | c > to    = [c]
                           | otherwise = c : up (c + step)
        -}
        , Name -> [Clause] -> Dec
FunD 'enumFromThenTo ([Clause] -> Dec) -> [Clause] -> Dec
forall a b. (a -> b) -> a -> b
$ Clause -> [Clause]
forall (m :: * -> *) a. Monad m => a -> m a
return (Clause -> [Clause]) -> Clause -> [Clause]
forall a b. (a -> b) -> a -> b
$
            [Pat] -> Body -> [Dec] -> Clause
Clause [Name -> Pat
VarP Name
x, Name -> Pat
VarP Name
y, Name -> Pat
VarP Name
z]
              (Exp -> Body
NormalB (Exp -> Body) -> Exp -> Body
forall a b. (a -> b) -> a -> b
$
                Exp -> [Match] -> Exp
CaseE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'compare [Name
y, Name
x])
                  [ Pat -> Exp -> [Dec] -> Match
match'
                      (Name -> [Pat] -> Pat
conP 'LT [])
                      (Exp -> Exp -> Exp -> Exp
CondE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(>) [Name
z, Name
y])
                             (Exp -> Exp -> Exp -> Exp
CondE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(>) [Name
z, Name
x])
                                    (Name -> Exp
ConE '[]) (Exp -> Exp
singE (Exp -> Exp) -> Exp -> Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE Name
x))
                             (Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appC '(:) [Name -> Exp
VarE Name
x, Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN Name
down [Name
y]]))
                      [ Name -> Exp -> Dec
val Name
step (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(-) [Name
x, Name
y]
                      , Name -> Exp -> Dec
val Name
to (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(+) [Name
z, Name
step]
                      , Name -> Name -> Exp -> Dec
fun1 Name
down Name
c (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
                          Exp -> Exp -> Exp -> Exp
CondE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(<) [Name
c, Name
to])
                                (Exp -> Exp
singE (Exp -> Exp) -> Exp -> Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE Name
c)
                                (Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appC '(:)
                                      [ Name -> Exp
VarE Name
c
                                      , Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV Name
down [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(-) [Name
c, Name
step]]
                                      ])
                      ]
                  , Pat -> Exp -> Match
match
                      (Name -> [Pat] -> Pat
conP 'EQ [])
                      (Exp -> Exp -> Exp -> Exp
CondE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(<) [Name
z, Name
x])
                             (Name -> Exp
ConE '[]) (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'repeat [Name
x]))
                  , Pat -> Exp -> [Dec] -> Match
match'
                      (Name -> [Pat] -> Pat
conP 'GT [])
                      (Exp -> Exp -> Exp -> Exp
CondE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(<) [Name
z, Name
y])
                             (Exp -> Exp -> Exp -> Exp
CondE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(<) [Name
z, Name
x])
                                    (Name -> Exp
ConE '[]) (Exp -> Exp
singE (Exp -> Exp) -> Exp -> Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE Name
x))
                             (Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appC '(:) [Name -> Exp
VarE Name
x, Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN Name
up [Name
y]]))
                      [ Name -> Exp -> Dec
val Name
step (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(-) [Name
y, Name
x]
                      , Name -> Exp -> Dec
val Name
to (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(-) [Name
z, Name
step]
                      , Name -> Name -> Exp -> Dec
fun1 Name
up Name
c (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
                          Exp -> Exp -> Exp -> Exp
CondE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(>) [Name
c, Name
to])
                                (Exp -> Exp
singE (Exp -> Exp) -> Exp -> Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE Name
c)
                                (Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appC '(:)
                                      [ Name -> Exp
VarE Name
c
                                      , Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV Name
up [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(+) [Name
c, Name
step]]
                                      ])
                      ]
                  ])
              []
        ]
    , Name -> [Name] -> [Dec] -> Dec
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> [Dec] -> Dec
inst ''Num [Name
tp]
        {-
          negate (W hi lo) = if lo == 0 then W (negate hi) 0
                                        else W (negate $ hi + 1) (negate lo)
        -}
        [ Name -> Exp -> Dec
funHiLo 'negate (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
            Exp -> Exp -> Exp -> Exp
CondE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(==) [Name
lo, 'allZeroes])
                  ([Exp] -> Exp
appW [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'negate [Name
hi], Exp
zeroE])
                  ([Exp] -> Exp
appW [ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'negate [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(+) ['lsb, Name
hi]]
                        , Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'negate [Name
lo] ])
        , Name -> Dec
inlinable 'negate
        {-
          abs x = if SIGNED
                  then if x < 0 then negate x else x
                  else x
        -}
        , Name -> Exp -> Dec
funX 'abs (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
            if Bool
signed
            then Exp -> Exp -> Exp -> Exp
CondE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(<) [Name
x, 'allZeroes])
                       (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'negate [Name
x]) (Name -> Exp
VarE Name
x)
            else Name -> Exp
VarE Name
x
        , if Bool
signed then Name -> Dec
inlinable 'abs else Name -> Dec
inline 'abs
        {-
          signum (W hi lo) = if SIGNED
                             then case hi `compare` 0 of
                               LT → W (-1) maxBound
                               EQ → if lo == 0 then 0 else 1
                               GT → W 0 1
                             else if hi == 0 && lo == 0 then 0 else 1
        -}
        , Name -> Exp -> Dec
funHiLo 'signum (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
            if Bool
signed
            then Exp -> [Match] -> Exp
CaseE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'compare [Name
hi, 'allZeroes])
                   [ Pat -> Body -> [Dec] -> Match
Match (Name -> [Pat] -> Pat
conP 'LT [])
                           (Exp -> Body
NormalB (Exp -> Body) -> Exp -> Body
forall a b. (a -> b) -> a -> b
$ [Name] -> Exp
appWN ['allOnes, 'maxBound]) []
                   , Pat -> Body -> [Dec] -> Match
Match (Name -> [Pat] -> Pat
conP 'EQ [])
                           (Exp -> Body
NormalB (Exp -> Body) -> Exp -> Body
forall a b. (a -> b) -> a -> b
$ Exp -> Exp -> Exp -> Exp
CondE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(==) [Name
lo, 'allZeroes])
                                            Exp
zeroE Exp
oneE)
                           []
                   , Pat -> Body -> [Dec] -> Match
Match (Name -> [Pat] -> Pat
conP 'GT []) (Exp -> Body
NormalB Exp
oneE) []
                   ]
            else Exp -> Exp -> Exp -> Exp
CondE (Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(&&) [ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(==) [Name
hi, 'allZeroes]
                                   , Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(==) [Name
lo, 'allZeroes] ])
                       Exp
zeroE Exp
oneE
        , Name -> Dec
inlinable 'signum
        {-
          (W hi lo) + (W hi' lo') = W y x
            where x = lo + lo'
                  y = hi + hi' + if x < lo then 1 else 0
        -}
        , Name -> Exp -> [Dec] -> Dec
funHiLo2' '(+) ([Name] -> Exp
appWN [Name
y, Name
x])
            [ Name -> Exp -> Dec
val Name
x (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(+) [Name
lo, Name
lo']
            , Name -> Exp -> Dec
val Name
y (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(+)
                        [ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(+) [Name
hi, Name
hi']
                        , Exp -> Exp -> Exp -> Exp
CondE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(<) [Name
x, Name
lo]) Exp
oneE Exp
zeroE ]
            ]
        , Name -> Dec
inlinable '(+)
        {-
          UNSIGNED:
            (W hi lo) * (W hi' lo') =
                W (hi * fromIntegral lo' + hi' * fromIntegral lo +
                   fromIntegral x) y
              where (x, y) = unwrappedMul lo lo'

          SIGNED:
            x * y = signedWord $ unsignedWord x * unsignedWord y
        -}
        , if Bool
signed
          then
            Name -> Exp -> Dec
funXY '(*) (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
              Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'signedWord
                   [Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(*) [ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'unsignedWord [Name
x]
                              , Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'unsignedWord [Name
y] ]]
          else
            Name -> Exp -> [Dec] -> Dec
funHiLo2' '(*)
              ([Exp] -> Exp
appW [ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(+)
                        [ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(+)
                            [ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(*) [Name -> Exp
VarE Name
hi, Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'fromIntegral [Name
lo']]
                            , Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(*) [Name -> Exp
VarE Name
hi', Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'fromIntegral [Name
lo]] ]
                        , Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'fromIntegral [Name
x] ]
                    , Name -> Exp
VarE Name
y ])
              [[Name] -> Exp -> Dec
vals [Name
x, Name
y] (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'unwrappedMul [Name
lo, Name
lo'])]
        , Name -> Dec
inlinable '(*)
        {-
          fromInteger x = W (fromInteger y) (fromInteger z)
            where (y, z) = x `divMod` (toInteger (maxBound ∷ L) + 1)
        -}
        , Name -> Exp -> [Dec] -> Dec
funX' 'fromInteger
            ([Exp] -> Exp
appW [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'fromInteger [Name
y], Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'fromInteger [Name
z]])
            [[Name] -> Exp -> Dec
vals [Name
y, Name
z]
               (Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'divMod
                  [ Name -> Exp
VarE Name
x
                  , Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(+)
                      [Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'toInteger [Exp -> Type -> Exp
SigE (Name -> Exp
VarE 'maxBound) Type
loT], Integer -> Exp
litI Integer
1]
                  ])]
        ]
    , Name -> [Name] -> [Dec] -> Dec
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> [Dec] -> Dec
inst ''Real [Name
tp]
        {- toRational x = toInteger x % 1 -}
        [ Name -> Exp -> Dec
funX 'toRational (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(%) [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'toInteger [Name
x], Integer -> Exp
litI Integer
1]
        , Name -> Dec
inline 'toRational ]
    , Name -> [Name] -> [Dec] -> Dec
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> [Dec] -> Dec
inst ''Integral [Name
tp] ([Dec] -> Dec) -> [Dec] -> Dec
forall a b. (a -> b) -> a -> b
$
        {-
          toInteger (W hi lo) =
            toInteger hi * (toInteger (maxBound ∷ L) + 1) + toInteger lo
        -}
        [ Name -> Exp -> Dec
funHiLo 'toInteger (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
            Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(+)
              [ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(*)
                  [ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'toInteger [Name
hi]
                  , Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(+)
                      [Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'toInteger [Exp -> Type -> Exp
SigE (Name -> Exp
VarE 'maxBound) Type
loT], Integer -> Exp
litI Integer
1] ]
              , Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'toInteger [Name
lo] ]
        {-
          UNSIGNED:
            quotRem x@(W hi lo) y@(W hi' lo') =
                if hi' == 0 && lo' == 0
                then error "divide by zero"
                else case compare hi hi' of
                  LT → (0, x)
                  EQ → compare lo lo' of
                    LT → (0, x)
                    EQ → (1, 0)
                    GT | hi' == 0 → (W 0 t2, W 0 t1)
                      where (t2, t1) = quotRem lo lo'
                    GT → (1, lo - lo')
                  GT | lo' == 0 → (W 0 (fromIntegral t2),
                                   W (fromIntegral t1) lo)
                    where (t2, t1) = quotRem hi hi'
                  GT | hi' == 0 && lo' == maxBound →
                      if t2 == 0
                      then if t1 == maxBound
                           then (W 0 z + 1, 0)
                           else (W 0 z, t1)
                      else if t1 == maxBound
                           then (W 0 z + 2, 1)
                           else if t1 == xor maxBound 1
                                then (W 0 z + 2, 0)
                                else (W 0 z + 1, W 0 (t1 + 1))
                    where z = fromIntegral hi
                          (t2, t1) = unwrappedAdd z lo
                  GT | hi' == 0 → (t2, W 0 t1)
                    where (t2, t1) = div1 hi lo lo'
                  GT → if t1 == t2
                       then (1, x - y)
                       else (W 0 (fromIntegral q2), shiftR r2 t2)
                    where t1 = leadingZeroes hi
                          t2 = leadingZeroes hi'
                          z = shiftR hi (bitSize (undefined ∷ H) - t2)
                          W hhh hll = shiftL x t2
                          v@(W lhh lll) = shiftL y t2
                          -- z hhh hll / lhh lll
                          ((0, q1), r1) = div2 z hhh lhh
                          (t4, t3) = unwrappedMul (fromIntegral q1) lll
                          t5 = W (fromIntegral t4) t3
                          t6 = W r1 hll
                          (t8, t7) = unwrappedAdd t6 v
                          (t10, t9) = unwrappedAdd t7 v
                          (q2, r2) =
                            if t5 > t6
                            then
                              if loWord t8 == 0
                              then
                                if t7 >= t5
                                then (q1 - 1, t7 - t5)
                                else
                                  if loWord t10 == 0
                                  then (q1 - 2, t9 - t5)
                                  else (q1 - 2, (maxBound - t5) + t9 + 1)
                              else
                                (q1 - 1, (maxBound - t5) + t7 + 1)
                            else
                              (q1, t6 - t5)
            where div1 hhh hll by = go hhh hll 0
                    where (t2, t1) = quotRem maxBound by
                          go h l c =
                              if z == 0
                              then (c + W (fromIntegral t8) t7 + W 0 t10, t9)
                              else go (fromIntegral z) t5
                                      (c + (W (fromIntegral t8) t7))
                            where h1 = fromIntegral h
                                  (t4, t3) = unwrappedMul h1 (t1 + 1)
                                  (t6, t5) = unwrappedAdd t3 l
                                  z = t4 + t6
                                  (t8, t7) = unwrappedMul h1 t2
                                  (t10, t9) = quotRem t5 by
                  div2 hhh hll by = go hhh hll (0, 0)
                    where (t2, t1) = quotRem maxBound by
                          go h l c =
                              if z == 0
                              then (addT (addT c (t8, t7)) (0, t10), t9)
                              else go z t5 (addT c (t8, t7))
                            where (t4, t3) = unwrappedMul h (t1 + 1)
                                  (t6, t5) = unwrappedAdd t3 l
                                  z = t4 + t6
                                  (t8, t7) = unwrappedMul h t2
                                  (t10, t9) = quotRem t5 by
                          addT (lhh, lhl) (llh, lll) = (lhh + llh + t4, t3)
                            where (t4, t3) = unwrappedAdd lhl lll

          SIGNED:
            quotRem x y =
              if x < 0
              then
                if y < 0
                then let (q, r) = quotRem (negate $ unsignedWord x)
                                          (negate $ unsignedWord y) in
                       (signedWord q, signedWord $ negate r)
                else let (q, r) = quotRem (negate $ unsignedWord x)
                                          (unsignedWord y) in
                       (signedWord $ negate q, signedWord $ negate r)
              else
                if y < 0
                then let (q, r) = quotRem (unsignedWord x)
                                          (negate $ unsignedWord y) in
                       (signedWord $ negate q, signedWord r)
                else let (q, r) = quotRem (unsignedWord x)
                                          (unsignedWord y) in
                       (signedWord q, signedWord r)
        -}
        , if Bool
signed
          then
            Name -> Exp -> Dec
funXY 'quotRem (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
              Exp -> Exp -> Exp -> Exp
CondE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'testMsb [Name
x])
                (Exp -> Exp -> Exp -> Exp
CondE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'testMsb [Name
y])
                   ([Dec] -> Exp -> Exp
LetE [[Name] -> Exp -> Dec
vals [Name
q, Name
r] (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
                            Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'quotRem
                              [ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'unsignedWord [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'negate [Name
x]]
                              , Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'unsignedWord [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'negate [Name
y]] ]]
                      ([Exp] -> Exp
tup [ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'signedWord [Name
q]
                            , Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'signedWord [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'negate [Name
r]] ]))
                   ([Dec] -> Exp -> Exp
LetE [[Name] -> Exp -> Dec
vals [Name
q, Name
r] (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
                            Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'quotRem
                              [ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'unsignedWord [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'negate [Name
x]]
                              , Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'unsignedWord [Name
y] ]]
                      ([Exp] -> Exp
tup [ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'signedWord [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'negate [Name
q]]
                            , Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'signedWord [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'negate [Name
r]] ])))
                (Exp -> Exp -> Exp -> Exp
CondE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'testMsb [Name
y])
                   ([Dec] -> Exp -> Exp
LetE [[Name] -> Exp -> Dec
vals [Name
q, Name
r] (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
                            Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'quotRem
                              [ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'unsignedWord [Name
x]
                              , Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'unsignedWord [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'negate [Name
y]] ]]
                      ([Exp] -> Exp
tup [ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'signedWord [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'negate [Name
q]]
                            , Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'signedWord [Name
r] ]))
                   ([Dec] -> Exp -> Exp
LetE [[Name] -> Exp -> Dec
vals [Name
q, Name
r] (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
                            Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'quotRem
                              [ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'unsignedWord [Name
x]
                              , Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'unsignedWord [Name
y] ]]
                      ([Exp] -> Exp
tup [ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'signedWord [Name
q]
                            , Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'signedWord [Name
r] ])))
          else
            Name -> Exp -> [Dec] -> Dec
funHiLo2XY' 'quotRem
              (Exp -> Exp -> Exp -> Exp
CondE (Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(&&) [ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(==) [Name
hi', 'allZeroes]
                                 , Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(==) [Name
lo', 'allZeroes] ])
                 (Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'error [String -> Exp
litS String
"divide by zero"])
                 (Exp -> [Match] -> Exp
CaseE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'compare [Name
hi, Name
hi'])
                    [ Pat -> Exp -> Match
match (Name -> [Pat] -> Pat
conP 'LT []) ([Exp] -> Exp
tup [Exp
zeroE, Name -> Exp
VarE Name
x])
                    , Pat -> Exp -> Match
match (Name -> [Pat] -> Pat
conP 'EQ [])
                        (Exp -> [Match] -> Exp
CaseE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'compare [Name
lo, Name
lo'])
                           [ Pat -> Exp -> Match
match (Name -> [Pat] -> Pat
conP 'LT []) ([Exp] -> Exp
tup [Exp
zeroE, Name -> Exp
VarE Name
x])
                           , Pat -> Exp -> Match
match (Name -> [Pat] -> Pat
conP 'EQ []) ([Exp] -> Exp
tup [Exp
oneE, Exp
zeroE])
                           , Pat -> Body -> [Dec] -> Match
Match (Name -> [Pat] -> Pat
conP 'GT [])
                               ([(Guard, Exp)] -> Body
GuardedB ([(Guard, Exp)] -> Body) -> [(Guard, Exp)] -> Body
forall a b. (a -> b) -> a -> b
$ (Guard, Exp) -> [(Guard, Exp)]
forall (m :: * -> *) a. Monad m => a -> m a
return
                                  ( Exp -> Guard
NormalG (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(==) [Name
hi', 'allZeroes])
                                  , [Exp] -> Exp
tup [ [Name] -> Exp
appWN ['allZeroes, Name
t2]
                                         , [Name] -> Exp
appWN ['allZeroes, Name
t1] ]))
                               [[Name] -> Exp -> Dec
vals [Name
t2, Name
t1] (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'quotRem [Name
lo, Name
lo']]
                           , Pat -> Exp -> Match
match (Name -> [Pat] -> Pat
conP 'GT []) (Exp -> Match) -> Exp -> Match
forall a b. (a -> b) -> a -> b
$
                               [Exp] -> Exp
tup [ Exp
oneE
                                    , [Exp] -> Exp
appW [Exp
zeroE, Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(-) [Name
lo, Name
lo']] ]
                           ])
                    , Pat -> Body -> [Dec] -> Match
Match (Name -> [Pat] -> Pat
conP 'GT [])
                        ([(Guard, Exp)] -> Body
GuardedB ([(Guard, Exp)] -> Body) -> [(Guard, Exp)] -> Body
forall a b. (a -> b) -> a -> b
$ (Guard, Exp) -> [(Guard, Exp)]
forall (m :: * -> *) a. Monad m => a -> m a
return
                           ( Exp -> Guard
NormalG (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(==) [Name
lo', 'allZeroes])
                           , [Exp] -> Exp
tup
                               [ [Exp] -> Exp
appW [Exp
zeroE, Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'fromIntegral [Name
t2]]
                               , [Exp] -> Exp
appW [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'fromIntegral [Name
t1], Name -> Exp
VarE Name
lo]
                               ] ))
                        [[Name] -> Exp -> Dec
vals [Name
t2, Name
t1] (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'quotRem [Name
hi, Name
hi']]
                    , Pat -> Body -> [Dec] -> Match
Match (Name -> [Pat] -> Pat
conP 'GT [])
                        ([(Guard, Exp)] -> Body
GuardedB ([(Guard, Exp)] -> Body) -> [(Guard, Exp)] -> Body
forall a b. (a -> b) -> a -> b
$ (Guard, Exp) -> [(Guard, Exp)]
forall (m :: * -> *) a. Monad m => a -> m a
return
                           ( Exp -> Guard
NormalG (Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(&&)
                                        [ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(==) [Name
hi', 'allZeroes]
                                        , Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(==) [Name
lo', 'maxBound] ])
                           , Exp -> Exp -> Exp -> Exp
CondE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(==) [Name
t2, 'allZeroes])
                               (Exp -> Exp -> Exp -> Exp
CondE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(==) [Name
t1, 'maxBound])
                                  ([Exp] -> Exp
tup
                                     [ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(+)
                                         [ [Name] -> Exp
appWN ['allZeroes, Name
z]
                                         , Exp
oneE ]
                                     , Exp
zeroE ])
                                  ([Exp] -> Exp
tup
                                     [ [Name] -> Exp
appWN ['allZeroes, Name
z]
                                     , [Name] -> Exp
appWN ['allZeroes, Name
t1] ]))
                               (Exp -> Exp -> Exp -> Exp
CondE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(==) [Name
t1, 'maxBound])
                                  ([Exp] -> Exp
tup
                                     [ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(+)
                                         [[Name] -> Exp
appWN ['allZeroes, Name
z], Integer -> Exp
litI Integer
2]
                                     , Exp
oneE ])
                                  (Exp -> Exp -> Exp -> Exp
CondE
                                     (Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(==)
                                        [ Name -> Exp
VarE Name
t1
                                        , Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'xor ['maxBound, 'lsb]
                                        ])
                                     ([Exp] -> Exp
tup
                                        [ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(+)
                                            [[Name] -> Exp
appWN ['allZeroes, Name
z], Integer -> Exp
litI Integer
2]
                                        , Exp
zeroE ])
                                     ([Exp] -> Exp
tup
                                        [ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(+)
                                            [[Name] -> Exp
appWN ['allZeroes, Name
z], Exp
oneE]
                                        , [Exp] -> Exp
appW [ Exp
zeroE
                                               , Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(+) [Name
t1, 'lsb] ]
                                        ])))
                           ))
                        [ Name -> Exp -> Dec
val Name
z (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'fromIntegral [Name
hi]
                        , [Name] -> Exp -> Dec
vals [Name
t2, Name
t1] (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'unwrappedAdd [Name
z, Name
lo] ]
                    , Pat -> Body -> [Dec] -> Match
Match (Name -> [Pat] -> Pat
conP 'GT [])
                        ([(Guard, Exp)] -> Body
GuardedB ([(Guard, Exp)] -> Body) -> [(Guard, Exp)] -> Body
forall a b. (a -> b) -> a -> b
$ (Guard, Exp) -> [(Guard, Exp)]
forall (m :: * -> *) a. Monad m => a -> m a
return
                           ( Exp -> Guard
NormalG (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(==) [Name
hi', 'allZeroes])
                           , [Exp] -> Exp
tup [Name -> Exp
VarE Name
t2, [Name] -> Exp
appWN ['allZeroes, Name
t1]] ))
                        [[Name] -> Exp -> Dec
vals [Name
t2, Name
t1] (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN Name
div1 [Name
hi, Name
lo, Name
lo']]
                    , Pat -> Exp -> [Dec] -> Match
match' (Name -> [Pat] -> Pat
conP 'GT [])
                        (Exp -> Exp -> Exp -> Exp
CondE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(==) [Name
t1, Name
t2])
                               ([Exp] -> Exp
tup [Exp
oneE, Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(-) [Name
x, Name
y]])
                               ([Exp] -> Exp
tup [ [Exp] -> Exp
appW [Exp
zeroE, Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'fromIntegral [Name
q2]]
                                     , Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'shiftR [Name
r2, Name
t2] ]))
                        [ Name -> Exp -> Dec
val Name
t1 (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'leadingZeroes [Name
hi]
                        , Name -> Exp -> Dec
val Name
t2 (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'leadingZeroes [Name
hi']
                        , Name -> Exp -> Dec
val Name
z (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'shiftR
                                    [ Name -> Exp
VarE Name
hi
                                    , Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(-) [Exp
hiSizeE, Name -> Exp
VarE Name
t2]
                                    ]
                        , Pat -> Body -> [Dec] -> Dec
ValD (Name -> [Pat] -> Pat
conP Name
cn [Name -> Pat
VarP Name
hhh, Name -> Pat
VarP Name
hll])
                            (Exp -> Body
NormalB (Exp -> Body) -> Exp -> Body
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'shiftL [Name
x, Name
t2]) []
                        , Pat -> Body -> [Dec] -> Dec
ValD (Name -> Pat -> Pat
AsP Name
v (Pat -> Pat) -> Pat -> Pat
forall a b. (a -> b) -> a -> b
$ Name -> [Pat] -> Pat
conP Name
cn [Name -> Pat
VarP Name
lhh, Name -> Pat
VarP Name
lll])
                            (Exp -> Body
NormalB (Exp -> Body) -> Exp -> Body
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'shiftL [Name
y, Name
t2]) []
                        , Pat -> Body -> [Dec] -> Dec
ValD ([Pat] -> Pat
TupP [ [Pat] -> Pat
TupP [Lit -> Pat
LitP (Integer -> Lit
IntegerL Integer
0), Name -> Pat
VarP Name
q1]
                                     , Name -> Pat
VarP Name
r1 ])
                            (Exp -> Body
NormalB (Exp -> Body) -> Exp -> Body
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN Name
div2 [Name
z, Name
hhh, Name
lhh]) []
                        , [Name] -> Exp -> Dec
vals [Name
t4, Name
t3] (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
                            Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'unwrappedMul
                              [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'fromIntegral [Name
q1], Name -> Exp
VarE Name
lll]
                        , Name -> Exp -> Dec
val Name
t5 (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ [Exp] -> Exp
appW [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'fromIntegral [Name
t4], Name -> Exp
VarE Name
t3]
                        , Name -> Exp -> Dec
val Name
t6 (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ [Name] -> Exp
appWN [Name
r1, Name
hll]
                        , [Name] -> Exp -> Dec
vals [Name
t8, Name
t7] (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'unwrappedAdd [Name
t6, Name
v]
                        , [Name] -> Exp -> Dec
vals [Name
t10, Name
t9] (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'unwrappedAdd [Name
t7, Name
v]
                        , [Name] -> Exp -> Dec
vals [Name
q2, Name
r2] (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
                            Exp -> Exp -> Exp -> Exp
CondE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(>) [Name
t5, Name
t6])
                              (Exp -> Exp -> Exp -> Exp
CondE (Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(==) [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'loWord [Name
t8], Exp
zeroE])
                                 (Exp -> Exp -> Exp -> Exp
CondE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(>=) [Name
t7, Name
t5])
                                    ([Exp] -> Exp
tup [ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(-) [Name
q1, 'lsb]
                                          , Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(-) [Name
t7, Name
t5] ])
                                    (Exp -> Exp -> Exp -> Exp
CondE (Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(==) [ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'loWord [Name
t10]
                                                       , Exp
zeroE ])
                                       ([Exp] -> Exp
tup [ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(-) [Name -> Exp
VarE Name
q1, Integer -> Exp
litI Integer
2]
                                             , Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(-) [Name
t9, Name
t5] ])
                                       ([Exp] -> Exp
tup [ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(-) [Name -> Exp
VarE Name
q1, Integer -> Exp
litI Integer
2]
                                             , Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(+)
                                                 [ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(-) ['maxBound, Name
t5]
                                                 , Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(+) [Name
t9, 'lsb]
                                                 ]
                                             ])))
                                 ([Exp] -> Exp
tup [ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(-) [Name
q1, 'lsb]
                                       , Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(+)
                                           [ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(-) ['maxBound, Name
t5]
                                           , Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(+) [Name
t7, 'lsb] ]
                                       ]))
                              ([Exp] -> Exp
tup [Name -> Exp
VarE Name
q1, Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(-) [Name
t6, Name
t5]])
                        ]
                    ]))
              [ Name -> [Clause] -> Dec
FunD Name
div1 ([Clause] -> Dec) -> [Clause] -> Dec
forall a b. (a -> b) -> a -> b
$ Clause -> [Clause]
forall (m :: * -> *) a. Monad m => a -> m a
return (Clause -> [Clause]) -> Clause -> [Clause]
forall a b. (a -> b) -> a -> b
$
                  [Pat] -> Body -> [Dec] -> Clause
Clause [Name -> Pat
VarP Name
hhh, Name -> Pat
VarP Name
hll, Name -> Pat
VarP Name
by]
                    (Exp -> Body
NormalB (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN Name
go [Name
hhh, Name
hll, 'allZeroes]))
                    [ [Name] -> Exp -> Dec
vals [Name
t2, Name
t1] (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'quotRem ['maxBound, Name
by]
                    , Name -> [Clause] -> Dec
FunD Name
go ([Clause] -> Dec) -> [Clause] -> Dec
forall a b. (a -> b) -> a -> b
$ Clause -> [Clause]
forall (m :: * -> *) a. Monad m => a -> m a
return (Clause -> [Clause]) -> Clause -> [Clause]
forall a b. (a -> b) -> a -> b
$
                        [Pat] -> Body -> [Dec] -> Clause
Clause [Name -> Pat
VarP Name
h, Name -> Pat
VarP Name
l, Name -> Pat
VarP Name
c]
                          (Exp -> Body
NormalB
                             (Exp -> Exp -> Exp -> Exp
CondE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(==) [Name
z, 'allZeroes])
                                ([Exp] -> Exp
tup [ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(+)
                                          [ Name -> Exp
VarE Name
c
                                          , Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(+)
                                              [ [Exp] -> Exp
appW [ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'fromIntegral [Name
t8]
                                                     , Name -> Exp
VarE Name
t7 ]
                                              , [Name] -> Exp
appWN ['allZeroes, Name
t10] ]
                                          ]
                                      , Name -> Exp
VarE Name
t9 ])
                                (Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV Name
go
                                   [ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'fromIntegral [Name
z]
                                   , Name -> Exp
VarE Name
t5
                                   , Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(+)
                                       [ Name -> Exp
VarE Name
c
                                       , [Exp] -> Exp
appW [ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'fromIntegral [Name
t8]
                                              , Name -> Exp
VarE Name
t7 ]
                                       ]
                                   ])))
                          [ Name -> Exp -> Dec
val Name
h1 (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'fromIntegral [Name
h]
                          , [Name] -> Exp -> Dec
vals [Name
t4, Name
t3] (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
                              Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'unwrappedMul
                                [Name -> Exp
VarE Name
h1, Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(+) [Name
t1, 'lsb]]
                          , [Name] -> Exp -> Dec
vals [Name
t6, Name
t5] (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'unwrappedAdd [Name
t3, Name
l]
                          , Name -> Exp -> Dec
val Name
z (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(+) [Name
t4, Name
t6]
                          , [Name] -> Exp -> Dec
vals [Name
t8, Name
t7] (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'unwrappedMul [Name
h1, Name
t2]
                          , [Name] -> Exp -> Dec
vals [Name
t10, Name
t9] (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'quotRem [Name
t5, Name
by] ]
                    ]
              , Name -> [Clause] -> Dec
FunD Name
div2 ([Clause] -> Dec) -> [Clause] -> Dec
forall a b. (a -> b) -> a -> b
$ Clause -> [Clause]
forall (m :: * -> *) a. Monad m => a -> m a
return (Clause -> [Clause]) -> Clause -> [Clause]
forall a b. (a -> b) -> a -> b
$
                  [Pat] -> Body -> [Dec] -> Clause
Clause [Name -> Pat
VarP Name
hhh, Name -> Pat
VarP Name
hll, Name -> Pat
VarP Name
by]
                    (Exp -> Body
NormalB (Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV Name
go [ Name -> Exp
VarE Name
hhh
                                      , Name -> Exp
VarE Name
hll
                                      , [Exp] -> Exp
tup [Exp
zeroE, Exp
zeroE]]))
                    [ [Name] -> Exp -> Dec
vals [Name
t2, Name
t1] (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'quotRem ['maxBound, Name
by]
                    , Name -> [Clause] -> Dec
FunD Name
go ([Clause] -> Dec) -> [Clause] -> Dec
forall a b. (a -> b) -> a -> b
$ Clause -> [Clause]
forall (m :: * -> *) a. Monad m => a -> m a
return (Clause -> [Clause]) -> Clause -> [Clause]
forall a b. (a -> b) -> a -> b
$
                        [Pat] -> Body -> [Dec] -> Clause
Clause [Name -> Pat
VarP Name
h, Name -> Pat
VarP Name
l, Name -> Pat
VarP Name
c]
                          (Exp -> Body
NormalB
                             (Exp -> Exp -> Exp -> Exp
CondE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(==) [Name
z, 'allZeroes])
                                ([Exp] -> Exp
tup [ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV Name
addT
                                          [ Name -> Exp
VarE Name
c
                                          , Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV Name
addT
                                              [ [Exp] -> Exp
tup [Name -> Exp
VarE Name
t8 , Name -> Exp
VarE Name
t7]
                                              , [Exp] -> Exp
tup [Exp
zeroE, Name -> Exp
VarE Name
t10] ]
                                          ]
                                      , Name -> Exp
VarE Name
t9 ])
                                (Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV Name
go
                                   [ Name -> Exp
VarE Name
z
                                   , Name -> Exp
VarE Name
t5
                                   , Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV Name
addT
                                       [ Name -> Exp
VarE Name
c
                                       , [Exp] -> Exp
tup [Name -> Exp
VarE Name
t8, Name -> Exp
VarE Name
t7]
                                       ]
                                   ])))
                          [ [Name] -> Exp -> Dec
vals [Name
t4, Name
t3] (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
                              Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'unwrappedMul
                                [Name -> Exp
VarE Name
h, Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(+) [Name
t1, 'lsb]]
                          , [Name] -> Exp -> Dec
vals [Name
t6, Name
t5] (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'unwrappedAdd [Name
t3, Name
l]
                          , Name -> Exp -> Dec
val Name
z (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(+) [Name
t4, Name
t6]
                          , [Name] -> Exp -> Dec
vals [Name
t8, Name
t7] (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'unwrappedMul [Name
h, Name
t2]
                          , [Name] -> Exp -> Dec
vals [Name
t10, Name
t9] (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'quotRem [Name
t5, Name
by] ]
                    , Name -> [Clause] -> Dec
FunD Name
addT ([Clause] -> Dec) -> [Clause] -> Dec
forall a b. (a -> b) -> a -> b
$ Clause -> [Clause]
forall (m :: * -> *) a. Monad m => a -> m a
return (Clause -> [Clause]) -> Clause -> [Clause]
forall a b. (a -> b) -> a -> b
$
                        [Pat] -> Body -> [Dec] -> Clause
Clause [ [Pat] -> Pat
TupP [Name -> Pat
VarP Name
lhh, Name -> Pat
VarP Name
lhl]
                               , [Pat] -> Pat
TupP [Name -> Pat
VarP Name
llh, Name -> Pat
VarP Name
lll]
                               ]
                          (Exp -> Body
NormalB ([Exp] -> Exp
tup [ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(+)
                                             [ Name -> Exp
VarE Name
t4
                                             , Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(+) [Name
lhh, Name
llh]
                                             ]
                                         , Name -> Exp
VarE Name
t3
                                         ]))
                          [[Name] -> Exp -> Dec
vals [Name
t4, Name
t3] (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'unwrappedAdd [Name
lhl, Name
lll]]
                    ]
              ]
        {-
          UNSIGNED:
            divMod = quotRem

          SIGNED:
            divMod x y =
              if x < 0
              then
                if y < 0
                then let (q, r) = quotRem (negate $ unsignedWord x)
                                          (negate $ unsignedWord y) in
                       (signedWord q, signedWord $ negate r)
                else let (q, r) = quotRem (negate $ unsignedWord x)
                                          (unsignedWord y)
                         q1 = signedWord (negate q)
                         r1 = signedWord (negate r) in
                       if r == 0
                       then (q1, r1)
                       else (q1 - 1, r1 + y)
              else
                if y < 0
                then let (q, r) = quotRem (unsignedWord x)
                                          (negate $ unsignedWord y)
                         q1 = signedWord (negate q)
                         r1 = signedWord r in
                       if r == 0
                       then (q1, r1)
                       else (q1 - 1, r1 + y)
                else let (q, r) = quotRem (unsignedWord x)
                                          (unsignedWord y) in
                       (signedWord q, signedWord r)
        -}
        , if Bool
signed
          then
            Name -> Exp -> Dec
funXY 'divMod (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
              Exp -> Exp -> Exp -> Exp
CondE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'testMsb [Name
x])
                (Exp -> Exp -> Exp -> Exp
CondE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'testMsb [Name
y])
                   ([Dec] -> Exp -> Exp
LetE [[Name] -> Exp -> Dec
vals [Name
q, Name
r] (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
                            Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'quotRem
                              [ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'unsignedWord [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'negate [Name
x]]
                              , Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'unsignedWord [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'negate [Name
y]] ]]
                      ([Exp] -> Exp
tup [ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'signedWord [Name
q]
                            , Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'signedWord [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'negate [Name
r]] ]))
                   ([Dec] -> Exp -> Exp
LetE [ [Name] -> Exp -> Dec
vals [Name
q, Name
r] (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
                             Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'quotRem
                               [ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'unsignedWord [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'negate [Name
x]]
                               , Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'unsignedWord [Name
y] ]
                         , Name -> Exp -> Dec
val Name
q1 (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'signedWord [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'negate [Name
q]]
                         , Name -> Exp -> Dec
val Name
r1 (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'signedWord [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'negate [Name
r]]
                         ]
                      (Exp -> Exp -> Exp -> Exp
CondE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(==) [Name
r, 'allZeroes])
                         ([Exp] -> Exp
tup [Name -> Exp
VarE Name
q1, Name -> Exp
VarE Name
r1])
                         ([Exp] -> Exp
tup [ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(-) [Name
q1, 'lsb]
                               , Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(+) [Name
r1, Name
y] ]))))
                (Exp -> Exp -> Exp -> Exp
CondE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'testMsb [Name
y])
                   ([Dec] -> Exp -> Exp
LetE [ [Name] -> Exp -> Dec
vals [Name
q, Name
r] (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
                             Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'quotRem
                               [ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'unsignedWord [Name
x]
                               , Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'unsignedWord [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'negate [Name
y]] ]
                         , Name -> Exp -> Dec
val Name
q1 (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'signedWord [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'negate [Name
q]]
                         , Name -> Exp -> Dec
val Name
r1 (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'signedWord [Name
r]
                         ]
                      (Exp -> Exp -> Exp -> Exp
CondE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(==) [Name
r, 'allZeroes])
                         ([Exp] -> Exp
tup [Name -> Exp
VarE Name
q1, Name -> Exp
VarE Name
r1])
                         ([Exp] -> Exp
tup [ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(-) [Name
q1, 'lsb]
                               , Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(+) [Name
r1, Name
y] ])))
                   ([Dec] -> Exp -> Exp
LetE [[Name] -> Exp -> Dec
vals [Name
q, Name
r] (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
                            Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'quotRem
                              [ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'unsignedWord [Name
x]
                              , Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'unsignedWord [Name
y] ]]
                      ([Exp] -> Exp
tup [ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'signedWord [Name
q]
                            , Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'signedWord [Name
r] ])))
          else
            Name -> Exp -> Dec
fun 'divMod (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'quotRem
        ] [Dec] -> [Dec] -> [Dec]
forall a. [a] -> [a] -> [a]
++
        if Bool
signed then [] else [Name -> Dec
inline 'divMod]
    , Name -> [Name] -> [Dec] -> Dec
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> [Dec] -> Dec
inst ''Show [Name
tp]
        [ Name -> Exp -> Dec
fun 'show (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(.) ['show, 'toInteger]
        , Name -> Dec
inline 'show ]
    , Name -> [Name] -> [Dec] -> Dec
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> [Dec] -> Dec
inst ''Read [Name
tp]
        {-
          readsPrec x y = fmap (\(q, r) → (fromInteger q, r))
                        $ readsPrec x y
        -}
        [ Name -> Exp -> Dec
funXY 'readsPrec (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
            Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'fmap [ [Pat] -> Exp -> Exp
LamE [[Pat] -> Pat
TupP [Name -> Pat
VarP Name
q, Name -> Pat
VarP Name
r]]
                              ([Exp] -> Exp
tup [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'fromInteger [Name
q], Name -> Exp
VarE Name
r])
                       , Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'readsPrec [Name
x, Name
y] ]
        ]
    , Name -> [Name] -> [Dec] -> Dec
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> [Dec] -> Dec
inst ''Hashable [Name
tp]
#if MIN_VERSION_hashable(1,2,0)
        {-
          hashWithSalt x (W hi lo) =
            x `hashWithSalt` hi `hashWithSalt` lo
        -}
        [ Name -> Exp -> Dec
funXHiLo 'hashWithSalt (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
            Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'hashWithSalt [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'hashWithSalt [Name
x, Name
hi], Name -> Exp
VarE Name
lo]
#else
        {- hash (W hi lo) = hash hi `combine` hash lo -}
        [ funHiLo 'hash $ appV 'combine [appVN 'hash [hi], appVN 'hash [lo]]
        , inline 'hash
#endif
        , Name -> Dec
inline 'hashWithSalt ]
    , Name -> [Name] -> [Dec] -> Dec
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> [Dec] -> Dec
inst ''Ix [Name
tp]
        {- range (x, y) = enumFromTo x y -}
        [ Name -> Exp -> Dec
funTup 'range (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'enumFromTo [Name
x, Name
y]
        , Name -> Dec
inline 'range
        {- unsafeIndex (x, _) z = fromIntegral z - fromIntegral x -}
        , Name -> Exp -> Dec
funTupLZ 'unsafeIndex (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
            Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(-) [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'fromIntegral [Name
z], Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'fromIntegral [Name
x]]
        , Name -> Dec
inline 'unsafeIndex
        {- inRange (x, y) z = z >= x && z <= y -}
        , Name -> Exp -> Dec
funTupZ 'inRange (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
            Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(&&) [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(>=) [Name
z, Name
x], Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(<=) [Name
z, Name
y]]
        , Name -> Dec
inline 'inRange ]
    , Name -> [Name] -> [Dec] -> Dec
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> [Dec] -> Dec
inst ''Bits [Name
tp] ([Dec] -> Dec) -> [Dec] -> Dec
forall a b. (a -> b) -> a -> b
$
        {- bitSize _ = bitSize (undefined ∷ H) + bitSize (undefined ∷ L) -}
        [ Name -> Exp -> Dec
fun_ 'bitSize (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(+) [Exp
hiSizeE, Exp
loSizeE]
        , Name -> Dec
inline 'bitSize
#if MIN_VERSION_base(4,7,0)
        {- bitSizeMaybe = Just . finiteBitSize -}
        , Name -> Exp -> Dec
fun 'bitSizeMaybe (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(.) [Name -> Exp
ConE 'Just, Name -> Exp
VarE 'finiteBitSize]
        , Name -> Dec
inline 'bitSizeMaybe
#endif
        {- isSigned _ = SIGNED -}
        , Name -> Exp -> Dec
fun_ 'isSigned (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> Exp
ConE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ if Bool
signed then 'True else 'False
        , Name -> Dec
inline 'isSigned
        {- complement (W hi lo) = W (complement hi) (complement lo) -}
        , Name -> Exp -> Dec
funHiLo 'complement (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
            [Exp] -> Exp
appW [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'complement [Name
hi], Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'complement [Name
lo]]
        , Name -> Dec
inline 'complement
        {- xor (W hi lo) (W hi' lo') = W (xor hi hi') (xor lo lo') -}
        , Name -> Exp -> Dec
funHiLo2 'xor (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ [Exp] -> Exp
appW [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'xor [Name
hi, Name
hi'], Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'xor [Name
lo, Name
lo']]
        , Name -> Dec
inline 'xor
        {- (W hi lo) .&. (W hi' lo') = W (hi .&. hi') (lo .&. lo') -}
        , Name -> Exp -> Dec
funHiLo2 '(.&.) (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
            [Exp] -> Exp
appW [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(.&.) [Name
hi, Name
hi'], Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(.&.) [Name
lo, Name
lo']]
        , Name -> Dec
inline '(.&.)
        {- (W hi lo) .|. (W hi' lo') = W (hi .|. hi') (lo .|. lo') -}
        , Name -> Exp -> Dec
funHiLo2 '(.|.) (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
            [Exp] -> Exp
appW [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(.|.) [Name
hi, Name
hi'], Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(.|.) [Name
lo, Name
lo']]
        , Name -> Dec
inline '(.|.)
        {-
          shiftL (W hi lo) x =
              if y > 0
                then W (shiftL hi x .|. fromIntegral (shiftR lo y))
                       (shiftL lo x)
                else W (fromIntegral $ shiftL lo $ negate y) 0
            where y = bitSize (undefined ∷ L) - x
        -}
        , Name -> Exp -> [Dec] -> Dec
funHiLoX' 'shiftL
            (Exp -> Exp -> Exp -> Exp
CondE (Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(>) [Name -> Exp
VarE Name
y, Integer -> Exp
litI Integer
0])
                   ([Exp] -> Exp
appW
                      [ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(.|.)
                          [ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'shiftL [Name
hi, Name
x]
                          , Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'fromIntegral [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'shiftR [Name
lo, Name
y]] ]
                      , Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'shiftL [Name
lo, Name
x] ])
                   ([Exp] -> Exp
appW [ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'fromIntegral
                             [Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'shiftL [Name -> Exp
VarE Name
lo, Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'negate [Name
y]]]
                         , Exp
zeroE ]))
            [Name -> Exp -> Dec
val Name
y (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(-) [Exp
loSizeE, Name -> Exp
VarE Name
x]]
        {-
          shiftR (W hi lo) x =
              W (shiftR hi x)
                (if y >= 0 then shiftL (fromIntegral hi) y .|. shiftR lo x
                           else z)
            where y = bitSize (undefined ∷ L) - x
                  z = if SIGNED
                      then fromIntegral $
                             shiftR (fromIntegral hi ∷ SignedWord L) $
                               negate y
                      else shiftR (fromIntegral hi) $ negate y
        -}
        , Name -> Exp -> [Dec] -> Dec
funHiLoX' 'shiftR
            ([Exp] -> Exp
appW [ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'shiftR [Name
hi, Name
x]
                  , Exp -> Exp -> Exp -> Exp
CondE (Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(>=) [Name -> Exp
VarE Name
y, Integer -> Exp
litI Integer
0])
                          (Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(.|.)
                             [ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'shiftL
                                 [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'fromIntegral [Name
hi], Name -> Exp
VarE Name
y]
                             , Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'shiftR [Name
lo, Name
x] ])
                          (Name -> Exp
VarE Name
z) ])
            [ Name -> Exp -> Dec
val Name
y (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(-) [Exp
loSizeE, Name -> Exp
VarE Name
x]
            , Name -> Exp -> Dec
val Name
z (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
                if Bool
signed
                then Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'fromIntegral
                       [Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'shiftR
                          [ Exp -> Type -> Exp
SigE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'fromIntegral [Name
hi])
                                 (Type -> Type -> Type
AppT (Name -> Type
ConT ''SignedWord) Type
loT)
                          , Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'negate [Name
y] ]]
                else Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'shiftR [ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'fromIntegral [Name
hi]
                                  , Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'negate [Name
y] ]
            ]
        {-
          UNSIGNED:
            rotateL (W hi lo) x =
                if y >= 0
                then W (fromIntegral (shiftL lo y) .|. shiftR hi z)
                     W (shiftL (fromIntegral hi) (bitSize (undefined ∷ L) - z)
                        .|. shiftR lo z)
                else W (fromIntegral (shiftR lo $ negate y) .|. shiftL hi x)
                       (shift (fromIntegral hi) (bitSize (undefined ∷ L) - z)
                        .|. shiftL lo x
                        .|. shiftR lo z)
              where y = x - bitSize (undefined ∷ L)
                    z = bitSize (undefined ∷ W) - x
          SIGNED:
            rotateL x y = signedWord $ rotateL (unsignedWord x) y
        -}
        , if Bool
signed
          then
            Name -> Exp -> Dec
funXY 'rotateL (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
              Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'signedWord
                   [Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'rotateL [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'unsignedWord [Name
x], Name -> Exp
VarE Name
y]]
          else
            Name -> Exp -> [Dec] -> Dec
funHiLoX' 'rotateL
              (Exp -> Exp -> Exp -> Exp
CondE (Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(>=) [Name -> Exp
VarE Name
y, Integer -> Exp
litI Integer
0])
                 ([Exp] -> Exp
appW
                    [ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(.|.)
                        [ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'fromIntegral [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'shiftL [Name
lo, Name
y]]
                        , Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'shiftR [Name
hi, Name
z] ]
                    , Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(.|.)
                        [ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'shiftL
                            [ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'fromIntegral [Name
hi]
                            , Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(-) [Exp
loSizeE, Name -> Exp
VarE Name
z]
                            ]
                        , Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'shiftR [Name
lo, Name
z] ]
                    ])
                 ([Exp] -> Exp
appW
                    [ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(.|.)
                        [ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'fromIntegral
                            [Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'shiftR [Name -> Exp
VarE Name
lo, Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'negate [Name
y]]]
                        , Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'shiftL [Name
hi, Name
x] ]
                    , Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(.|.)
                        [ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'shift
                            [ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'fromIntegral [Name
hi]
                            , Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(-) [Exp
loSizeE, Name -> Exp
VarE Name
z] ]
                        , Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(.|.)
                            [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'shiftL [Name
lo, Name
x], Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'shiftR [Name
lo, Name
z]] ]
                    ]))
              [ Name -> Exp -> Dec
val Name
y (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(-) [Name -> Exp
VarE Name
x, Exp
loSizeE]
              , Name -> Exp -> Dec
val Name
z (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(-) [Exp
sizeE, Name -> Exp
VarE Name
x]
              ]
        {- rotateR x y = rotateL x $ bitSize (undefined ∷ W) - y -}
        , Name -> Exp -> Dec
funXY 'rotateR (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'rotateL [Name -> Exp
VarE Name
x, Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(-) [Exp
sizeE, Name -> Exp
VarE Name
y]]
        , Name -> Dec
inline 'rotateR
        {-
          bit x = if y >= 0 then W (bit y) 0 else W 0 (bit x)
            where y = x - bitSize (undefined ∷ LoWord W)
        -}
        , Name -> Exp -> [Dec] -> Dec
funX' 'bit (Exp -> Exp -> Exp -> Exp
CondE (Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(>=) [Name -> Exp
VarE Name
y, Integer -> Exp
litI Integer
0])
                            ([Exp] -> Exp
appW [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'bit [Name
y], Exp
zeroE])
                            ([Exp] -> Exp
appW [Exp
zeroE, Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'bit [Name
x]]))
            [Name -> Exp -> Dec
val Name
y (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(-) [Name -> Exp
VarE Name
x, Exp
loSizeE]]
        , Name -> Dec
inlinable 'bit
        {-
          setBit (W hi lo) x =
              if y >= 0 then W (setBit hi y) lo else W hi (setBit lo x)
            where y = x - bitSize (undefined ∷ L)
        -}
        , Name -> Exp -> [Dec] -> Dec
funHiLoX' 'setBit
            (Exp -> Exp -> Exp -> Exp
CondE (Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(>=) [Name -> Exp
VarE Name
y, Integer -> Exp
litI Integer
0])
                   ([Exp] -> Exp
appW [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'setBit [Name
hi, Name
y], Name -> Exp
VarE Name
lo])
                   ([Exp] -> Exp
appW [Name -> Exp
VarE Name
hi, Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'setBit [Name
lo, Name
x]]))
            [Name -> Exp -> Dec
val Name
y (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
               Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(-) [ Name -> Exp
VarE Name
x
                         , Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'bitSize [Exp -> Type -> Exp
SigE (Name -> Exp
VarE 'undefined) Type
loT] ]]
        , Name -> Dec
inlinable 'setBit
        {-
          clearBit (W hi lo) x =
              if y >= 0 then W (clearBit hi y) lo
                        else W hi (clearBit lo x)
            where y = x - bitSize (undefined ∷ L)
        -}
        , Name -> Exp -> [Dec] -> Dec
funHiLoX' 'clearBit
            (Exp -> Exp -> Exp -> Exp
CondE (Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(>=) [Name -> Exp
VarE Name
y, Integer -> Exp
litI Integer
0])
                   ([Exp] -> Exp
appW [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'clearBit [Name
hi, Name
y], Name -> Exp
VarE Name
lo])
                   ([Exp] -> Exp
appW [Name -> Exp
VarE Name
hi, Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'clearBit [Name
lo, Name
x]]))
            [Name -> Exp -> Dec
val Name
y (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(-) [Name -> Exp
VarE Name
x, Exp
loSizeE]]
        , Name -> Dec
inlinable 'clearBit
        {-
          complementBit (W hi lo) x =
              if y >= 0 then W (complementBit hi y) lo
                        else W hi (complementBit lo x)
            where y = x - bitSize (undefined ∷ L)
        -}
        , Name -> Exp -> [Dec] -> Dec
funHiLoX' 'complementBit
            (Exp -> Exp -> Exp -> Exp
CondE (Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(>=) [Name -> Exp
VarE Name
y, Integer -> Exp
litI Integer
0])
                   ([Exp] -> Exp
appW [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'complementBit [Name
hi, Name
y], Name -> Exp
VarE Name
lo])
                   ([Exp] -> Exp
appW [Name -> Exp
VarE Name
hi, Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'complementBit [Name
lo, Name
x]]))
            [Name -> Exp -> Dec
val Name
y (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(-) [Name -> Exp
VarE Name
x, Exp
loSizeE]]
        , Name -> Dec
inlinable 'complementBit
        {-
          testBit (W hi lo) x =
              if y >= 0 then testBit hi y else testBit lo x
            where y = x - bitSize (undefined ∷ L)
        -}
        , Name -> Exp -> [Dec] -> Dec
funHiLoX' 'testBit
            (Exp -> Exp -> Exp -> Exp
CondE (Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(>=) [Name -> Exp
VarE Name
y, Integer -> Exp
litI Integer
0])
                   (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'testBit [Name
hi, Name
y])
                   (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'testBit [Name
lo, Name
x]))
            [Name -> Exp -> Dec
val Name
y (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(-) [Name -> Exp
VarE Name
x, Exp
loSizeE]]
        , Name -> Dec
inlinable 'testBit
        {- popCount (W hi lo) = popCount hi + popCount lo -}
        , Name -> Exp -> Dec
funHiLo 'popCount
            (Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(+) [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'popCount [Name
hi], Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'popCount [Name
lo]])
        , Name -> Dec
inline 'popCount
        ] [Dec] -> [Dec] -> [Dec]
forall a. [a] -> [a] -> [a]
++
        if Bool
signed then [Name -> Dec
inline 'rotateL] else []
#if MIN_VERSION_base(4,7,0)
    , Name -> [Name] -> [Dec] -> Dec
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> [Dec] -> Dec
inst ''FiniteBits [Name
tp]
        {-
           finiteBitSize = finiteBitSize (undefined ∷ H) +
                           finiteBitSize (undefined ∷ L)
        -}
        [ Name -> Exp -> Dec
fun_ 'finiteBitSize (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(+) [Exp
hiSizeE, Exp
loSizeE]
        , Name -> Dec
inline 'finiteBitSize
# if MIN_VERSION_base(4,8,0)
        {- countLeadingZeros = leadingZeroes -}
        , Name -> Exp -> Dec
fun 'countLeadingZeros (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'leadingZeroes
        , Name -> Dec
inline 'countLeadingZeros
        {- countTrailingZeros = trailingZeroes -}
        , Name -> Exp -> Dec
fun 'countTrailingZeros (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'trailingZeroes
        , Name -> Dec
inline 'countTrailingZeros
# endif
        ]
#endif
    , Name -> [Name] -> [Dec] -> Dec
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> [Dec] -> Dec
inst ''BinaryWord [Name
tp]
        [ Name -> Cxt -> Type -> Dec
forall (t :: * -> *). Foldable t => Name -> t Type -> Type -> Dec
tySynInst ''UnsignedWord [Type
tpT] (Type -> Dec) -> Type -> Dec
forall a b. (a -> b) -> a -> b
$
            Name -> Type
ConT (Name -> Type) -> Name -> Type
forall a b. (a -> b) -> a -> b
$ if Bool
signed then Name
otp else Name
tp
        , Name -> Cxt -> Type -> Dec
forall (t :: * -> *). Foldable t => Name -> t Type -> Type -> Dec
tySynInst ''SignedWord [Type
tpT] (Type -> Dec) -> Type -> Dec
forall a b. (a -> b) -> a -> b
$
            Name -> Type
ConT (Name -> Type) -> Name -> Type
forall a b. (a -> b) -> a -> b
$ if Bool
signed then Name
tp else Name
otp
        {-
          UNSIGNED:
            unsignedWord = id

          SIGNED:
            unsignedWord (W hi lo) = U (unsignedWord hi) lo
        -}
        , if Bool
signed
          then
            Name -> Exp -> Dec
funHiLo 'unsignedWord (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
              Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appC Name
ocn [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'unsignedWord [Name
hi], Name -> Exp
VarE Name
lo]
          else
            Name -> Exp -> Dec
fun 'unsignedWord (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'id
        , Name -> Dec
inline 'unsignedWord
        {-
          UNSIGNED:
            signedWord (W hi lo) = S (signedWord hi) lo

          SIGNED:
            signedWord = id
        -}
        , if Bool
signed
          then
            Name -> Exp -> Dec
fun 'signedWord (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'id
          else
            Name -> Exp -> Dec
funHiLo 'signedWord (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
              Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appC Name
ocn [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'signedWord [Name
hi], Name -> Exp
VarE Name
lo]
        , Name -> Dec
inline 'signedWord
        {-
          UNSIGNED:
            unwrappedAdd (W hi lo) (W hi' lo') = (W 0 z, W y x)
              where (t1, x) = unwrappedAdd lo lo'
                    (t3, t2) = unwrappedAdd hi (fromIntegral t1)
                    (t4, y) = unwrappedAdd t2 hi'
                    z = fromIntegral $ t3 + t4
          SIGNED:
            unwrappedAdd x y = (z, t4)
              where t1 = if x < 0 then maxBound else minBound
                    t2 = if y < 0 then maxBound else minBound
                    (t3, t4) = unwrappedAdd (unsignedWord x) (unsignedWord y)
                    z = signedWord $ t1 + t2 + t3
        -}
        , if Bool
signed
          then
            Name -> Exp -> [Dec] -> Dec
funXY' 'unwrappedAdd ([Exp] -> Exp
tup [Name -> Exp
VarE Name
z, Name -> Exp
VarE Name
t4])
              [ Name -> Exp -> Dec
val Name
t1 (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Exp -> Exp -> Exp -> Exp
CondE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'testMsb [Name
x])
                               (Name -> Exp
VarE 'maxBound) (Name -> Exp
VarE 'minBound)
              , Name -> Exp -> Dec
val Name
t2 (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Exp -> Exp -> Exp -> Exp
CondE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'testMsb [Name
y])
                               (Name -> Exp
VarE 'maxBound) (Name -> Exp
VarE 'minBound)
              , [Name] -> Exp -> Dec
vals [Name
t3, Name
t4] (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
                  Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'unwrappedAdd [ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'unsignedWord [Name
x]
                                     , Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'unsignedWord [Name
y] ]
              , Name -> Exp -> Dec
val Name
z (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
                  Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'signedWord [Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(+) [Name -> Exp
VarE Name
t1, Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(+) [Name
t2, Name
t3]]]
              ]
          else
            Name -> Exp -> [Dec] -> Dec
funHiLo2' 'unwrappedAdd
              ([Exp] -> Exp
tup [[Name] -> Exp
appWN ['allZeroes, Name
z], [Name] -> Exp
appWN [Name
y, Name
x]])
              [ [Name] -> Exp -> Dec
vals [Name
t1, Name
x] (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'unwrappedAdd [Name
lo, Name
lo']
              , [Name] -> Exp -> Dec
vals [Name
t3, Name
t2] (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
                  Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'unwrappedAdd [Name -> Exp
VarE Name
hi, Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'fromIntegral [Name
t1]]
              , [Name] -> Exp -> Dec
vals [Name
t4, Name
y] (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'unwrappedAdd [Name
t2, Name
hi']
              , Name -> Exp -> Dec
val Name
z (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'fromIntegral [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(+) [Name
t3, Name
t4]]
              ]
        {-
          UNSIGNED:
            unwrappedMul (W hi lo) (W hi' lo') =
                (W (hhh + fromIntegral (shiftR t9 y) + shiftL x z)
                   (shiftL t9 z .|. shiftR t3 y),
                 W (fromIntegral t3) lll)
              where (llh, lll) = unwrappedMul lo lo'
                    (hlh, hll) = unwrappedMul (fromIntegral hi) lo'
                    (lhh, lhl) = unwrappedMul lo (fromIntegral hi')
                    (hhh, hhl) = unwrappedMul hi hi'
                    (t2, t1) = unwrappedAdd llh hll
                    (t4, t3) = unwrappedAdd t1 lhl
                    (t6, t5) = unwrappedAdd (fromIntegral hhl) (t2 + t4)
                    (t8, t7) = unwrappedAdd t5 lhh
                    (t10, t9) = unwrappedAdd t7 hlh
                    x = fromIntegral $ t6 + t8 + t10
                    y = bitSize (undefined ∷ H)
                    z = bitSize (undefined ∷ L) - y
          SIGNED:
            unwrappedMul (W hi lo) (W hi' lo') = (x, y)
              where t1 = W (complement hi') (complement lo') + 1
                    t2 = W (complement hi) (complement lo) + 1
                    (t3, y) = unwrappedMul (U (unsignedWord hi) lo)
                                           (U (unsignedWord hi') lo')
                    z = signedWord t3
                    x = if hi < 0
                        then if hi' < 0
                             then z + t1 + t2
                             else z + t1
                        else if hi' < 0
                             then z + t2
                             else z
        -}
        , if Bool
signed
          then
            Name -> Exp -> [Dec] -> Dec
funHiLo2' 'unwrappedMul ([Exp] -> Exp
tup [Name -> Exp
VarE Name
x, Name -> Exp
VarE Name
y])
              [ Name -> Exp -> Dec
val Name
t1 (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
                  Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(+) [ [Exp] -> Exp
appW [ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'complement [Name
hi']
                                   , Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'complement [Name
lo'] ]
                            , Exp
oneE ]
              , Name -> Exp -> Dec
val Name
t2 (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
                  Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(+) [ [Exp] -> Exp
appW [ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'complement [Name
hi]
                                   , Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'complement [Name
lo] ]
                            , Exp
oneE ]
              , [Name] -> Exp -> Dec
vals [Name
t3, Name
y] (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
                  Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'unwrappedMul
                    [ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appC Name
ocn [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'unsignedWord [Name
hi], Name -> Exp
VarE Name
lo]
                    , Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appC Name
ocn [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'unsignedWord [Name
hi'], Name -> Exp
VarE Name
lo'] ]
              , Name -> Exp -> Dec
val Name
z (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'signedWord [Name
t3]
              , Name -> Exp -> Dec
val Name
x (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
                  Exp -> Exp -> Exp -> Exp
CondE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'testMsb [Name
hi])
                    (Exp -> Exp -> Exp -> Exp
CondE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'testMsb [Name
hi'])
                       (Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(+) [Name -> Exp
VarE Name
z, Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(+) [Name
t1, Name
t2]])
                       (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(+) [Name
z, Name
t1]))
                    (Exp -> Exp -> Exp -> Exp
CondE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'testMsb [Name
hi'])
                       (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(+) [Name
z, Name
t2]) (Name -> Exp
VarE Name
z))
              ]
          else
            Name -> Exp -> [Dec] -> Dec
funHiLo2' 'unwrappedMul
              ([Exp] -> Exp
tup [ [Exp] -> Exp
appW
                        [ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(+)
                            [ Name -> Exp
VarE Name
hhh
                            , Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(+)
                                [ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'fromIntegral [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'shiftR [Name
t9, Name
y]]
                                , Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'shiftL [Name
x, Name
z] ]
                            ]
                        , Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(.|.) [ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'shiftL [Name
t9, Name
z]
                                      , Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'shiftR [Name
t3, Name
y] ]
                        ]
                    , [Exp] -> Exp
appW [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'fromIntegral [Name
t3], Name -> Exp
VarE Name
lll]
                    ])
              [ [Name] -> Exp -> Dec
vals [Name
llh, Name
lll] (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'unwrappedMul [Name
lo, Name
lo']
              , [Name] -> Exp -> Dec
vals [Name
hlh, Name
hll] (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
                  Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'unwrappedMul [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'fromIntegral [Name
hi], Name -> Exp
VarE Name
lo']
              , [Name] -> Exp -> Dec
vals [Name
lhh, Name
lhl] (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
                  Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'unwrappedMul [Name -> Exp
VarE Name
lo, Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'fromIntegral [Name
hi']]
              , [Name] -> Exp -> Dec
vals [Name
hhh, Name
hhl] (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'unwrappedMul [Name
hi, Name
hi']
              , [Name] -> Exp -> Dec
vals [Name
t2, Name
t1] (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'unwrappedAdd [Name
llh, Name
hll]
              , [Name] -> Exp -> Dec
vals [Name
t4, Name
t3] (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'unwrappedAdd [Name
t1, Name
lhl]
              , [Name] -> Exp -> Dec
vals [Name
t6, Name
t5] (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
                  Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'unwrappedAdd [ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'fromIntegral [Name
hhl]
                                     , Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(+) [Name
t2, Name
t4] ]
              , [Name] -> Exp -> Dec
vals [Name
t8, Name
t7] (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'unwrappedAdd [Name
t5, Name
lhh]
              , [Name] -> Exp -> Dec
vals [Name
t10, Name
t9] (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'unwrappedAdd [Name
t7, Name
hlh]
              , Name -> Exp -> Dec
val Name
x (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$
                  Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'fromIntegral
                    [Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(+) [Name -> Exp
VarE Name
t6, Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(+) [Name
t8, Name
t10]]]
              , Name -> Exp -> Dec
val Name
y (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Exp
hiSizeE
              , Name -> Exp -> Dec
val Name
z (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(-) [Exp
loSizeE, Name -> Exp
VarE Name
y]
              ]
        {-
          UNSIGNED:
            leadingZeroes (W hi lo) =
                if x == y then y + leadingZeroes lo else x
              where x = leadingZeroes hi
                    y = bitSize (undefined ∷ H)
          SIGNED:
            leadingZeroes = leadingZeroes . unsignedWord
        -}
        , if Bool
signed
          then
            Name -> Exp -> Dec
fun 'leadingZeroes (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(.) ['leadingZeroes, 'unsignedWord]
          else
            Name -> Exp -> [Dec] -> Dec
funHiLo' 'leadingZeroes
              (Exp -> Exp -> Exp -> Exp
CondE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(==) [Name
x, Name
y])
                     (Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(+) [Name -> Exp
VarE Name
y, Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'leadingZeroes [Name
lo]])
                     (Name -> Exp
VarE Name
x))
              [ Name -> Exp -> Dec
val Name
x (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'leadingZeroes [Name
hi]
              , Name -> Exp -> Dec
val Name
y (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Exp
hiSizeE
              ]
        , if Bool
signed then Name -> Dec
inlinable 'leadingZeroes
                    else Name -> Dec
inline 'leadingZeroes
        {-
          UNSIGNED:
            trailingZeroes (W hi lo) =
                if x == y then y + trailingZeroes hi else x
              where x = trailingZeroes lo
                    y = bitSize (undefined ∷ L)
          SIGNED:
            trailingZeroes = trailingZeroes . unsignedWord
        -}
        , if Bool
signed
          then
            Name -> Exp -> Dec
fun 'trailingZeroes (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(.) ['trailingZeroes, 'unsignedWord]
          else
            Name -> Exp -> [Dec] -> Dec
funHiLo' 'trailingZeroes
              (Exp -> Exp -> Exp -> Exp
CondE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(==) [Name
x, Name
y])
                     (Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(+) [Name -> Exp
VarE Name
y, Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'trailingZeroes [Name
hi]])
                     (Name -> Exp
VarE Name
x))
              [ Name -> Exp -> Dec
val Name
x (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'trailingZeroes [Name
lo]
              , Name -> Exp -> Dec
val Name
y (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Exp
loSizeE ]
        , if Bool
signed then Name -> Dec
inlinable 'trailingZeroes
                    else Name -> Dec
inline 'trailingZeroes
        {- allZeroes = W allZeroes allZeroes -}
        , Name -> Exp -> Dec
fun 'allZeroes (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ [Name] -> Exp
appWN ['allZeroes, 'allZeroes]
        , Name -> Dec
inline 'allZeroes
        {- allOnes = W allOnes allOnes -}
        , Name -> Exp -> Dec
fun 'allOnes (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ [Name] -> Exp
appWN ['allOnes, 'allOnes]
        , Name -> Dec
inline 'allOnes
        {- msb = W msb allZeroes -}
        , Name -> Exp -> Dec
fun 'msb (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ [Name] -> Exp
appWN ['msb, 'allZeroes]
        , Name -> Dec
inline 'msb
        {- lsb = W allZeroes lsb -}
        , Name -> Exp -> Dec
fun 'lsb (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ [Name] -> Exp
appWN ['allZeroes, 'lsb]
        , Name -> Dec
inline 'lsb
        {- testMsb (W hi _) = testMsb hi -}
        , Name -> Exp -> Dec
funHi 'testMsb (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'testMsb [Name
hi]
        , Name -> Dec
inline 'testMsb
        {- testLsb (W _ lo) = testLsb lo -}
        , Name -> Exp -> Dec
funLo 'testLsb (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'testLsb [Name
lo]
        , Name -> Dec
inline 'testLsb
        {- setMsb (W hi lo) = W (setMsb hi) lo -}
        , Name -> Exp -> Dec
funHiLo 'setMsb (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ [Exp] -> Exp
appW [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'setMsb [Name
hi], Name -> Exp
VarE Name
lo]
        , Name -> Dec
inline 'setMsb
        {- setLsb (W hi lo) = W hi (setLsb lo) -}
        , Name -> Exp -> Dec
funHiLo 'setLsb (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ [Exp] -> Exp
appW [Name -> Exp
VarE Name
hi, Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'setLsb [Name
lo]]
        , Name -> Dec
inline 'setLsb
        {- clearMsb (W hi lo) = W (clearMsb hi) lo -}
        , Name -> Exp -> Dec
funHiLo 'clearMsb (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ [Exp] -> Exp
appW [Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'clearMsb [Name
hi], Name -> Exp
VarE Name
lo]
        , Name -> Dec
inline 'clearMsb
        {- clearLsb (W hi lo) = W hi (clearLsb lo) -}
        , Name -> Exp -> Dec
funHiLo 'clearLsb (Exp -> Dec) -> Exp -> Dec
forall a b. (a -> b) -> a -> b
$ [Exp] -> Exp
appW [Name -> Exp
VarE Name
hi, Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'clearLsb [Name
lo]]
        , Name -> Dec
inline 'clearLsb
        ]
    ]
  where
    x :: Name
x    = String -> Name
mkName String
"x"
    y :: Name
y    = String -> Name
mkName String
"y"
    z :: Name
z    = String -> Name
mkName String
"z"
    t1 :: Name
t1   = String -> Name
mkName String
"t1"
    t2 :: Name
t2   = String -> Name
mkName String
"t2"
    t3 :: Name
t3   = String -> Name
mkName String
"t3"
    t4 :: Name
t4   = String -> Name
mkName String
"t4"
    t5 :: Name
t5   = String -> Name
mkName String
"t5"
    t6 :: Name
t6   = String -> Name
mkName String
"t6"
    t7 :: Name
t7   = String -> Name
mkName String
"t7"
    t8 :: Name
t8   = String -> Name
mkName String
"t8"
    t9 :: Name
t9   = String -> Name
mkName String
"t9"
    t10 :: Name
t10  = String -> Name
mkName String
"t10"
    v :: Name
v    = String -> Name
mkName String
"v"
    q :: Name
q    = String -> Name
mkName String
"q"
    q1 :: Name
q1   = String -> Name
mkName String
"q1"
    q2 :: Name
q2   = String -> Name
mkName String
"q2"
    r :: Name
r    = String -> Name
mkName String
"r"
    r1 :: Name
r1   = String -> Name
mkName String
"r1"
    r2 :: Name
r2   = String -> Name
mkName String
"r2"
    lll :: Name
lll  = String -> Name
mkName String
"lll"
    llh :: Name
llh  = String -> Name
mkName String
"llh"
    lhl :: Name
lhl  = String -> Name
mkName String
"lhl"
    lhh :: Name
lhh  = String -> Name
mkName String
"lhh"
    hll :: Name
hll  = String -> Name
mkName String
"hll"
    hlh :: Name
hlh  = String -> Name
mkName String
"hlh"
    hhl :: Name
hhl  = String -> Name
mkName String
"hhl"
    hhh :: Name
hhh  = String -> Name
mkName String
"hhh"
    h :: Name
h    = String -> Name
mkName String
"h"
    h1 :: Name
h1   = String -> Name
mkName String
"h1"
    l :: Name
l    = String -> Name
mkName String
"l"
    div1 :: Name
div1 = String -> Name
mkName String
"div1"
    div2 :: Name
div2 = String -> Name
mkName String
"div2"
    addT :: Name
addT = String -> Name
mkName String
"addT"
    by :: Name
by   = String -> Name
mkName String
"by_"
    go :: Name
go   = String -> Name
mkName String
"go_"
    c :: Name
c    = String -> Name
mkName String
"c"
    next :: Name
next = String -> Name
mkName String
"next_"
    step :: Name
step = String -> Name
mkName String
"step_"
    to :: Name
to   = String -> Name
mkName String
"to_"
    down :: Name
down = String -> Name
mkName String
"down_"
    up :: Name
up   = String -> Name
mkName String
"up_"
    hi :: Name
hi   = String -> Name
mkName String
"hi_"
    lo :: Name
lo   = String -> Name
mkName String
"lo_"
    hi' :: Name
hi'  = String -> Name
mkName String
"hi'"
    lo' :: Name
lo'  = String -> Name
mkName String
"lo'"
    tpT :: Type
tpT  = Name -> Type
ConT Name
tp
    tySynInst :: Name -> t Type -> Type -> Dec
tySynInst Name
n t Type
ps Type
t =
#if MIN_VERSION_template_haskell(2,15,0)
      TySynEqn -> Dec
TySynInstD (Maybe [TyVarBndr] -> Type -> Type -> TySynEqn
TySynEqn Maybe [TyVarBndr]
forall a. Maybe a
Nothing ((Type -> Type -> Type) -> Type -> t Type -> Type
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Type -> Type -> Type
AppT (Name -> Type
ConT Name
n) t Type
ps) Type
t)
#elif MIN_VERSION_template_haskell(2,9,0)
      TySynInstD n (TySynEqn ps t)
#else
      TySynInstD n ps t
#endif
    inst :: Name -> t Name -> [Dec] -> Dec
inst Name
cls t Name
params = Maybe Overlap -> Cxt -> Type -> [Dec] -> Dec
InstanceD
#if MIN_VERSION_template_haskell(2,11,0)
                                Maybe Overlap
forall a. Maybe a
Nothing
#endif
                                [] ((Type -> Type -> Type) -> Type -> t Type -> Type
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Type -> Type -> Type
AppT (Name -> Type
ConT Name
cls) (Name -> Type
ConT (Name -> Type) -> t Name -> t Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t Name
params))
    fun :: Name -> Exp -> Dec
fun Name
n Exp
e       = Name -> [Clause] -> Dec
FunD Name
n [[Pat] -> Body -> [Dec] -> Clause
Clause [] (Exp -> Body
NormalB Exp
e) []]
    fun1 :: Name -> Name -> Exp -> Dec
fun1 Name
n Name
a Exp
e    = Name -> [Clause] -> Dec
FunD Name
n [[Pat] -> Body -> [Dec] -> Clause
Clause [Name -> Pat
VarP Name
a] (Exp -> Body
NormalB Exp
e) []]
    fun_ :: Name -> Exp -> Dec
fun_ Name
n Exp
e      = Name -> [Clause] -> Dec
FunD Name
n [[Pat] -> Body -> [Dec] -> Clause
Clause [Pat
WildP] (Exp -> Body
NormalB Exp
e) []]
    funX' :: Name -> Exp -> [Dec] -> Dec
funX' Name
n Exp
e [Dec]
ds  = Name -> [Clause] -> Dec
FunD Name
n [[Pat] -> Body -> [Dec] -> Clause
Clause [Name -> Pat
VarP Name
x] (Exp -> Body
NormalB Exp
e) [Dec]
ds]
    funX :: Name -> Exp -> Dec
funX Name
n Exp
e      = Name -> Exp -> [Dec] -> Dec
funX' Name
n Exp
e []
    funXY' :: Name -> Exp -> [Dec] -> Dec
funXY' Name
n Exp
e [Dec]
ds = Name -> [Clause] -> Dec
FunD Name
n [[Pat] -> Body -> [Dec] -> Clause
Clause [Name -> Pat
VarP Name
x, Name -> Pat
VarP Name
y] (Exp -> Body
NormalB Exp
e) [Dec]
ds]
    funXY :: Name -> Exp -> Dec
funXY Name
n Exp
e     = Name -> Exp -> [Dec] -> Dec
funXY' Name
n Exp
e []
    funTup :: Name -> Exp -> Dec
funTup Name
n Exp
e    = Name -> [Clause] -> Dec
FunD Name
n [[Pat] -> Body -> [Dec] -> Clause
Clause [[Pat] -> Pat
TupP [Name -> Pat
VarP Name
x, Name -> Pat
VarP Name
y]] (Exp -> Body
NormalB Exp
e) []]
    funTupZ :: Name -> Exp -> Dec
funTupZ Name
n Exp
e   =
      Name -> [Clause] -> Dec
FunD Name
n [[Pat] -> Body -> [Dec] -> Clause
Clause [[Pat] -> Pat
TupP [Name -> Pat
VarP Name
x, Name -> Pat
VarP Name
y], Name -> Pat
VarP Name
z] (Exp -> Body
NormalB Exp
e) []]
    funTupLZ :: Name -> Exp -> Dec
funTupLZ Name
n Exp
e  =
      Name -> [Clause] -> Dec
FunD Name
n [[Pat] -> Body -> [Dec] -> Clause
Clause [[Pat] -> Pat
TupP [Name -> Pat
VarP Name
x, Pat
WildP], Name -> Pat
VarP Name
z] (Exp -> Body
NormalB Exp
e) []]
    funLo :: Name -> Exp -> Dec
funLo Name
n Exp
e     = Name -> [Clause] -> Dec
FunD Name
n [[Pat] -> Body -> [Dec] -> Clause
Clause [Name -> [Pat] -> Pat
conP Name
cn [Pat
WildP, Name -> Pat
VarP Name
lo]] (Exp -> Body
NormalB Exp
e) []]
    funHi :: Name -> Exp -> Dec
funHi Name
n Exp
e     = Name -> [Clause] -> Dec
FunD Name
n [[Pat] -> Body -> [Dec] -> Clause
Clause [Name -> [Pat] -> Pat
conP Name
cn [Name -> Pat
VarP Name
hi, Pat
WildP]] (Exp -> Body
NormalB Exp
e) []]
    funHiLo :: Name -> Exp -> Dec
funHiLo Name
n Exp
e   = Name -> Exp -> [Dec] -> Dec
funHiLo' Name
n Exp
e []
    funHiLo' :: Name -> Exp -> [Dec] -> Dec
funHiLo' Name
n Exp
e [Dec]
ds  =
      Name -> [Clause] -> Dec
FunD Name
n [[Pat] -> Body -> [Dec] -> Clause
Clause [Name -> [Pat] -> Pat
conP Name
cn [Name -> Pat
VarP Name
hi, Name -> Pat
VarP Name
lo]] (Exp -> Body
NormalB Exp
e) [Dec]
ds]
    funHiLoX' :: Name -> Exp -> [Dec] -> Dec
funHiLoX' Name
n Exp
e [Dec]
ds =
      Name -> [Clause] -> Dec
FunD Name
n [[Pat] -> Body -> [Dec] -> Clause
Clause [Name -> [Pat] -> Pat
conP Name
cn [Name -> Pat
VarP Name
hi, Name -> Pat
VarP Name
lo], Name -> Pat
VarP Name
x] (Exp -> Body
NormalB Exp
e) [Dec]
ds]
    funHiLo2 :: Name -> Exp -> Dec
funHiLo2 Name
n Exp
e     = Name -> Exp -> [Dec] -> Dec
funHiLo2' Name
n Exp
e []
    funHiLo2' :: Name -> Exp -> [Dec] -> Dec
funHiLo2' Name
n Exp
e [Dec]
ds =
      Name -> [Clause] -> Dec
FunD Name
n [[Pat] -> Body -> [Dec] -> Clause
Clause [ Name -> [Pat] -> Pat
conP Name
cn [Name -> Pat
VarP Name
hi, Name -> Pat
VarP Name
lo]
                     , Name -> [Pat] -> Pat
conP Name
cn [Name -> Pat
VarP Name
hi', Name -> Pat
VarP Name
lo'] ]
                     (Exp -> Body
NormalB Exp
e) [Dec]
ds]
    funHiLo2XY' :: Name -> Exp -> [Dec] -> Dec
funHiLo2XY' Name
n Exp
e [Dec]
ds =
      Name -> [Clause] -> Dec
FunD Name
n [[Pat] -> Body -> [Dec] -> Clause
Clause [ Name -> Pat -> Pat
AsP Name
x (Name -> [Pat] -> Pat
conP Name
cn [Name -> Pat
VarP Name
hi, Name -> Pat
VarP Name
lo])
                     , Name -> Pat -> Pat
AsP Name
y (Name -> [Pat] -> Pat
conP Name
cn [Name -> Pat
VarP Name
hi', Name -> Pat
VarP Name
lo']) ]
                     (Exp -> Body
NormalB Exp
e) [Dec]
ds]
    funXHiLo :: Name -> Exp -> Dec
funXHiLo Name
n Exp
e  = Name -> [Clause] -> Dec
FunD Name
n [[Pat] -> Body -> [Dec] -> Clause
Clause [Name -> Pat
VarP Name
x, Name -> [Pat] -> Pat
conP Name
cn [Name -> Pat
VarP Name
hi, Name -> Pat
VarP Name
lo]]
                                   (Exp -> Body
NormalB Exp
e) []]
    match' :: Pat -> Exp -> [Dec] -> Match
match' Pat
p Exp
e [Dec]
ds = Pat -> Body -> [Dec] -> Match
Match Pat
p (Exp -> Body
NormalB Exp
e) [Dec]
ds
    match :: Pat -> Exp -> Match
match Pat
p Exp
e     = Pat -> Exp -> [Dec] -> Match
match' Pat
p Exp
e []
    inline :: Name -> Dec
inline Name
n = Pragma -> Dec
PragmaD (Pragma -> Dec) -> Pragma -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> Inline -> RuleMatch -> Phases -> Pragma
InlineP Name
n Inline
Inline RuleMatch
FunLike Phases
AllPhases
    inlinable :: Name -> Dec
inlinable Name
n = Pragma -> Dec
PragmaD (Pragma -> Dec) -> Pragma -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> Inline -> RuleMatch -> Phases -> Pragma
InlineP Name
n Inline
Inlinable RuleMatch
FunLike Phases
AllPhases
    val :: Name -> Exp -> Dec
val Name
n Exp
e   = Pat -> Body -> [Dec] -> Dec
ValD (Name -> Pat
VarP Name
n) (Exp -> Body
NormalB Exp
e) []
    vals :: [Name] -> Exp -> Dec
vals [Name]
ns Exp
e = Pat -> Body -> [Dec] -> Dec
ValD ([Pat] -> Pat
TupP (Name -> Pat
VarP (Name -> Pat) -> [Name] -> [Pat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
ns)) (Exp -> Body
NormalB Exp
e) []
    app :: Exp -> t Exp -> Exp
app Exp
f   = (Exp -> Exp -> Exp) -> Exp -> t Exp -> Exp
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Exp -> Exp -> Exp
AppE Exp
f
    appN :: Exp -> t Name -> Exp
appN Exp
f  = Exp -> t Exp -> Exp
forall (t :: * -> *). Foldable t => Exp -> t Exp -> Exp
app Exp
f (t Exp -> Exp) -> (t Name -> t Exp) -> t Name -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Exp) -> t Name -> t Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name -> Exp
VarE
    appV :: Name -> t Exp -> Exp
appV Name
f  = Exp -> t Exp -> Exp
forall (t :: * -> *). Foldable t => Exp -> t Exp -> Exp
app (Name -> Exp
VarE Name
f)
    appC :: Name -> t Exp -> Exp
appC Name
f  = Exp -> t Exp -> Exp
forall (t :: * -> *). Foldable t => Exp -> t Exp -> Exp
app (Name -> Exp
ConE Name
f)
    appW :: [Exp] -> Exp
appW    = Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appC Name
cn
    appVN :: Name -> t Name -> Exp
appVN Name
f = Exp -> t Name -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Exp -> t Name -> Exp
appN (Name -> Exp
VarE Name
f)
    appCN :: Name -> t Name -> Exp
appCN Name
f = Exp -> t Name -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Exp -> t Name -> Exp
appN (Name -> Exp
ConE Name
f)
    appWN :: [Name] -> Exp
appWN   = Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appCN Name
cn
    litI :: Integer -> Exp
litI = Lit -> Exp
LitE (Lit -> Exp) -> (Integer -> Lit) -> Integer -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Lit
IntegerL
    litS :: String -> Exp
litS = Lit -> Exp
LitE (Lit -> Exp) -> (String -> Lit) -> String -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Lit
StringL
    zeroE :: Exp
zeroE = Name -> Exp
VarE 'allZeroes
    oneE :: Exp
oneE  = Name -> Exp
VarE 'lsb
#if MIN_VERSION_base(4,7,0)
    loSizeE :: Exp
loSizeE = Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'finiteBitSize [Exp -> Type -> Exp
SigE (Name -> Exp
VarE 'undefined) Type
loT]
    hiSizeE :: Exp
hiSizeE = Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'finiteBitSize [Exp -> Type -> Exp
SigE (Name -> Exp
VarE 'undefined) Type
hiT]
    sizeE :: Exp
sizeE   = Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV 'finiteBitSize [Exp -> Type -> Exp
SigE (Name -> Exp
VarE 'undefined) Type
tpT]
#else
    loSizeE = appV 'bitSize [SigE (VarE 'undefined) loT]
    hiSizeE = appV 'bitSize [SigE (VarE 'undefined) hiT]
    sizeE   = appV 'bitSize [SigE (VarE 'undefined) tpT]
#endif
    singE :: Exp -> Exp
singE Exp
e = Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appC '(:) [Exp
e, Name -> Exp
ConE '[]]
    conP :: Name -> [Pat] -> Pat
conP Name
name [Pat]
ps =
      Name -> [Pat] -> Pat
ConP Name
name
#if MIN_VERSION_template_haskell(2,18,0)
           [] ps
#else
           [Pat]
ps
#endif
    ruleP :: String -> Exp -> Exp -> Phases -> Pragma
ruleP String
name Exp
lhs Exp
rhs Phases
phases =
      String
-> Maybe [TyVarBndr]
-> [RuleBndr]
-> Exp
-> Exp
-> Phases
-> Pragma
RuleP String
name
#if MIN_VERSION_template_haskell(2,15,0)
            Maybe [TyVarBndr]
forall a. Maybe a
Nothing
#endif
            [] Exp
lhs Exp
rhs Phases
phases
    mkRules :: Q [Dec]
mkRules = do
      let idRule :: Pragma
idRule = String -> Exp -> Exp -> Phases -> Pragma
ruleP (String
"fromIntegral/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
forall a. Show a => a -> String
show Name
tp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"->" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
forall a. Show a => a -> String
show Name
tp)
                         (Name -> Exp
VarE 'fromIntegral)
                         (Exp -> Type -> Exp
SigE (Name -> Exp
VarE 'id) (Type -> Type -> Type
AppT (Type -> Type -> Type
AppT Type
ArrowT Type
tpT) Type
tpT))
                         Phases
AllPhases
          signRule :: Pragma
signRule = String -> Exp -> Exp -> Phases -> Pragma
ruleP (String
"fromIntegral/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
forall a. Show a => a -> String
show Name
tp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"->" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
forall a. Show a => a -> String
show Name
otp)
                           (Name -> Exp
VarE 'fromIntegral)
                           (Exp -> Type -> Exp
SigE (Name -> Exp
VarE (if Bool
signed then 'unsignedWord
                                                  else 'signedWord))
                                 (Type -> Type -> Type
AppT (Type -> Type -> Type
AppT Type
ArrowT Type
tpT) (Name -> Type
ConT Name
otp)))
                           Phases
AllPhases
      [Pragma] -> Type -> Exp -> Exp -> Exp -> Q [Dec]
mkRules' [Pragma
idRule, Pragma
signRule] Type
loT
               (Name -> Exp
VarE 'loWord)
               (Name -> Exp
VarE 'extendLo)
               (Name -> Exp
VarE 'signExtendLo)
    mkRules' :: [Pragma] -> Type -> Exp -> Exp -> Exp -> Q [Dec]
mkRules' [Pragma]
rules Type
t Exp
narrowE Exp
extE Exp
signExtE = do
      let narrowRule :: Pragma
narrowRule = String -> Exp -> Exp -> Phases -> Pragma
ruleP (String
"fromIntegral/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
forall a. Show a => a -> String
show Name
tp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"->" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
showT Type
t)
                             (Name -> Exp
VarE 'fromIntegral)
                             (Exp -> Type -> Exp
SigE Exp
narrowE (Type -> Type -> Type
AppT (Type -> Type -> Type
AppT Type
ArrowT Type
tpT) Type
t))
                             Phases
AllPhases
          extRule :: Pragma
extRule = String -> Exp -> Exp -> Phases -> Pragma
ruleP (String
"fromIntegral/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
showT Type
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"->" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
forall a. Show a => a -> String
show Name
tp)
                          (Name -> Exp
VarE 'fromIntegral)
                          (Exp -> Type -> Exp
SigE Exp
extE (Type -> Type -> Type
AppT (Type -> Type -> Type
AppT Type
ArrowT Type
t) Type
tpT))
                          Phases
AllPhases
      [Pragma]
signedRules ← do
        [Dec]
insts ← Name -> Cxt -> Q [Dec]
reifyInstances ''SignedWord [Type
t]
        case [Dec]
insts of
#if MIN_VERSION_template_haskell(2,15,0)
          [TySynInstD (TySynEqn Maybe [TyVarBndr]
_ Type
_ Type
signT)] → [Pragma] -> Q [Pragma]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Pragma] -> Q [Pragma]) -> [Pragma] -> Q [Pragma]
forall a b. (a -> b) -> a -> b
$
#elif MIN_VERSION_template_haskell(2,9,0)
          [TySynInstD _ (TySynEqn _ signT)] → return $
#else
          [TySynInstD _ _ signT] → return $
#endif
            [ String -> Exp -> Exp -> Phases -> Pragma
ruleP (String
"fromIntegral/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
forall a. Show a => a -> String
show Name
tp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"->" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
showT Type
signT)
                    (Name -> Exp
VarE 'fromIntegral)
                    (Exp -> Type -> Exp
SigE (Exp -> Exp -> Exp
AppE (Name -> [Name] -> Exp
forall (t :: * -> *).
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(.) ['signedWord]) Exp
narrowE)
                          (Type -> Type -> Type
AppT (Type -> Type -> Type
AppT Type
ArrowT Type
tpT) Type
signT))
                    Phases
AllPhases
            , String -> Exp -> Exp -> Phases -> Pragma
ruleP (String
"fromIntegral/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
showT Type
signT String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"->" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
forall a. Show a => a -> String
show Name
tp)
                    (Name -> Exp
VarE 'fromIntegral)
                    (Exp -> Type -> Exp
SigE Exp
signExtE (Type -> Type -> Type
AppT (Type -> Type -> Type
AppT Type
ArrowT Type
signT) Type
tpT))
                    Phases
AllPhases ]
          [Dec]
_ → [Pragma] -> Q [Pragma]
forall (m :: * -> *) a. Monad m => a -> m a
return []
      let rules' :: [Pragma]
rules' = Pragma
narrowRule Pragma -> [Pragma] -> [Pragma]
forall a. a -> [a] -> [a]
: Pragma
extRule Pragma -> [Pragma] -> [Pragma]
forall a. a -> [a] -> [a]
: [Pragma]
signedRules [Pragma] -> [Pragma] -> [Pragma]
forall a. [a] -> [a] -> [a]
++ [Pragma]
rules
      case Type -> Maybe [(Name, Name)]
smallerStdTypes Type
t of
        Just [(Name, Name)]
ts → do
          let smallRules :: [Pragma]
smallRules = [(Name, Name)]
ts [(Name, Name)] -> ((Name, Name) -> [Pragma]) -> [Pragma]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Name
uSmallName, Name
sSmallName) →
                let uSmallT :: Type
uSmallT = Name -> Type
ConT Name
uSmallName
                    sSmallT :: Type
sSmallT = Name -> Type
ConT Name
sSmallName in
                [ String -> Exp -> Exp -> Phases -> Pragma
ruleP (String
"fromIntegral/" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                         Name -> String
forall a. Show a => a -> String
show Name
tp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"->" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
forall a. Show a => a -> String
show Name
uSmallName)
                        (Name -> Exp
VarE 'fromIntegral)
                        (Exp -> Type -> Exp
SigE (Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(.) [Name -> Exp
VarE 'fromIntegral, Exp
narrowE])
                              (Type -> Type -> Type
AppT (Type -> Type -> Type
AppT Type
ArrowT Type
tpT) Type
uSmallT))
                        Phases
AllPhases
                , String -> Exp -> Exp -> Phases -> Pragma
ruleP (String
"fromIntegral/" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                         Name -> String
forall a. Show a => a -> String
show Name
uSmallName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"->" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
forall a. Show a => a -> String
show Name
tp)
                        (Name -> Exp
VarE 'fromIntegral)
                        (Exp -> Type -> Exp
SigE (Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(.) [Exp
extE, Name -> Exp
VarE 'fromIntegral])
                              (Type -> Type -> Type
AppT (Type -> Type -> Type
AppT Type
ArrowT Type
uSmallT) Type
tpT))
                        Phases
AllPhases
                , String -> Exp -> Exp -> Phases -> Pragma
ruleP (String
"fromIntegral/" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                         Name -> String
forall a. Show a => a -> String
show Name
tp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"->" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
forall a. Show a => a -> String
show Name
sSmallName)
                        (Name -> Exp
VarE 'fromIntegral)
                        (Exp -> Type -> Exp
SigE (Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(.) [Name -> Exp
VarE 'fromIntegral, Exp
narrowE])
                              (Type -> Type -> Type
AppT (Type -> Type -> Type
AppT Type
ArrowT Type
tpT) Type
sSmallT))
                        Phases
AllPhases
                , String -> Exp -> Exp -> Phases -> Pragma
ruleP (String
"fromIntegral/" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                         Name -> String
forall a. Show a => a -> String
show Name
sSmallName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"->" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
forall a. Show a => a -> String
show Name
tp)
                        (Name -> Exp
VarE 'fromIntegral)
                        (Exp -> Type -> Exp
SigE (Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(.) [Exp
signExtE, Name -> Exp
VarE 'fromIntegral])
                              (Type -> Type -> Type
AppT (Type -> Type -> Type
AppT Type
ArrowT Type
sSmallT) Type
tpT))
                        Phases
AllPhases
                ]
          [Dec] -> Q [Dec]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Dec] -> Q [Dec]) -> [Dec] -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ Pragma -> Dec
PragmaD (Pragma -> Dec) -> [Pragma] -> [Dec]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pragma]
rules' [Pragma] -> [Pragma] -> [Pragma]
forall a. [a] -> [a] -> [a]
++ [Pragma]
smallRules
        Maybe [(Name, Name)]
_ → do
          [Dec]
insts ← Name -> Cxt -> Q [Dec]
reifyInstances ''LoWord [Type
t]
          case [Dec]
insts of
#if MIN_VERSION_template_haskell(2,15,0)
            [TySynInstD (TySynEqn Maybe [TyVarBndr]
_ Type
_ Type
t')] →
#elif MIN_VERSION_template_haskell(2,9,0)
            [TySynInstD _ (TySynEqn _ t')] →
#else
            [TySynInstD _ _ t'] →
#endif
              [Pragma] -> Type -> Exp -> Exp -> Exp -> Q [Dec]
mkRules' [Pragma]
rules' Type
t'
                       (Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(.) [Name -> Exp
VarE 'loWord, Exp
narrowE])
                       (Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(.) [Name -> Exp
VarE 'extendLo, Exp
extE])
                       (Name -> [Exp] -> Exp
forall (t :: * -> *). Foldable t => Name -> t Exp -> Exp
appV '(.) [Name -> Exp
VarE 'signExtendLo, Exp
signExtE])
            [Dec]
_ → [Dec] -> Q [Dec]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Dec] -> Q [Dec]) -> [Dec] -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ Pragma -> Dec
PragmaD (Pragma -> Dec) -> [Pragma] -> [Dec]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pragma]
rules'
    showT :: Type -> String
showT (ConT Name
n) = Name -> String
forall a. Show a => a -> String
show Name
n
    showT Type
t = Type -> String
forall a. Show a => a -> String
show Type
t
    stdTypes :: [(Name, Name)]
stdTypes = [(''Word64, ''Int64), (''Word32, ''Int32),
                (''Word16, ''Int16), (''Word8, ''Int8)]
    smallerStdTypes :: Type -> Maybe [(Name, Name)]
smallerStdTypes Type
t = Type -> [(Name, Name)] -> Maybe [(Name, Name)]
forall b. Type -> [(Name, b)] -> Maybe [(Name, b)]
smallerStdTypes' Type
t [(Name, Name)]
stdTypes
    smallerStdTypes' :: Type -> [(Name, b)] -> Maybe [(Name, b)]
smallerStdTypes' Type
_ [] = Maybe [(Name, b)]
forall a. Maybe a
Nothing
    smallerStdTypes' Type
t ((Name
ut, b
_) : [(Name, b)]
ts)
      | Name -> Type
ConT Name
ut Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
t = [(Name, b)] -> Maybe [(Name, b)]
forall a. a -> Maybe a
Just [(Name, b)]
ts
      | Bool
otherwise    = Type -> [(Name, b)] -> Maybe [(Name, b)]
smallerStdTypes' Type
t [(Name, b)]
ts