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

-- | Template Haskell utilities for generating short words declarations
module Data.ShortWord.TH
  ( mkShortWord
  ) where

import GHC.Arr (Ix(..))
import GHC.Enum (succError, predError, toEnumError)
import Data.Data
import Data.Proxy (Proxy(..))
import Data.Ratio ((%))
import Data.Bits (Bits(..))
import Data.Bits (FiniteBits(..))
#if MIN_VERSION_hashable(1,2,0)
import Data.Hashable (Hashable(..), hashWithSalt)
#else
import Data.Hashable (Hashable(..), combine)
#endif
import Data.Char (toLower)
import Data.List (union)
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>), (<*>))
#endif
import Language.Haskell.TH
import Language.Haskell.TH.Syntax (Module(..), ModName(..))
import Data.BinaryWord (BinaryWord(..))

-- | Declare signed and unsigned binary word types that use a subset
--   of the bits of the specified underlying type. For each data type
--   the following instances are declared: 'Typeable', 'Data', 'Eq', 'Ord',
--   'Bounded', 'Enum', 'Num', 'Real', 'Integral', 'Show', 'Read',
--   'Hashable', 'Ix', 'Bits', 'BinaryWord'.
mkShortWord ∷ String -- ^ Unsigned variant type name
            → String -- ^ Unsigned variant constructor name
            → String -- ^ Unsigned variant proxy name
            → String -- ^ Signed variant type name
            → String -- ^ Signed variant constructor name
            → String -- ^ Signed variant proxy name
            → Name   -- ^ The underlying (unsigned) type
            → Int    -- ^ The bit length
            → [Name] -- ^ List of instances for automatic derivation
            → Q [Dec]
mkShortWord :: String
-> String
-> String
-> String
-> String
-> String
-> Name
-> Int
-> [Name]
-> Q [Dec]
mkShortWord String
un String
uc String
upn String
sn String
sc String
spn Name
utp Int
bl [Name]
ad =
    forall a. [a] -> [a] -> [a]
(++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool
-> Name
-> Name
-> Name
-> Name
-> Name
-> Name
-> Int
-> [Name]
-> Q [Dec]
mkShortWord' Bool
False Name
un' Name
uc' Name
upn' Name
sn' Name
sc' Name
utp Int
bl [Name]
ad
         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool
-> Name
-> Name
-> Name
-> Name
-> Name
-> Name
-> Int
-> [Name]
-> Q [Dec]
mkShortWord' Bool
True  Name
sn' Name
sc' Name
spn' Name
un' Name
uc' Name
utp Int
bl [Name]
ad
  where un' :: Name
un'  = String -> Name
mkName String
un
        uc' :: Name
uc'  = String -> Name
mkName String
uc
        upn' :: Name
upn' = String -> Name
mkName String
upn
        sn' :: Name
sn'  = String -> Name
mkName String
sn
        sc' :: Name
sc'  = String -> Name
mkName String
sc
        spn' :: Name
spn' = String -> Name
mkName String
spn

mkShortWord' ∷ Bool
             → Name → Name
             → Name
             → Name → Name
             → Name
             → Int
             → [Name]
             → Q [Dec]
mkShortWord' :: Bool
-> Name
-> Name
-> Name
-> Name
-> Name
-> Name
-> Int
-> [Name]
-> Q [Dec]
mkShortWord' Bool
signed Name
tp Name
cn Name
pn Name
otp Name
ocn Name
utp Int
bl [Name]
ad = [Dec] -> Q [Dec]
returnDecls forall a b. (a -> b) -> a -> b
$
    [ Cxt
-> Name
-> [TyVarBndr ()]
-> Maybe Kind
-> Con
-> [DerivClause]
-> Dec
NewtypeD [] Name
tp []
#if MIN_VERSION_template_haskell(2,11,0)
               forall a. Maybe a
Nothing
               (Name -> [BangType] -> Con
NormalC Name
cn [(SourceUnpackedness -> SourceStrictness -> Bang
Bang SourceUnpackedness
NoSourceUnpackedness
                                  SourceStrictness
NoSourceStrictness,
                             Kind
uT)])
# if MIN_VERSION_template_haskell(2,12,0)
               [Maybe DerivStrategy -> Cxt -> DerivClause
DerivClause forall a. Maybe a
Nothing (Name -> Kind
ConT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Eq a => [a] -> [a] -> [a]
union [''Typeable] [Name]
ad)]
# else
               (ConT <$> union [''Typeable] ad)
# endif
#else
               (NormalC cn [(NotStrict, uT)])
               (union [''Typeable] ad)
#endif
    , Name -> Kind -> Dec
SigD Name
pn (Kind -> Kind -> Kind
AppT (Name -> Kind
ConT ''Proxy) Kind
tpT)
    , Name -> Exp -> Dec
fun Name
pn forall a b. (a -> b) -> a -> b
$ Name -> Exp
ConE 'Proxy
    , forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> [Dec] -> Dec
inst ''Eq [Name
tp] forall a b. (a -> b) -> a -> b
$
        {- (W x) == (W y) = x == y -}
        [ Name -> Exp -> Dec
funUn2 '(==) forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(==) [Name
x, Name
y]
        , Name -> Dec
inline '(==) ]
    , forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> [Dec] -> Dec
inst ''Ord [Name
tp]
        {- compare (W x) (W y) = x `compare` y -}
        [ Name -> Exp -> Dec
funUn2 'compare forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'compare [Name
x, Name
y]
        , Name -> Dec
inline 'compare ]
    , forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> [Dec] -> Dec
inst ''Bounded [Name
tp]
        {- minBound = W (minBound .&. MASK) -}
        [ Name -> Exp -> Dec
fun 'minBound forall a b. (a -> b) -> a -> b
$ Exp -> Exp
appW forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV '(.&.) [Name -> Exp
VarE 'minBound, Exp
maskE]
        , Name -> Dec
inline 'minBound
        {- maxBound = W (maxBound .&. MASK) -}
        , Name -> Exp -> Dec
fun 'maxBound forall a b. (a -> b) -> a -> b
$ Exp -> Exp
appW forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV '(.&.) [Name -> Exp
VarE 'maxBound, Exp
maskE]
        , Name -> Dec
inline 'maxBound ]
    , forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> [Dec] -> Dec
inst ''Enum [Name
tp]
        {-
          succ x@(W y) = if x == maxBound then succError "TYPE"
                                          else W (y + shiftL 1 SHIFT)
        -}
        [ Name -> Exp -> Dec
funUnAsX 'succ forall a b. (a -> b) -> a -> b
$
            Exp -> Exp -> Exp -> Exp
CondE (forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(==) [Name
x, 'maxBound])
                  (forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'succError [String -> Exp
litS (forall a. Show a => a -> String
show Name
tp)])
                  (Exp -> Exp
appW (forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV '(+) [Name -> Exp
VarE Name
y, forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'shiftL [Integer -> Exp
litI Integer
1, Exp
shiftE]]))
        , Name -> Dec
inlinable 'succ
        {-
          pred x@(W y) = if x == minBound then predError "TYPE"
                                          else W (y - shiftL 1 SHIFT)
        -}
        , Name -> Exp -> Dec
funUnAsX 'pred forall a b. (a -> b) -> a -> b
$
            Exp -> Exp -> Exp -> Exp
CondE (forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(==) [Name
x, 'minBound])
                  (forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'predError [String -> Exp
litS (forall a. Show a => a -> String
show Name
tp)])
                  (Exp -> Exp
appW (forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV '(-) [Name -> Exp
VarE Name
y, forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'shiftL [Integer -> Exp
litI Integer
1, Exp
shiftE]]))
        , Name -> Dec
inlinable 'pred
        {-
          toEnum x = if y < shiftR minBound SHIFT || y > shiftR maxBound SHIFT
                     then toEnumError "TYPE" x [minBound ∷ TYPE, maxBound ∷ TYPE]
                     else W (shiftL y SHIFT)
            where y = toEnum x
        -}
        , Name -> Exp -> [Dec] -> Dec
funX' 'toEnum
            (Exp -> Exp -> Exp -> Exp
CondE (forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV '(||) [ forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV '(<) [ Name -> Exp
VarE Name
y
                                           , forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'shiftR
                                                  [Name -> Exp
VarE 'minBound, Exp
shiftE]
                                           ]
                               , forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV '(>) [ Name -> Exp
VarE Name
y
                                           , forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'shiftR
                                                  [Name -> Exp
VarE 'maxBound, Exp
shiftE]
                                           ]
                               ])
                   (forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'toEnumError [ String -> Exp
litS (forall a. Show a => a -> String
show Name
tp)
                                      , Name -> Exp
VarE Name
x
                                      , [Exp] -> Exp
tup [ Exp -> Kind -> Exp
SigE (Name -> Exp
VarE 'minBound) Kind
tpT
                                            , Exp -> Kind -> Exp
SigE (Name -> Exp
VarE 'maxBound) Kind
tpT
                                            ]
                                      ])
                   (Exp -> Exp
appW forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'shiftL [Name -> Exp
VarE Name
y, Exp
shiftE]))
            [Name -> Exp -> Dec
val Name
y forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'toEnum [Name
x]]
        {- fromEnum (W x) = fromEnum (shiftR x SHIFT) -}
        , Name -> Exp -> Dec
funUn 'fromEnum forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'fromEnum [forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'shiftR [Name -> Exp
VarE Name
x, Exp
shiftE]]
        , Name -> Dec
inline 'fromEnum
        {- enumFrom x = enumFromTo x maxBound -}
        , Name -> Exp -> Dec
funX 'enumFrom forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$
            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 (forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(>=) [Name
x, Name
y]) (Name -> Exp
VarE 'maxBound) (Name -> Exp
VarE 'minBound)
              ]
        , Name -> Dec
inlinable 'enumFromThen
        {-
          enumFromTo x y = case y `compare` x of
              LT → x : down y x
              EQ → [x]
              GT → x : up y x
            where down to c = next : if next == to then [] else down to next
                    where next = c - 1
                  up to c = next : if next == to then [] else up to next
                    where next = c + 1 
        -}
        , Name -> [Clause] -> Dec
FunD 'enumFromTo forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall a b. (a -> b) -> a -> b
$
                 Exp -> [Match] -> Exp
CaseE (forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'compare [Name
y, Name
x])
                   [ Pat -> Body -> [Dec] -> Match
Match
                       (Name -> [Pat] -> Pat
con 'LT [])
                       (Exp -> Body
NormalB forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appC '(:) [Name -> Exp
VarE Name
x, forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN Name
down [Name
y, Name
x]])
                       []
                   , Pat -> Body -> [Dec] -> Match
Match
                       (Name -> [Pat] -> Pat
con 'EQ [])
                       (Exp -> Body
NormalB forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appC '(:) [Name -> Exp
VarE Name
x, Name -> Exp
ConE '[]])
                       []
                   , Pat -> Body -> [Dec] -> Match
Match
                       (Name -> [Pat] -> Pat
con 'GT [])
                       (Exp -> Body
NormalB forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appC '(:) [Name -> Exp
VarE Name
x, forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN Name
up [Name
y, Name
x]])
                       []
                   ])
              [ Name -> [Clause] -> Dec
FunD Name
down forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall a b. (a -> b) -> a -> b
$
                       forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appC '(:)
                         [ Name -> Exp
VarE Name
next
                         , Exp -> Exp -> Exp -> Exp
CondE (forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(==) [Name
next, Name
to])
                                 (Name -> Exp
ConE '[]) (forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN Name
down [Name
to, Name
next])
                         ])
                    [Pat -> Body -> [Dec] -> Dec
ValD (Name -> Pat
VarP Name
next)
                          (Exp -> Body
NormalB forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(-) [Name
c, 'lsb]) []]
              , Name -> [Clause] -> Dec
FunD Name
up forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall a b. (a -> b) -> a -> b
$
                       forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appC '(:)
                         [ Name -> Exp
VarE Name
next
                         , Exp -> Exp -> Exp -> Exp
CondE (forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(==) [Name
next, Name
to])
                                 (Name -> Exp
ConE '[]) (forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN Name
up [Name
to, Name
next])
                         ])
                    [Pat -> Body -> [Dec] -> Dec
ValD (Name -> Pat
VarP Name
next)
                          (Exp -> Body
NormalB forall a b. (a -> b) -> a -> b
$ 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 > x then [] else down (x - y) z x
              EQ → repeat x
              GT → if z < x then [] else up (y - x) z x
            where down s to c = c : if next < to then [] else down s to next
                    where next = c - s
                  up s to c = c : if next > to then [] else up s to next
                    where next = c + s 
        -}
        , Name -> [Clause] -> Dec
FunD 'enumFromThenTo forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall a b. (a -> b) -> a -> b
$
                Exp -> [Match] -> Exp
CaseE (forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'compare [Name
y, Name
x])
                  [ Pat -> Body -> [Dec] -> Match
Match
                      (Name -> [Pat] -> Pat
con 'LT [])
                      (Exp -> Body
NormalB forall a b. (a -> b) -> a -> b
$
                         Exp -> Exp -> Exp -> Exp
CondE (forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(>) [Name
z, Name
x])
                               (Name -> Exp
ConE '[])
                               (forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV Name
down [forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(-) [Name
x, Name
y], Name -> Exp
VarE Name
z, Name -> Exp
VarE Name
x]))
                      []
                  , Pat -> Body -> [Dec] -> Match
Match (Name -> [Pat] -> Pat
con 'EQ []) (Exp -> Body
NormalB forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'repeat [Name
x]) []
                  , Pat -> Body -> [Dec] -> Match
Match
                      (Name -> [Pat] -> Pat
con 'GT [])
                      (Exp -> Body
NormalB forall a b. (a -> b) -> a -> b
$
                         Exp -> Exp -> Exp -> Exp
CondE (forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(<) [Name
z, Name
x]) (Name -> Exp
ConE '[])
                               (forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV Name
up [forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(-) [Name
y, Name
x], Name -> Exp
VarE Name
z, Name -> Exp
VarE Name
x]))
                      []
                  ])
              [ Name -> [Clause] -> Dec
FunD Name
down forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
                  [Pat] -> Body -> [Dec] -> Clause
Clause [Name -> Pat
VarP Name
step, Name -> Pat
VarP Name
to, Name -> Pat
VarP Name
c]
                    (Exp -> Body
NormalB forall a b. (a -> b) -> a -> b
$
                       forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appC '(:)
                         [ Name -> Exp
VarE Name
c
                         , Exp -> Exp -> Exp -> Exp
CondE (forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(<) [Name
next, Name
to])
                                 (Name -> Exp
ConE '[]) (forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN Name
down [Name
step, Name
to, Name
next])
                         ])
                    [Pat -> Body -> [Dec] -> Dec
ValD (Name -> Pat
VarP Name
next) (Exp -> Body
NormalB forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(-) [Name
c, Name
step]) []]
              , Name -> [Clause] -> Dec
FunD Name
up forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
                  [Pat] -> Body -> [Dec] -> Clause
Clause [Name -> Pat
VarP Name
step, Name -> Pat
VarP Name
to, Name -> Pat
VarP Name
c]
                    (Exp -> Body
NormalB forall a b. (a -> b) -> a -> b
$
                       forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appC '(:)
                         [ Name -> Exp
VarE Name
c
                         , Exp -> Exp -> Exp -> Exp
CondE (forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(==) [Name
next, Name
to])
                                 (Name -> Exp
ConE '[]) (forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN Name
up [Name
step, Name
to, Name
next])
                         ])
                    [Pat -> Body -> [Dec] -> Dec
ValD (Name -> Pat
VarP Name
next) (Exp -> Body
NormalB forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(+) [Name
c, Name
step]) []]]
        ]
    , forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> [Dec] -> Dec
inst ''Num [Name
tp]
        {- negate (W x) = W (negate x) -}
        [ Name -> Exp -> Dec
funUn 'negate forall a b. (a -> b) -> a -> b
$ Exp -> Exp
appW forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'negate [Name
x]
        , Name -> Dec
inline 'negate
        {- 
          abs x@(W y) = if SIGNED
                        then if y < 0 then W (negate y) else x 
                        else x
        -}
        , if Bool
signed
          then Name -> Exp -> Dec
funUnAsX 'abs forall a b. (a -> b) -> a -> b
$
                 Exp -> Exp -> Exp -> Exp
CondE (forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(<) [Name
y, 'allZeroes])
                       (Exp -> Exp
appW forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'negate [Name
y]) (Name -> Exp
VarE Name
x)
          else Name -> Exp -> Dec
funX 'abs forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE Name
x
        , if Bool
signed then Name -> Dec
inlinable 'abs else Name -> Dec
inline 'abs
        {- signum (W x) = W (shiftL (signum x) SHIFT) -}
        , Name -> Exp -> Dec
funUn 'signum forall a b. (a -> b) -> a -> b
$ Exp -> Exp
appW forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'shiftL [forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'signum [Name
x], Exp
shiftE]
        , Name -> Dec
inline 'signum
        {- (W x) + (W y) = W (x + y) -}
        , Name -> Exp -> Dec
funUn2 '(+) forall a b. (a -> b) -> a -> b
$ Exp -> Exp
appW forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(+) [Name
x, Name
y]
        , Name -> Dec
inline '(+)
        {- (W x) * (W y) = W (shiftR x SHIFT * y) -}
        , Name -> Exp -> Dec
funUn2 '(*) forall a b. (a -> b) -> a -> b
$
            Exp -> Exp
appW forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV '(*) [forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'shiftR [Name -> Exp
VarE Name
x, Exp
shiftE], Name -> Exp
VarE Name
y]
        , Name -> Dec
inline '(*)
        {- fromInteger x = W (shiftL (fromInteger x) SHIFT) -}
        , Name -> Exp -> Dec
funX 'fromInteger forall a b. (a -> b) -> a -> b
$
            Exp -> Exp
appW forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'shiftL [forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'fromInteger [Name
x], Exp
shiftE]
        , Name -> Dec
inline 'fromInteger
        ]
    , 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 forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV '(%) [forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'toInteger [Name
x], Integer -> Exp
litI Integer
1]
        , Name -> Dec
inline 'toRational ]
    , forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> [Dec] -> Dec
inst ''Integral [Name
tp] forall a b. (a -> b) -> a -> b
$
        {- toInteger (W x) = toInteger (shiftR x SHIFT) -}
        [ Name -> Exp -> Dec
funUn 'toInteger forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'toInteger [forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'shiftR [Name -> Exp
VarE Name
x, Exp
shiftE]]
        , Name -> Dec
inline 'toInteger
        {-
           quotRem (W x) (W y) = (W (shiftL q SHIFT), W r)
             where (q, r) = quotRem x y
        -}
        , Name -> Exp -> [Dec] -> Dec
funUn2' 'quotRem
            ([Exp] -> Exp
tup [Exp -> Exp
appW (forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'shiftL [Name -> Exp
VarE Name
q, Exp
shiftE]), Name -> Exp
appWN Name
r])
            [[Name] -> Exp -> Dec
vals [Name
q, Name
r] forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'quotRem [Name
x, Name
y]]
        , Name -> Dec
inline 'quotRem
        {-
           divMod (W x) (W y) = (W (shiftL q SHIFT), W r)
             where (q, r) = divMod x y
        -}
        , Name -> Exp -> [Dec] -> Dec
funUn2' 'divMod
            ([Exp] -> Exp
tup [Exp -> Exp
appW (forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'shiftL [Name -> Exp
VarE Name
q, Exp
shiftE]), Name -> Exp
appWN Name
r])
            [[Name] -> Exp -> Dec
vals [Name
q, Name
r] forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'divMod [Name
x, Name
y]]
        , Name -> Dec
inline 'divMod
        ]
    , forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> [Dec] -> Dec
inst ''Show [Name
tp]
        [ {- show (W x) = show (shiftR x SHIFT) -}
          Name -> Exp -> Dec
funUn 'show forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'show [forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'shiftR [Name -> Exp
VarE Name
x, Exp
shiftE]]
        , Name -> Dec
inline 'show ]
    , 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 forall a b. (a -> b) -> a -> b
$
            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 [forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'fromInteger [Name
q], Name -> Exp
VarE Name
r])
                       , forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'readsPrec [Name
x, Name
y] ]
        ]
    , 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 y) = x `hashWithSalt` y -}
        [ Name -> Exp -> Dec
funXUn 'hashWithSalt forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'hashWithSalt [Name
x, Name
y]
#else
        {- hash (W x) = hash x -}
        [ funUn 'hash $ appVN 'hash [x]
        , inline 'hash
#endif
        , Name -> Dec
inline 'hashWithSalt ]
    , 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 forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$
            forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV '(-) [forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'fromIntegral [Name
z], 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 forall a b. (a -> b) -> a -> b
$
            forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV '(&&) [forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(>=) [Name
z, Name
x], forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(<=) [Name
z, Name
y]]
        , Name -> Dec
inline 'inRange ]
    , forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> [Dec] -> Dec
inst ''Bits [Name
tp] forall a b. (a -> b) -> a -> b
$
        {- bitSize _ = SIZE -}
        [ Name -> Exp -> Dec
fun_ 'bitSize forall a b. (a -> b) -> a -> b
$ Exp
sizeE
        , Name -> Dec
inline 'bitSize
        {- bitSizeMaybe _ = Just SIZE -}
        , Name -> Exp -> Dec
fun_ 'bitSizeMaybe forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}. Foldable t => Exp -> t Exp -> Exp
app (Name -> Exp
ConE 'Just) [Exp
sizeE]
        , Name -> Dec
inline 'bitSizeMaybe
        {- isSigned _ = SIGNED -}
        , Name -> Exp -> Dec
fun_ 'isSigned forall a b. (a -> b) -> a -> b
$ Name -> Exp
ConE forall a b. (a -> b) -> a -> b
$ if Bool
signed then 'True else 'False
        , Name -> Dec
inline 'isSigned
        {- complement (W x) = W (complement x .&. MASK) -}
        , Name -> Exp -> Dec
funUn 'complement forall a b. (a -> b) -> a -> b
$
            Exp -> Exp
appW forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV '(.&.) [forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'complement [Name
x], Exp
maskE]
        , Name -> Dec
inline 'complement
        {- xor (W x) (W y) = W (xor x y) -}
        , Name -> Exp -> Dec
funUn2 'xor forall a b. (a -> b) -> a -> b
$ Exp -> Exp
appW forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'xor [Name
x, Name
y]
        , Name -> Dec
inline 'xor
        {- (W x) .&. (W y) = W (x .&. y) -}
        , Name -> Exp -> Dec
funUn2 '(.&.) forall a b. (a -> b) -> a -> b
$ Exp -> Exp
appW forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(.&.) [Name
x, Name
y]
        , Name -> Dec
inline '(.&.)
        {- (W x) .|. (W y) = W (x .|. y) -}
        , Name -> Exp -> Dec
funUn2 '(.|.) forall a b. (a -> b) -> a -> b
$ Exp -> Exp
appW forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN '(.|.) [Name
x, Name
y]
        , Name -> Dec
inline '(.|.)
        {- shiftL (W x) y = W (shiftL x y) -}
        , Name -> Exp -> Dec
funUnY 'shiftL forall a b. (a -> b) -> a -> b
$ Exp -> Exp
appW forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'shiftL [Name
x, Name
y]
        , Name -> Dec
inline 'shiftL
        {- shiftR (W x) y = W (shiftR x y .&. MASK) -}
        , Name -> Exp -> Dec
funUnY 'shiftR forall a b. (a -> b) -> a -> b
$ Exp -> Exp
appW forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV '(.&.) [forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'shiftR [Name
x, Name
y], Exp
maskE]
        , Name -> Dec
inline 'shiftR
        {-
           UNSIGNED:
             rotateL (W x) y = W (shiftL x y .|.
                                  (shiftR x (SIZE - y) .&. MASK))

           SIGNED:
             rotateL (W x) y =
               W (shiftL x y .|.
                  (signedWord (shiftR (unsignedWord x) (SIZE - y)) .&.
                   MASK))
        -}
        , Name -> Exp -> Dec
funUnY 'rotateL forall a b. (a -> b) -> a -> b
$ Exp -> Exp
appW forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV '(.|.) forall a b. (a -> b) -> a -> b
$ (forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'shiftL [Name
x, Name
y] forall a. a -> [a] -> [a]
:) forall a b. (a -> b) -> a -> b
$
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV '(.&.) forall a b. (a -> b) -> a -> b
$
              [ if Bool
signed
                then forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'signedWord [ forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'shiftR
                                             [ forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'unsignedWord [Name
x]
                                             , forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV '(-) [Exp
sizeE, Name -> Exp
VarE Name
y]
                                             ]
                                      ]
                else forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'shiftR [Name -> Exp
VarE Name
x, forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV '(-) [Exp
sizeE, Name -> Exp
VarE Name
y]]
              , Exp
maskE
              ]
        , Name -> Dec
inline 'rotateL
        {- rotateR x y = rotateL x (SIZE - y) -}
        , Name -> Exp -> Dec
funXY 'rotateR forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'rotateL [Name -> Exp
VarE Name
x, forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV '(-) [Exp
sizeE, Name -> Exp
VarE Name
y]]
        , Name -> Dec
inline 'rotateR
        {- bit x = W (bit (x + SHIFT)) -}
        , Name -> Exp -> Dec
funX 'bit forall a b. (a -> b) -> a -> b
$ Exp -> Exp
appW forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'bit [forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV '(+) [Name -> Exp
VarE Name
x, Exp
shiftE]]
        , Name -> Dec
inline 'bit
        {- setBit (W x) y = W (setBit x (y + SHIFT)) -}
        , Name -> Exp -> Dec
funUnY 'setBit forall a b. (a -> b) -> a -> b
$
            Exp -> Exp
appW forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'setBit [Name -> Exp
VarE Name
x, forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV '(+) [Name -> Exp
VarE Name
y, Exp
shiftE]]
        , Name -> Dec
inline 'setBit
        {- clearBit (W x) y = W (clearBit x (y + SHIFT)) -}
        , Name -> Exp -> Dec
funUnY 'clearBit forall a b. (a -> b) -> a -> b
$
            Exp -> Exp
appW forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'clearBit [Name -> Exp
VarE Name
x, forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV '(+) [Name -> Exp
VarE Name
y, Exp
shiftE]]
        , Name -> Dec
inline 'clearBit
        {- complementBit (W x) y = W (complementBit x (y + SHIFT)) -}
        , Name -> Exp -> Dec
funUnY 'complementBit forall a b. (a -> b) -> a -> b
$
            Exp -> Exp
appW forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'complementBit [Name -> Exp
VarE Name
x, forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV '(+) [Name -> Exp
VarE Name
y, Exp
shiftE]]
        , Name -> Dec
inline 'complementBit
        {- testBit (W x) y = testBit x (y + SHIFT) -}
        , Name -> Exp -> Dec
funUnY 'testBit forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'testBit [Name -> Exp
VarE Name
x, forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV '(+) [Name -> Exp
VarE Name
y, Exp
shiftE]]
        , Name -> Dec
inline 'testBit
        {- popCount (W x) = popCount x -}
        , Name -> Exp -> Dec
funUn 'popCount forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'popCount [Name
x]
        , Name -> Dec
inline 'popCount
        ]
    , forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> [Dec] -> Dec
inst ''FiniteBits [Name
tp]
        {- finiteBitSize _ = SIZE -}
        [ Name -> Exp -> Dec
fun_ 'finiteBitSize forall a b. (a -> b) -> a -> b
$ Exp
sizeE
        , Name -> Dec
inline 'finiteBitSize
# if MIN_VERSION_base(4,8,0)
        {- countLeadingZeros = leadingZeroes -}
        , Name -> Exp -> Dec
fun 'countLeadingZeros forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'leadingZeroes
        , Name -> Dec
inline 'countLeadingZeros
        {- countTrailingZeros = trailingZeroes -}
        , Name -> Exp -> Dec
fun 'countTrailingZeros forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'trailingZeroes
        , Name -> Dec
inline 'countTrailingZeros
# endif
        ]
    , forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> [Dec] -> Dec
inst ''BinaryWord [Name
tp]
        [ forall {t :: * -> *}. Foldable t => Name -> t Kind -> Kind -> Dec
tySynInst ''UnsignedWord [Kind
tpT] forall a b. (a -> b) -> a -> b
$
            Name -> Kind
ConT forall a b. (a -> b) -> a -> b
$ if Bool
signed then Name
otp else Name
tp
        , forall {t :: * -> *}. Foldable t => Name -> t Kind -> Kind -> Dec
tySynInst ''SignedWord [Kind
tpT] forall a b. (a -> b) -> a -> b
$
            Name -> Kind
ConT forall a b. (a -> b) -> a -> b
$ if Bool
signed then Name
tp else Name
otp
        {-
          UNSIGNED:
            unsignedWord = id
          
          SIGNED:
            unsignedWord (W x) = U (unsignedWord x)
        -}
        , if Bool
signed
          then Name -> Exp -> Dec
funUn 'unsignedWord forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appC Name
ocn [forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'unsignedWord [Name
x]]
          else Name -> Exp -> Dec
fun 'unsignedWord forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'id
        , Name -> Dec
inline 'unsignedWord
        {-
          UNSIGNED:
            signedWord (W x) = S (signedWord hi)
          
          SIGNED:
            signedWord = id
        -}
        , if Bool
signed
          then Name -> Exp -> Dec
fun 'signedWord forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE 'id
          else Name -> Exp -> Dec
funUn 'signedWord forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appC Name
ocn [forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'signedWord [Name
x]]
        , Name -> Dec
inline 'signedWord
        {-
          unwrappedAdd (W x) (W y) = (W (shiftL t1 SHIFT),
                                      U (unsignedWord t2))
            where (t1, t2) = unwrappedAdd x y
        -}
        , Name -> Exp -> [Dec] -> Dec
funUn2' 'unwrappedAdd
            ([Exp] -> Exp
tup [ Exp -> Exp
appW (forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'shiftL [Name -> Exp
VarE Name
t1, Exp
shiftE])
                 , forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appC (if Bool
signed then Name
ocn else Name
cn)
                        [forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'unsignedWord [Name
t2]]
                 ])
            [[Name] -> Exp -> Dec
vals [Name
t1, Name
t2] forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'unwrappedAdd [Name
x, Name
y]]
        , Name -> Dec
inline 'unwrappedAdd
        {-
          unwrappedMul (W x) (W y) = (W (shiftL t1 SHIFT),
                                      U (unsignedWord t2))
            where (t1, t2) = unwrappedMul (shiftR x SHIFT) y
        -}
        , Name -> Exp -> [Dec] -> Dec
funUn2' 'unwrappedMul
            ([Exp] -> Exp
tup [ Exp -> Exp
appW (forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'shiftL [Name -> Exp
VarE Name
t1, Exp
shiftE])
                 , forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appC (if Bool
signed then Name
ocn else Name
cn)
                        [forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'unsignedWord [Name
t2]]
                 ])
            [[Name] -> Exp -> Dec
vals [Name
t1, Name
t2] forall a b. (a -> b) -> a -> b
$
               forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'unwrappedMul [forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'shiftR [Name -> Exp
VarE Name
x, Exp
shiftE], Name -> Exp
VarE Name
y]]
        , Name -> Dec
inline 'unwrappedMul
        {- leadingZeroes (W x) = leadingZeroes (x .|. complement MASK) -}
        , Name -> Exp -> Dec
funUn 'leadingZeroes forall a b. (a -> b) -> a -> b
$
            forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'leadingZeroes [forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV '(.|.)
                                      [Name -> Exp
VarE Name
x, forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'complement [Exp
maskE]]]
        , Name -> Dec
inline 'leadingZeroes
        {- trailingZeroes (W x) = trailingZeroes x - SHIFT -}
        , Name -> Exp -> Dec
funUn 'trailingZeroes forall a b. (a -> b) -> a -> b
$
            forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV '(-) [forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'trailingZeroes [Name
x], Exp
shiftE]
        , Name -> Dec
inline 'trailingZeroes
        {- allZeroes = W allZeroes -}
        , Name -> Exp -> Dec
fun 'allZeroes forall a b. (a -> b) -> a -> b
$ Name -> Exp
appWN 'allZeroes
        , Name -> Dec
inline 'allZeroes
        {- allOnes = W (allOnes .&. MASK) -}
        , Name -> Exp -> Dec
fun 'allOnes forall a b. (a -> b) -> a -> b
$ Exp -> Exp
appW forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV '(.&.) [Name -> Exp
VarE 'allOnes, Exp
maskE]
        , Name -> Dec
inline 'allOnes
        {- msb = W msb -}
        , Name -> Exp -> Dec
fun 'msb forall a b. (a -> b) -> a -> b
$ Name -> Exp
appWN 'msb
        , Name -> Dec
inline 'msb
        {- lsb = W (shiftL lsb SHIFT) -}
        , Name -> Exp -> Dec
fun 'lsb forall a b. (a -> b) -> a -> b
$ Exp -> Exp
appW forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'shiftL [Name -> Exp
VarE 'lsb, Exp
shiftE]
        , Name -> Dec
inline 'lsb
        {- testMsb (W x) = testMsb x -}
        , Name -> Exp -> Dec
funUn 'testMsb forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'testMsb [Name
x]
        , Name -> Dec
inline 'testMsb
        {- testLsb (W x) = testBit x SHIFT -}
        , Name -> Exp -> Dec
funUn 'testLsb forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'testBit [Name -> Exp
VarE Name
x, Exp
shiftE]
        , Name -> Dec
inline 'testLsb
        {- setMsb (W x) = W (setMsb x) -}
        , Name -> Exp -> Dec
funUn 'setMsb forall a b. (a -> b) -> a -> b
$ Exp -> Exp
appW forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'setMsb [Name
x]
        , Name -> Dec
inline 'setMsb
        {- setLsb (W x) = W (setBit x SHIFT) -}
        , Name -> Exp -> Dec
funUn 'setLsb forall a b. (a -> b) -> a -> b
$ Exp -> Exp
appW forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'setBit [Name -> Exp
VarE Name
x, Exp
shiftE]
        , Name -> Dec
inline 'setLsb
        {- clearMsb (W x) = W (clearMsb x) -}
        , Name -> Exp -> Dec
funUn 'clearMsb forall a b. (a -> b) -> a -> b
$ Exp -> Exp
appW forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'clearMsb [Name
x]
        , Name -> Dec
inline 'clearMsb
        {- clearLsb (W x) = W (clearBit x SHIFT) -}
        , Name -> Exp -> Dec
funUn 'clearLsb forall a b. (a -> b) -> a -> b
$ Exp -> Exp
appW forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'clearBit [Name -> Exp
VarE Name
x, Exp
shiftE]
        , Name -> Dec
inline 'clearLsb
        ]
    , String -> Exp -> Exp -> Dec
rule (String
"fromIntegral/" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Name
tp forall a. [a] -> [a] -> [a]
++ String
"->" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Name
tp)
           (Name -> Exp
VarE 'fromIntegral)
           (Exp -> Kind -> Exp
SigE (Name -> Exp
VarE 'id) (Kind -> Kind -> Kind
AppT (Kind -> Kind -> Kind
AppT Kind
ArrowT Kind
tpT) Kind
tpT))
    , String -> Exp -> Exp -> Dec
rule (String
"fromIntegral/" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Name
tp forall a. [a] -> [a] -> [a]
++ String
"->" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Name
otp)
           (Name -> Exp
VarE 'fromIntegral)
           (Exp -> Kind -> Exp
SigE (Name -> Exp
VarE forall a b. (a -> b) -> a -> b
$ if Bool
signed then 'unsignedWord else 'signedWord)
                 (Kind -> Kind -> Kind
AppT (Kind -> Kind -> Kind
AppT Kind
ArrowT Kind
tpT) (Name -> Kind
ConT Name
otp)))
    , String -> Exp -> Exp -> Dec
rule (String
"fromIntegral/" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Name
tp forall a. [a] -> [a] -> [a]
++ String
"->a")
           (Name -> Exp
VarE 'fromIntegral)
           ([Dec] -> Exp -> Exp
LetE [Name -> Exp -> Dec
funUn Name
fn forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'fromIntegral
                                  [forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'shiftR [Name -> Exp
VarE Name
x, Exp
shiftE]]]
                 (Name -> Exp
VarE Name
fn))
    , String -> Exp -> Exp -> Dec
rule (String
"fromIntegral/a->" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Name
tp)
           (Name -> Exp
VarE 'fromIntegral)
           (forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV '(.) [ forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV '(.) [ Name -> Exp
ConE Name
tp
                                  , forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'flip [Name -> Exp
VarE 'shiftL, Exp
shiftE] ]
                      , Name -> Exp
VarE 'fromIntegral ])
    ]
  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"
    q :: Name
q    = String -> Name
mkName String
"q"
    r :: Name
r    = String -> Name
mkName String
"r"
    t1 :: Name
t1   = String -> Name
mkName String
"t1"
    t2 :: Name
t2   = String -> Name
mkName String
"t2"
    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_"
    fn :: Name
fn   = String -> Name
mkName String
"fn_"
    uT :: Kind
uT   | Bool
signed    = Kind -> Kind -> Kind
AppT (Name -> Kind
ConT ''SignedWord) (Name -> Kind
ConT Name
utp)
         | Bool
otherwise = Kind -> Kind -> Kind
AppT (Name -> Kind
ConT ''UnsignedWord) (Name -> Kind
ConT Name
utp)
    tpT :: Kind
tpT  = Name -> Kind
ConT Name
tp
    tySynInst :: Name -> t Kind -> Kind -> Dec
tySynInst Name
n t Kind
ps Kind
t =
#if MIN_VERSION_template_haskell(2,15,0)
      TySynEqn -> Dec
TySynInstD (Maybe [TyVarBndr ()] -> Kind -> Kind -> TySynEqn
TySynEqn forall a. Maybe a
Nothing (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Kind -> Kind -> Kind
AppT (Name -> Kind
ConT Name
n) t Kind
ps) Kind
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 -> Kind -> [Dec] -> Dec
InstanceD 
#if MIN_VERSION_template_haskell(2,11,0)
                                forall a. Maybe a
Nothing
#endif
                                [] (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Kind -> Kind -> Kind
AppT (Name -> Kind
ConT Name
cls) (Name -> Kind
ConT 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) []]
    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) []]
    funUn' :: Name -> Exp -> [Dec] -> Dec
funUn' Name
n Exp
e [Dec]
ds  =
      Name -> [Clause] -> Dec
FunD Name
n [[Pat] -> Body -> [Dec] -> Clause
Clause [Name -> [Pat] -> Pat
con Name
cn [Name -> Pat
VarP Name
x]] (Exp -> Body
NormalB Exp
e) [Dec]
ds]
    funUn :: Name -> Exp -> Dec
funUn Name
n Exp
e      = Name -> Exp -> [Dec] -> Dec
funUn' Name
n Exp
e []
    funUnAsX' :: Name -> Exp -> [Dec] -> Dec
funUnAsX' 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
con Name
cn [Name -> Pat
VarP Name
y])]
                                      (Exp -> Body
NormalB Exp
e) [Dec]
ds]
    funUnAsX :: Name -> Exp -> Dec
funUnAsX Name
n Exp
e     = Name -> Exp -> [Dec] -> Dec
funUnAsX' Name
n Exp
e []
    funUn2' :: Name -> Exp -> [Dec] -> Dec
funUn2' Name
n Exp
e [Dec]
ds =
      Name -> [Clause] -> Dec
FunD Name
n [[Pat] -> Body -> [Dec] -> Clause
Clause [Name -> [Pat] -> Pat
con Name
cn [Name -> Pat
VarP Name
x], Name -> [Pat] -> Pat
con Name
cn [Name -> Pat
VarP Name
y]] (Exp -> Body
NormalB Exp
e) [Dec]
ds]
    funUn2 :: Name -> Exp -> Dec
funUn2 Name
n Exp
e     = Name -> Exp -> [Dec] -> Dec
funUn2' Name
n Exp
e []
    funXUn' :: Name -> Exp -> [Dec] -> Dec
funXUn' Name
n Exp
e [Dec]
ds =
      Name -> [Clause] -> Dec
FunD Name
n [[Pat] -> Body -> [Dec] -> Clause
Clause [Name -> Pat
VarP Name
x, Name -> [Pat] -> Pat
con Name
cn [Name -> Pat
VarP Name
y]] (Exp -> Body
NormalB Exp
e) [Dec]
ds]
    funXUn :: Name -> Exp -> Dec
funXUn Name
n Exp
e     = Name -> Exp -> [Dec] -> Dec
funXUn' Name
n Exp
e []
    funUnY' :: Name -> Exp -> [Dec] -> Dec
funUnY' Name
n Exp
e [Dec]
ds =
      Name -> [Clause] -> Dec
FunD Name
n [[Pat] -> Body -> [Dec] -> Clause
Clause [Name -> [Pat] -> Pat
con Name
cn [Name -> Pat
VarP Name
x], Name -> Pat
VarP Name
y] (Exp -> Body
NormalB Exp
e) [Dec]
ds]
    funUnY :: Name -> Exp -> Dec
funUnY Name
n Exp
e     = Name -> Exp -> [Dec] -> Dec
funUnY' Name
n 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) []]
    fun_ZC :: Name -> Exp -> Dec
fun_ZC Name
n Exp
e     = Name -> [Clause] -> Dec
FunD Name
n [[Pat] -> Body -> [Dec] -> Clause
Clause [Pat
WildP, Name -> Pat
VarP Name
z, Name -> Pat
VarP Name
c] (Exp -> Body
NormalB Exp
e) []]
    inline :: Name -> Dec
inline Name
n = Pragma -> Dec
PragmaD 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 forall a b. (a -> b) -> a -> b
$ Name -> Inline -> RuleMatch -> Phases -> Pragma
InlineP Name
n Inline
Inlinable RuleMatch
FunLike Phases
AllPhases
    rule :: String -> Exp -> Exp -> Dec
rule String
n Exp
m Exp
e =
#if MIN_VERSION_template_haskell(2,15,0)
      Pragma -> Dec
PragmaD forall a b. (a -> b) -> a -> b
$ String
-> Maybe [TyVarBndr ()]
-> [RuleBndr]
-> Exp
-> Exp
-> Phases
-> Pragma
RuleP String
n forall a. Maybe a
Nothing [] Exp
m Exp
e Phases
AllPhases
#else
      PragmaD $ RuleP n [] m e AllPhases
#endif
    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 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   = 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  = forall {t :: * -> *}. Foldable t => Exp -> t Exp -> Exp
app Exp
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name -> Exp
VarE
    appV :: Name -> t Exp -> Exp
appV Name
f  = forall {t :: * -> *}. Foldable t => Exp -> t Exp -> Exp
app (Name -> Exp
VarE Name
f)
    appC :: Name -> t Exp -> Exp
appC Name
f  = forall {t :: * -> *}. Foldable t => Exp -> t Exp -> Exp
app (Name -> Exp
ConE Name
f)
    appW :: Exp -> Exp
appW Exp
e  = forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appC Name
cn [Exp
e]
    appVN :: Name -> t Name -> Exp
appVN Name
f = forall {t :: * -> *}.
(Foldable t, Functor t) =>
Exp -> t Name -> Exp
appN (Name -> Exp
VarE Name
f)
    appCN :: Name -> t Name -> Exp
appCN Name
f = forall {t :: * -> *}.
(Foldable t, Functor t) =>
Exp -> t Name -> Exp
appN (Name -> Exp
ConE Name
f)
    appWN :: Name -> Exp
appWN Name
e = forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appCN Name
cn [Name
e]
    litI :: Integer -> Exp
litI = Lit -> Exp
LitE forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Lit
IntegerL
    litS :: String -> Exp
litS = Lit -> Exp
LitE forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Lit
StringL
    sizeE :: Exp
sizeE = Integer -> Exp
litI forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> Integer
toInteger Int
bl
    shiftE :: Exp
shiftE = forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV '(-)
               [ forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'finiteBitSize [Exp -> Kind -> Exp
SigE (Name -> Exp
VarE 'undefined) Kind
uT]
               , Exp
sizeE ]
    maskE :: Exp
maskE = forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'shiftL [Name -> Exp
VarE 'allOnes, Exp
shiftE]
#if MIN_VERSION_template_haskell(2,16,0)
    tup :: [Exp] -> Exp
tup = [Maybe Exp] -> Exp
TupE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just
#else
    tup = TupE
#endif
#if MIN_VERSION_template_haskell(2,18,0)
    con :: Name -> [Pat] -> Pat
con Name
n = Name -> Cxt -> [Pat] -> Pat
ConP Name
n []
#else
    con = ConP
#endif
    returnDecls :: [Dec] -> Q [Dec]
returnDecls [Dec]
ds = do
      Module PkgName
_ (ModName String
modName) ← Q Module
thisModule
      let typeVar :: Name
typeVar = String -> Name
mkName forall a b. (a -> b) -> a -> b
$ String -> String
uncapitalize (forall a. Show a => a -> String
show Name
tp) forall a. [a] -> [a] -> [a]
++ String
"Type"
            where uncapitalize :: String -> String
uncapitalize (Char
h : String
t) = Char -> Char
toLower Char
h forall a. a -> [a] -> [a]
: String
t
                  uncapitalize []      = []
          fullName :: String
fullName = String
modName forall a. [a] -> [a] -> [a]
++ String
"." forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Name
tp
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ([Dec]
ds forall a. [a] -> [a] -> [a]
++) forall a b. (a -> b) -> a -> b
$
        {- TYPEType ∷ DataType -}
        [ Name -> Kind -> Dec
SigD Name
typeVar (Name -> Kind
ConT ''DataType)
        {- TYPEType = mkIntType TYPE -}
        , Name -> Exp -> Dec
fun Name
typeVar forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'mkIntType [String -> Exp
litS String
fullName]
        , forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> [Dec] -> Dec
inst ''Data [Name
tp] forall a b. (a -> b) -> a -> b
$
            {- toConstr = mkIntegralConstr TYPE -}
            [ Name -> Exp -> Dec
fun 'toConstr forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'mkIntegralConstr [Name
typeVar]
            {-
               gunfold _ z c = case constRep c of
                                 IntConstr x → z (fromIntegral x)
                                 _ → error $ "Data.Data.gunfold: Constructor" ++
                                             show c ++ " is not of type " ++
                                             fullName
            -}
            , Name -> Exp -> Dec
fun_ZC 'gunfold forall a b. (a -> b) -> a -> b
$ Exp -> [Match] -> Exp
CaseE (forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'constrRep [Name
c]) forall a b. (a -> b) -> a -> b
$
                [ Pat -> Body -> [Dec] -> Match
Match (Name -> [Pat] -> Pat
con 'IntConstr [Name -> Pat
VarP Name
x])
                        (Exp -> Body
NormalB forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV Name
z [forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'fromIntegral [Name
x]])
                        []
                , Pat -> Body -> [Dec] -> Match
Match Pat
WildP
                        (Exp -> Body
NormalB forall a b. (a -> b) -> a -> b
$
                           forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV 'error
                                [forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV '(++)
                                      [ String -> Exp
litS String
"Data.Data.gunfold: Constructor"
                                      , forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV '(++)
                                             [ forall {t :: * -> *}.
(Foldable t, Functor t) =>
Name -> t Name -> Exp
appVN 'show [Name
c]
                                             , forall {t :: * -> *}. Foldable t => Name -> t Exp -> Exp
appV '(++)
                                                    [ String -> Exp
litS String
" is not of type "
                                                    , String -> Exp
litS String
fullName ]
                                             ]
                                      ]
                                ])
                        []
                ]
            {- dataTypeOf _ = TYPEType -}
            , Name -> Exp -> Dec
fun_ 'dataTypeOf forall a b. (a -> b) -> a -> b
$ Name -> Exp
VarE Name
typeVar
            ]
        ]