{-|
  Copyright   :  (C) 2013-2016, University of Twente,
                     2016-2017, Myrtle Software Ltd,
                     2017     , QBayLogic, Google Inc.
  License     :  BSD2 (see the file LICENSE)
  Maintainer  :  Christiaan Baaij <christiaan.baaij@gmail.com>
-}

{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UnboxedTuples #-}

module Clash.GHC.Evaluator
  ( primEvaluator
  , isUndefinedPrimVal
  ) where

import           Control.Concurrent.Supply  (Supply,freshId)
import           Control.DeepSeq            (force)
import           Control.Exception          (ArithException(..), Exception, tryJust, evaluate)
import           Control.Monad.State.Strict (State, MonadState)
import qualified Control.Monad.State.Strict as State
import           Control.Monad.Trans.Except (runExcept)
import           Data.Bits
import           Data.Char           (chr,ord)
import qualified Data.Either         as Either
import           Data.Maybe (fromMaybe, mapMaybe)
import qualified Data.List           as List
import qualified Data.Primitive.ByteArray as ByteArray
import           Data.Proxy          (Proxy)
import           Data.Reflection     (reifyNat)
import           Data.Text           (Text)
import qualified Data.Text           as Text
import qualified Data.Vector.Primitive as Vector
import           GHC.Float
import           GHC.Int
import           GHC.Integer
  (decodeDoubleInteger,encodeDoubleInteger,compareInteger,orInteger,andInteger,
   xorInteger,complementInteger,absInteger,signumInteger)
import           GHC.Integer.GMP.Internals
  (Integer (..), BigNat (..))
import           GHC.Natural
import           GHC.Prim
import           GHC.Real            (Ratio (..))
import           GHC.TypeLits        (KnownNat)
import           GHC.Types           (IO (..))
import           GHC.Word
import           System.IO.Unsafe    (unsafeDupablePerformIO)

import           BasicTypes          (Boxity (..))
import           Name                (getSrcSpan, nameOccName, occNameString)
import           PrelNames
  (typeNatAddTyFamNameKey, typeNatMulTyFamNameKey, typeNatSubTyFamNameKey,
   trueDataConKey, falseDataConKey)
import           SrcLoc              (wiredInSrcSpan)
import qualified TyCon
import           TysWiredIn          (tupleTyCon)
import           Unique              (getKey)

import           Clash.Class.BitPack (pack,unpack)
import           Clash.Core.DataCon  (DataCon (..))
import           Clash.Core.Evaluator
import           Clash.Core.Evaluator.Types
import           Clash.Core.Literal  (Literal (..))
import           Clash.Core.Name
  (Name (..), NameSort (..), mkUnsafeSystemName)
import           Clash.Core.Pretty   (showPpr)
import           Clash.Core.Term
  (Pat (..), PrimInfo (..), Term (..), WorkInfo (..), mkApps)
import           Clash.Core.TermInfo (piResultTys, applyTypeToArgs)
import           Clash.Core.Type
  (Type (..), ConstTy (..), LitTy (..), TypeView (..), mkFunTy, mkTyConApp,
   splitFunForallTy, tyView)
import           Clash.Core.TyCon
  (TyConMap, TyConName, tyConDataCons)
import           Clash.Core.TysPrim
import           Clash.Core.Util
  (mkRTree,mkVec,tyNatSize,dataConInstArgTys,primCo,
   undefinedTm)
import           Clash.Core.Var      (mkLocalId, mkTyVar)
import           Clash.Debug
import           Clash.GHC.GHC2Core  (modNameM)
import           Clash.Rewrite.Util  (mkSelectorCase)
import           Clash.Unique        (lookupUniqMap)
import           Clash.Util
  (MonadUnique (..), clogBase, flogBase, curLoc)

import Clash.Promoted.Nat.Unsafe (unsafeSNat)
import qualified Clash.Sized.Internal.BitVector as BitVector
import qualified Clash.Sized.Internal.Signed    as Signed
import qualified Clash.Sized.Internal.Unsigned  as Unsigned
import Clash.Sized.Internal.BitVector(BitVector(..), Bit(..))
import Clash.Sized.Internal.Signed   (Signed   (..))
import Clash.Sized.Internal.Unsigned (Unsigned (..))
import Clash.XException (isX)

primEvaluator :: PrimEvaluator
primEvaluator :: PrimEvaluator
primEvaluator = (PrimStep
reduceConstant, PrimUnwind
unwindPrim)


-- | Evaluation of primitive operations.
-- TODO This should really be in Clash.GHC.Evaluator -- the evaluator in
-- clash-lib should NEVER refer to GHC primitives.
unwindPrim :: PrimUnwind
unwindPrim :: PrimUnwind
unwindPrim TyConMap
tcm PrimInfo
p [Type]
tys [Value]
vs Value
v [] Machine
m
  | PrimInfo -> Text
primName PrimInfo
p Text -> [Text] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` [ Text
"Clash.Sized.Internal.Index.fromInteger#"
                       , Text
"GHC.CString.unpackCString#"
                       , Text
"Clash.Transformations.removedArg"
                       , Text
"GHC.Prim.MutableByteArray#"
                       , Text
"Clash.Transformations.undefined"
                       ]
              -- The above primitives are actually values, and not operations.
  = TyConMap -> Machine -> Value -> Maybe Machine
unwind TyConMap
tcm Machine
m (PrimInfo -> [Type] -> [Value] -> Value
PrimVal PrimInfo
p [Type]
tys ([Value]
vs [Value] -> [Value] -> [Value]
forall a. [a] -> [a] -> [a]
++ [Value
v]))
  | PrimInfo -> Text
primName PrimInfo
p Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Clash.Sized.Internal.BitVector.fromInteger#"
  = case ([Value]
vs,Value
v) of
    ([Value -> Maybe Integer
naturalLiteral -> Just Integer
n,Value
mask], Value -> Maybe Integer
integerLiteral -> Just Integer
i) ->
      TyConMap -> Machine -> Value -> Maybe Machine
unwind TyConMap
tcm Machine
m (PrimInfo -> [Type] -> [Value] -> Value
PrimVal PrimInfo
p [Type]
tys [Literal -> Value
Lit (Integer -> Literal
NaturalLiteral Integer
n), Value
mask, Literal -> Value
Lit (Integer -> Literal
IntegerLiteral (Integer -> Integer -> Integer
wrapUnsigned Integer
n Integer
i))])
    ([Value], Value)
_ -> [Char] -> Maybe Machine
forall a. HasCallStack => [Char] -> a
error ($([Char]
curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"Internal error"  [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ([Value], Value) -> [Char]
forall a. Show a => a -> [Char]
show ([Value]
vs,Value
v))
  | PrimInfo -> Text
primName PrimInfo
p Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Clash.Sized.Internal.BitVector.fromInteger##"
  = case ([Value]
vs,Value
v) of
    ([Value
mask], Value -> Maybe Integer
integerLiteral -> Just Integer
i) ->
      TyConMap -> Machine -> Value -> Maybe Machine
unwind TyConMap
tcm Machine
m (PrimInfo -> [Type] -> [Value] -> Value
PrimVal PrimInfo
p [Type]
tys [Value
mask, Literal -> Value
Lit (Integer -> Literal
IntegerLiteral (Integer -> Integer -> Integer
wrapUnsigned Integer
1 Integer
i))])
    ([Value], Value)
_ -> [Char] -> Maybe Machine
forall a. HasCallStack => [Char] -> a
error ($([Char]
curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"Internal error"  [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ([Value], Value) -> [Char]
forall a. Show a => a -> [Char]
show ([Value]
vs,Value
v))
  | PrimInfo -> Text
primName PrimInfo
p Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Clash.Sized.Internal.Signed.fromInteger#"
  = case ([Value]
vs,Value
v) of
    ([Value -> Maybe Integer
naturalLiteral -> Just Integer
n],Value -> Maybe Integer
integerLiteral -> Just Integer
i) ->
      TyConMap -> Machine -> Value -> Maybe Machine
unwind TyConMap
tcm Machine
m (PrimInfo -> [Type] -> [Value] -> Value
PrimVal PrimInfo
p [Type]
tys [Literal -> Value
Lit (Integer -> Literal
NaturalLiteral Integer
n), Literal -> Value
Lit (Integer -> Literal
IntegerLiteral (Integer -> Integer -> Integer
wrapSigned Integer
n Integer
i))])
    ([Value], Value)
_ -> [Char] -> Maybe Machine
forall a. HasCallStack => [Char] -> a
error ($([Char]
curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"Internal error"  [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ([Value], Value) -> [Char]
forall a. Show a => a -> [Char]
show ([Value]
vs,Value
v))
  | PrimInfo -> Text
primName PrimInfo
p Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Clash.Sized.Internal.Unsigned.fromInteger#"
  = case ([Value]
vs,Value
v) of
    ([Value -> Maybe Integer
naturalLiteral -> Just Integer
n],Value -> Maybe Integer
integerLiteral -> Just Integer
i) ->
      TyConMap -> Machine -> Value -> Maybe Machine
unwind TyConMap
tcm Machine
m (PrimInfo -> [Type] -> [Value] -> Value
PrimVal PrimInfo
p [Type]
tys [Literal -> Value
Lit (Integer -> Literal
NaturalLiteral Integer
n), Literal -> Value
Lit (Integer -> Literal
IntegerLiteral (Integer -> Integer -> Integer
wrapUnsigned Integer
n Integer
i))])
    ([Value], Value)
_ -> [Char] -> Maybe Machine
forall a. HasCallStack => [Char] -> a
error ($([Char]
curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"Internal error"  [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ([Value], Value) -> [Char]
forall a. Show a => a -> [Char]
show ([Value]
vs,Value
v))
  | Value -> Bool
isUndefinedPrimVal Value
v
  = let tyArgs :: [Either a Type]
tyArgs = (Type -> Either a Type) -> [Type] -> [Either a Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Either a Type
forall a b. b -> Either a b
Right [Type]
tys
        tmArgs :: [Either Term b]
tmArgs = (Value -> Either Term b) -> [Value] -> [Either Term b]
forall a b. (a -> b) -> [a] -> [b]
map (Term -> Either Term b
forall a b. a -> Either a b
Left (Term -> Either Term b)
-> (Value -> Term) -> Value -> Either Term b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Term
valToTerm) ([Value]
vs [Value] -> [Value] -> [Value]
forall a. [a] -> [a] -> [a]
++ [Value
v])
    in  Machine -> Maybe Machine
forall a. a -> Maybe a
Just (Machine -> Maybe Machine) -> Machine -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ (Term -> Machine -> Machine) -> Machine -> Term -> Machine
forall a b c. (a -> b -> c) -> b -> a -> c
flip Term -> Machine -> Machine
setTerm Machine
m (Term -> Machine) -> Term -> Machine
forall a b. (a -> b) -> a -> b
$ Type -> Term
undefinedTm (Type -> Term) -> Type -> Term
forall a b. (a -> b) -> a -> b
$
          Term -> TyConMap -> Type -> [Either Term Type] -> Type
applyTypeToArgs (PrimInfo -> Term
Prim PrimInfo
p) TyConMap
tcm (PrimInfo -> Type
primType PrimInfo
p) ([Either Term Type]
forall a. [Either a Type]
tyArgs [Either Term Type] -> [Either Term Type] -> [Either Term Type]
forall a. [a] -> [a] -> [a]
++ [Either Term Type]
forall b. [Either Term b]
tmArgs)
  | Bool
otherwise
  = Machine -> PrimStep
mPrimStep Machine
m TyConMap
tcm (Machine -> Bool
forcePrims Machine
m) PrimInfo
p [Type]
tys ([Value]
vs [Value] -> [Value] -> [Value]
forall a. [a] -> [a] -> [a]
++ [Value
v]) Machine
m

unwindPrim TyConMap
tcm PrimInfo
p [Type]
tys [Value]
vs Value
v [Term
e] Machine
m0
  -- Primitives are usually considered undefined when one of their arguments is
  -- (unless they're unused). _Some_ primitives can still yield a result even
  -- though one of their arguments is undefined. It turns out that all primitives
  -- exhibiting this property happen to be "lazy" in their last argument. Thus,
  -- all the cases can be covered by a match on [e] and their names:
  | PrimInfo -> Text
primName PrimInfo
p Text -> [Text] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` [ Text
"Clash.Sized.Vector.lazyV"
                       , Text
"Clash.Sized.Vector.replicate"
                       , Text
"Clash.Sized.Vector.replace_int"
                       , Text
"GHC.Classes.&&"
                       , Text
"GHC.Classes.||"
                       ]
  = if Value -> Bool
isUndefinedPrimVal Value
v then
      let tyArgs :: [Either a Type]
tyArgs = (Type -> Either a Type) -> [Type] -> [Either a Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Either a Type
forall a b. b -> Either a b
Right [Type]
tys
          tmArgs :: [Either Term b]
tmArgs = (Value -> Either Term b) -> [Value] -> [Either Term b]
forall a b. (a -> b) -> [a] -> [b]
map (Term -> Either Term b
forall a b. a -> Either a b
Left (Term -> Either Term b)
-> (Value -> Term) -> Value -> Either Term b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Term
valToTerm) ([Value]
vs [Value] -> [Value] -> [Value]
forall a. [a] -> [a] -> [a]
++ [Value
v]) [Either Term b] -> [Either Term b] -> [Either Term b]
forall a. [a] -> [a] -> [a]
++ [Term -> Either Term b
forall a b. a -> Either a b
Left Term
e]
      in  Machine -> Maybe Machine
forall a. a -> Maybe a
Just (Machine -> Maybe Machine) -> Machine -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ (Term -> Machine -> Machine) -> Machine -> Term -> Machine
forall a b c. (a -> b -> c) -> b -> a -> c
flip Term -> Machine -> Machine
setTerm Machine
m0 (Term -> Machine) -> Term -> Machine
forall a b. (a -> b) -> a -> b
$ Type -> Term
undefinedTm (Type -> Term) -> Type -> Term
forall a b. (a -> b) -> a -> b
$
            Term -> TyConMap -> Type -> [Either Term Type] -> Type
applyTypeToArgs (PrimInfo -> Term
Prim PrimInfo
p) TyConMap
tcm (PrimInfo -> Type
primType PrimInfo
p) ([Either Term Type]
forall a. [Either a Type]
tyArgs [Either Term Type] -> [Either Term Type] -> [Either Term Type]
forall a. [a] -> [a] -> [a]
++ [Either Term Type]
forall b. [Either Term b]
tmArgs)
    else
      let (Machine
m1,Id
i) = TyConMap -> Machine -> Term -> (Machine, Id)
newLetBinding TyConMap
tcm Machine
m0 Term
e
      in  Machine -> PrimStep
mPrimStep Machine
m0 TyConMap
tcm (Machine -> Bool
forcePrims Machine
m0) PrimInfo
p [Type]
tys ([Value]
vs [Value] -> [Value] -> [Value]
forall a. [a] -> [a] -> [a]
++ [Value
v,Term -> Value
Suspend (Id -> Term
Var Id
i)]) Machine
m1

unwindPrim TyConMap
tcm PrimInfo
p [Type]
tys [Value]
vs (Value -> (Value, [TickInfo])
collectValueTicks -> (Value
v, [TickInfo]
ts)) (Term
e:[Term]
es) Machine
m
  | Value -> Bool
isUndefinedPrimVal Value
v
  = let tyArgs :: [Either a Type]
tyArgs = (Type -> Either a Type) -> [Type] -> [Either a Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Either a Type
forall a b. b -> Either a b
Right [Type]
tys
        tmArgs :: [Either Term b]
tmArgs = (Value -> Either Term b) -> [Value] -> [Either Term b]
forall a b. (a -> b) -> [a] -> [b]
map (Term -> Either Term b
forall a b. a -> Either a b
Left (Term -> Either Term b)
-> (Value -> Term) -> Value -> Either Term b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Term
valToTerm) ([Value]
vs [Value] -> [Value] -> [Value]
forall a. [a] -> [a] -> [a]
++ [Value
v]) [Either Term b] -> [Either Term b] -> [Either Term b]
forall a. [a] -> [a] -> [a]
++ (Term -> Either Term b) -> [Term] -> [Either Term b]
forall a b. (a -> b) -> [a] -> [b]
map Term -> Either Term b
forall a b. a -> Either a b
Left (Term
eTerm -> [Term] -> [Term]
forall a. a -> [a] -> [a]
:[Term]
es)
    in  Machine -> Maybe Machine
forall a. a -> Maybe a
Just (Machine -> Maybe Machine) -> Machine -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ (Term -> Machine -> Machine) -> Machine -> Term -> Machine
forall a b c. (a -> b -> c) -> b -> a -> c
flip Term -> Machine -> Machine
setTerm Machine
m (Term -> Machine) -> Term -> Machine
forall a b. (a -> b) -> a -> b
$ Type -> Term
undefinedTm (Type -> Term) -> Type -> Term
forall a b. (a -> b) -> a -> b
$
          Term -> TyConMap -> Type -> [Either Term Type] -> Type
applyTypeToArgs (PrimInfo -> Term
Prim PrimInfo
p) TyConMap
tcm (PrimInfo -> Type
primType PrimInfo
p) ([Either Term Type]
forall a. [Either a Type]
tyArgs [Either Term Type] -> [Either Term Type] -> [Either Term Type]
forall a. [a] -> [a] -> [a]
++ [Either Term Type]
forall b. [Either Term b]
tmArgs)
  | Bool
otherwise
  = Machine -> Maybe Machine
forall a. a -> Maybe a
Just (Machine -> Maybe Machine)
-> (Machine -> Machine) -> Machine -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Machine -> Machine
setTerm Term
e (Machine -> Maybe Machine) -> Machine -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ StackFrame -> Machine -> Machine
stackPush (PrimInfo -> [Type] -> [Value] -> [Term] -> StackFrame
PrimApply PrimInfo
p [Type]
tys ([Value]
vs [Value] -> [Value] -> [Value]
forall a. [a] -> [a] -> [a]
++ [(TickInfo -> Value -> Value) -> Value -> [TickInfo] -> Value
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr TickInfo -> Value -> Value
TickValue Value
v [TickInfo]
ts]) [Term]
es) Machine
m


newtype PrimEvalMonad a = PEM (State Supply a)
  deriving (a -> PrimEvalMonad b -> PrimEvalMonad a
(a -> b) -> PrimEvalMonad a -> PrimEvalMonad b
(forall a b. (a -> b) -> PrimEvalMonad a -> PrimEvalMonad b)
-> (forall a b. a -> PrimEvalMonad b -> PrimEvalMonad a)
-> Functor PrimEvalMonad
forall a b. a -> PrimEvalMonad b -> PrimEvalMonad a
forall a b. (a -> b) -> PrimEvalMonad a -> PrimEvalMonad b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> PrimEvalMonad b -> PrimEvalMonad a
$c<$ :: forall a b. a -> PrimEvalMonad b -> PrimEvalMonad a
fmap :: (a -> b) -> PrimEvalMonad a -> PrimEvalMonad b
$cfmap :: forall a b. (a -> b) -> PrimEvalMonad a -> PrimEvalMonad b
Functor, Functor PrimEvalMonad
a -> PrimEvalMonad a
Functor PrimEvalMonad
-> (forall a. a -> PrimEvalMonad a)
-> (forall a b.
    PrimEvalMonad (a -> b) -> PrimEvalMonad a -> PrimEvalMonad b)
-> (forall a b c.
    (a -> b -> c)
    -> PrimEvalMonad a -> PrimEvalMonad b -> PrimEvalMonad c)
-> (forall a b.
    PrimEvalMonad a -> PrimEvalMonad b -> PrimEvalMonad b)
-> (forall a b.
    PrimEvalMonad a -> PrimEvalMonad b -> PrimEvalMonad a)
-> Applicative PrimEvalMonad
PrimEvalMonad a -> PrimEvalMonad b -> PrimEvalMonad b
PrimEvalMonad a -> PrimEvalMonad b -> PrimEvalMonad a
PrimEvalMonad (a -> b) -> PrimEvalMonad a -> PrimEvalMonad b
(a -> b -> c)
-> PrimEvalMonad a -> PrimEvalMonad b -> PrimEvalMonad c
forall a. a -> PrimEvalMonad a
forall a b. PrimEvalMonad a -> PrimEvalMonad b -> PrimEvalMonad a
forall a b. PrimEvalMonad a -> PrimEvalMonad b -> PrimEvalMonad b
forall a b.
PrimEvalMonad (a -> b) -> PrimEvalMonad a -> PrimEvalMonad b
forall a b c.
(a -> b -> c)
-> PrimEvalMonad a -> PrimEvalMonad b -> PrimEvalMonad c
forall (f :: Type -> Type).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: PrimEvalMonad a -> PrimEvalMonad b -> PrimEvalMonad a
$c<* :: forall a b. PrimEvalMonad a -> PrimEvalMonad b -> PrimEvalMonad a
*> :: PrimEvalMonad a -> PrimEvalMonad b -> PrimEvalMonad b
$c*> :: forall a b. PrimEvalMonad a -> PrimEvalMonad b -> PrimEvalMonad b
liftA2 :: (a -> b -> c)
-> PrimEvalMonad a -> PrimEvalMonad b -> PrimEvalMonad c
$cliftA2 :: forall a b c.
(a -> b -> c)
-> PrimEvalMonad a -> PrimEvalMonad b -> PrimEvalMonad c
<*> :: PrimEvalMonad (a -> b) -> PrimEvalMonad a -> PrimEvalMonad b
$c<*> :: forall a b.
PrimEvalMonad (a -> b) -> PrimEvalMonad a -> PrimEvalMonad b
pure :: a -> PrimEvalMonad a
$cpure :: forall a. a -> PrimEvalMonad a
$cp1Applicative :: Functor PrimEvalMonad
Applicative, Applicative PrimEvalMonad
a -> PrimEvalMonad a
Applicative PrimEvalMonad
-> (forall a b.
    PrimEvalMonad a -> (a -> PrimEvalMonad b) -> PrimEvalMonad b)
-> (forall a b.
    PrimEvalMonad a -> PrimEvalMonad b -> PrimEvalMonad b)
-> (forall a. a -> PrimEvalMonad a)
-> Monad PrimEvalMonad
PrimEvalMonad a -> (a -> PrimEvalMonad b) -> PrimEvalMonad b
PrimEvalMonad a -> PrimEvalMonad b -> PrimEvalMonad b
forall a. a -> PrimEvalMonad a
forall a b. PrimEvalMonad a -> PrimEvalMonad b -> PrimEvalMonad b
forall a b.
PrimEvalMonad a -> (a -> PrimEvalMonad b) -> PrimEvalMonad b
forall (m :: Type -> Type).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> PrimEvalMonad a
$creturn :: forall a. a -> PrimEvalMonad a
>> :: PrimEvalMonad a -> PrimEvalMonad b -> PrimEvalMonad b
$c>> :: forall a b. PrimEvalMonad a -> PrimEvalMonad b -> PrimEvalMonad b
>>= :: PrimEvalMonad a -> (a -> PrimEvalMonad b) -> PrimEvalMonad b
$c>>= :: forall a b.
PrimEvalMonad a -> (a -> PrimEvalMonad b) -> PrimEvalMonad b
$cp1Monad :: Applicative PrimEvalMonad
Monad, MonadState Supply)

instance MonadUnique PrimEvalMonad where
  getUniqueM :: PrimEvalMonad Int
getUniqueM = State Supply Int -> PrimEvalMonad Int
forall a. State Supply a -> PrimEvalMonad a
PEM (State Supply Int -> PrimEvalMonad Int)
-> State Supply Int -> PrimEvalMonad Int
forall a b. (a -> b) -> a -> b
$ (Supply -> (Int, Supply)) -> State Supply Int
forall s (m :: Type -> Type) a.
MonadState s m =>
(s -> (a, s)) -> m a
State.state (\Supply
s -> case Supply -> (Int, Supply)
freshId Supply
s of (!Int
i,!Supply
s') -> (Int
i,Supply
s'))

runPEM :: PrimEvalMonad a -> Supply -> (a, Supply)
runPEM :: PrimEvalMonad a -> Supply -> (a, Supply)
runPEM (PEM State Supply a
m) = State Supply a -> Supply -> (a, Supply)
forall s a. State s a -> s -> (a, s)
State.runState State Supply a
m

reduceConstant :: PrimStep
reduceConstant :: PrimStep
reduceConstant TyConMap
tcm Bool
isSubj PrimInfo
pInfo [Type]
tys [Value]
args Machine
mach = case PrimInfo -> Text
primName PrimInfo
pInfo of
-----------------
-- GHC.Prim.Char#
-----------------
  Text
"GHC.Prim.gtChar#" | Just (Char
i,Char
j) <- [Value] -> Maybe (Char, Char)
charLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Bool -> Term
boolToIntLiteral (Char
i Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
> Char
j))
  Text
"GHC.Prim.geChar#" | Just (Char
i,Char
j) <- [Value] -> Maybe (Char, Char)
charLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Bool -> Term
boolToIntLiteral (Char
i Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
j))
  Text
"GHC.Prim.eqChar#" | Just (Char
i,Char
j) <- [Value] -> Maybe (Char, Char)
charLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Bool -> Term
boolToIntLiteral (Char
i Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
j))
  Text
"GHC.Prim.neChar#" | Just (Char
i,Char
j) <- [Value] -> Maybe (Char, Char)
charLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Bool -> Term
boolToIntLiteral (Char
i Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
j))
  Text
"GHC.Prim.ltChar#" | Just (Char
i,Char
j) <- [Value] -> Maybe (Char, Char)
charLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Bool -> Term
boolToIntLiteral (Char
i Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
j))
  Text
"GHC.Prim.leChar#" | Just (Char
i,Char
j) <- [Value] -> Maybe (Char, Char)
charLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Bool -> Term
boolToIntLiteral (Char
i Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
j))
  Text
"GHC.Prim.ord#" | [Char
i] <- [Value] -> [Char]
charLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToIntLiteral (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
i))

----------------
-- GHC.Prim.Int#
----------------
  Text
"GHC.Prim.+#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
intLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToIntLiteral (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
j))
  Text
"GHC.Prim.-#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
intLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToIntLiteral (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
j))
  Text
"GHC.Prim.*#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
intLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToIntLiteral (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
j))

  Text
"GHC.Prim.mulIntMayOflo#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
intLiterals  [Value]
args
    -> let !(I# Int#
a)  = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i
           !(I# Int#
b)  = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
j
           c :: Int#
           c :: Int#
c = Int# -> Int# -> Int#
mulIntMayOflo# Int#
a Int#
b
       in  Term -> Maybe Machine
reduce (Integer -> Term
integerToIntLiteral (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
c))

  Text
"GHC.Prim.quotInt#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
intLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Term -> Term
catchDivByZero (Integer -> Term
integerToIntLiteral (Integer
i Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
j))
  Text
"GHC.Prim.remInt#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
intLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Term -> Term
catchDivByZero (Integer -> Term
integerToIntLiteral (Integer
i Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`rem` Integer
j))
  Text
"GHC.Prim.quotRemInt#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
intLiterals [Value]
args
    -> let ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
tupTcNm [Type]
tyArgs) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just TyCon
tupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
tupTcNm TyConMap
tcm
           [DataCon
tupDc] = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
           (Integer
q,Integer
r)   = Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
quotRem Integer
i Integer
j
           ret :: Term
ret     = Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
tupDc) ((Type -> Either Term Type) -> [Type] -> [Either Term Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Either Term Type
forall a b. b -> Either a b
Right [Type]
tyArgs [Either Term Type] -> [Either Term Type] -> [Either Term Type]
forall a. [a] -> [a] -> [a]
++
                    [Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> Either Term Type) -> Term -> Either Term Type
forall a b. (a -> b) -> a -> b
$ Term -> Term
catchDivByZero (Integer -> Term
integerToIntLiteral Integer
q)
                    ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> Either Term Type) -> Term -> Either Term Type
forall a b. (a -> b) -> a -> b
$ Term -> Term
catchDivByZero (Integer -> Term
integerToIntLiteral Integer
r)])
       in  Term -> Maybe Machine
reduce Term
ret

  Text
"GHC.Prim.andI#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
intLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToIntLiteral (Integer
i Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
j))
  Text
"GHC.Prim.orI#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
intLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToIntLiteral (Integer
i Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer
j))
  Text
"GHC.Prim.xorI#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
intLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToIntLiteral (Integer
i Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
`xor` Integer
j))
  Text
"GHC.Prim.notI#" | [Integer
i] <- [Value] -> [Integer]
intLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToIntLiteral (Integer -> Integer
forall a. Bits a => a -> a
complement Integer
i))

  Text
"GHC.Prim.negateInt#"
    | [Lit (IntLiteral Integer
i)] <- [Value]
args
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToIntLiteral (Integer -> Integer
forall a. Num a => a -> a
negate Integer
i))

  Text
"GHC.Prim.addIntC#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
intLiterals [Value]
args
    -> let ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
tupTcNm [Type]
tyArgs) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just TyCon
tupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
tupTcNm TyConMap
tcm
           [DataCon
tupDc] = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
           !(I# Int#
a)  = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i
           !(I# Int#
b)  = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
j
           !(# Int#
d, Int#
c #) = Int# -> Int# -> (# Int#, Int# #)
addIntC# Int#
a Int#
b
       in  Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
           Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
tupDc) ((Type -> Either Term Type) -> [Type] -> [Either Term Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Either Term Type
forall a b. b -> Either a b
Right [Type]
tyArgs [Either Term Type] -> [Either Term Type] -> [Either Term Type]
forall a. [a] -> [a] -> [a]
++
                   [ Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Literal -> Term) -> (Int -> Literal) -> Int -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral (Integer -> Literal) -> (Int -> Integer) -> Int -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Term) -> Int -> Term
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
d)
                   , Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Literal -> Term) -> (Int -> Literal) -> Int -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral (Integer -> Literal) -> (Int -> Integer) -> Int -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Term) -> Int -> Term
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
c)])
  Text
"GHC.Prim.subIntC#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
intLiterals [Value]
args
    -> let ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
tupTcNm [Type]
tyArgs) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just TyCon
tupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
tupTcNm TyConMap
tcm
           [DataCon
tupDc] = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
           !(I# Int#
a)  = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i
           !(I# Int#
b)  = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
j
           !(# Int#
d, Int#
c #) = Int# -> Int# -> (# Int#, Int# #)
subIntC# Int#
a Int#
b
       in  Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
           Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
tupDc) ((Type -> Either Term Type) -> [Type] -> [Either Term Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Either Term Type
forall a b. b -> Either a b
Right [Type]
tyArgs [Either Term Type] -> [Either Term Type] -> [Either Term Type]
forall a. [a] -> [a] -> [a]
++
                   [ Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Literal -> Term) -> (Int -> Literal) -> Int -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral (Integer -> Literal) -> (Int -> Integer) -> Int -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Term) -> Int -> Term
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
d)
                   , Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Literal -> Term) -> (Int -> Literal) -> Int -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral (Integer -> Literal) -> (Int -> Integer) -> Int -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Term) -> Int -> Term
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
c)])

  Text
"GHC.Prim.>#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
intLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Bool -> Term
boolToIntLiteral (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
j))
  Text
"GHC.Prim.>=#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
intLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Bool -> Term
boolToIntLiteral (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
j))
  Text
"GHC.Prim.==#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
intLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Bool -> Term
boolToIntLiteral (Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
j))
  Text
"GHC.Prim./=#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
intLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Bool -> Term
boolToIntLiteral (Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
j))
  Text
"GHC.Prim.<#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
intLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Bool -> Term
boolToIntLiteral (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
j))
  Text
"GHC.Prim.<=#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
intLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Bool -> Term
boolToIntLiteral (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
j))

  Text
"GHC.Prim.chr#" | [Integer
i] <- [Value] -> [Integer]
intLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Char -> Term
charToCharLiteral (Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i))

  Text
"GHC.Prim.int2Word#"
    | [Lit (IntLiteral Integer
i)] <- [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> (Word -> Term) -> Word -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Term
Literal (Literal -> Term) -> (Word -> Literal) -> Word -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
WordLiteral (Integer -> Literal) -> (Word -> Integer) -> Word -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Integer
forall a. Integral a => a -> Integer
toInteger (Word -> Maybe Machine) -> Word -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ (Integer -> Word
forall a. Num a => Integer -> a
fromInteger :: Integer -> Word) Integer
i -- for overflow behavior

  Text
"GHC.Prim.int2Float#"
    | [Lit (IntLiteral Integer
i)] <- [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine)
-> (Float -> Term) -> Float -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Term
Literal (Literal -> Term) -> (Float -> Literal) -> Float -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Literal
FloatLiteral  (Rational -> Literal) -> (Float -> Rational) -> Float -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Rational
forall a. Real a => a -> Rational
toRational (Float -> Maybe Machine) -> Float -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ (Integer -> Float
forall a. Num a => Integer -> a
fromInteger Integer
i :: Float)
  Text
"GHC.Prim.int2Double#"
    | [Lit (IntLiteral Integer
i)] <- [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine)
-> (Double -> Term) -> Double -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Term
Literal (Literal -> Term) -> (Double -> Literal) -> Double -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Literal
DoubleLiteral (Rational -> Literal) -> (Double -> Rational) -> Double -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Rational
forall a. Real a => a -> Rational
toRational (Double -> Maybe Machine) -> Double -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ (Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
i :: Double)

  Text
"GHC.Prim.word2Float#"
    | [Lit (WordLiteral Integer
i)] <- [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine)
-> (Float -> Term) -> Float -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Term
Literal (Literal -> Term) -> (Float -> Literal) -> Float -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Literal
FloatLiteral  (Rational -> Literal) -> (Float -> Rational) -> Float -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Rational
forall a. Real a => a -> Rational
toRational (Float -> Maybe Machine) -> Float -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ (Integer -> Float
forall a. Num a => Integer -> a
fromInteger Integer
i :: Float)
  Text
"GHC.Prim.word2Double#"
    | [Lit (WordLiteral Integer
i)] <- [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine)
-> (Double -> Term) -> Double -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Term
Literal (Literal -> Term) -> (Double -> Literal) -> Double -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Literal
DoubleLiteral (Rational -> Literal) -> (Double -> Rational) -> Double -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Rational
forall a. Real a => a -> Rational
toRational (Double -> Maybe Machine) -> Double -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ (Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
i :: Double)

  Text
"GHC.Prim.uncheckedIShiftL#"
    | [ Lit (IntLiteral Integer
i)
      , Lit (IntLiteral Integer
s)
      ] <- [Value]
args
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToIntLiteral (Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
s))
  Text
"GHC.Prim.uncheckedIShiftRA#"
    | [ Lit (IntLiteral Integer
i)
      , Lit (IntLiteral Integer
s)
      ] <- [Value]
args
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToIntLiteral (Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
s))
  Text
"GHC.Prim.uncheckedIShiftRL#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
intLiterals [Value]
args
    -> let !(I# Int#
a)  = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i
           !(I# Int#
b)  = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
j
           c :: Int#
           c :: Int#
c = Int# -> Int# -> Int#
uncheckedIShiftRL# Int#
a Int#
b
       in  Term -> Maybe Machine
reduce (Integer -> Term
integerToIntLiteral (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
c))

-----------------
-- GHC.Prim.Word#
-----------------
  Text
"GHC.Prim.plusWord#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
wordLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToWordLiteral (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
j))

  Text
"GHC.Prim.subWordC#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
wordLiterals [Value]
args
    -> let ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
tupTcNm [Type]
tyArgs) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just TyCon
tupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
tupTcNm TyConMap
tcm
           [DataCon
tupDc] = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
           !(W# Word#
a)  = Integer -> Word
forall a. Num a => Integer -> a
fromInteger Integer
i
           !(W# Word#
b)  = Integer -> Word
forall a. Num a => Integer -> a
fromInteger Integer
j
           !(# Word#
d, Int#
c #) = Word# -> Word# -> (# Word#, Int# #)
subWordC# Word#
a Word#
b
       in  Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
           Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
tupDc) ((Type -> Either Term Type) -> [Type] -> [Either Term Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Either Term Type
forall a b. b -> Either a b
Right [Type]
tyArgs [Either Term Type] -> [Either Term Type] -> [Either Term Type]
forall a. [a] -> [a] -> [a]
++
                   [ Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Literal -> Term) -> (Word -> Literal) -> Word -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
WordLiteral (Integer -> Literal) -> (Word -> Integer) -> Word -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Integer
forall a. Integral a => a -> Integer
toInteger (Word -> Term) -> Word -> Term
forall a b. (a -> b) -> a -> b
$ Word# -> Word
W# Word#
d)
                   , Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Literal -> Term) -> (Int -> Literal) -> Int -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral (Integer -> Literal) -> (Int -> Integer) -> Int -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Term) -> Int -> Term
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
c)])

  Text
"GHC.Prim.plusWord2#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
wordLiterals [Value]
args
    -> let ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
tupTcNm [Type]
tyArgs) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just TyCon
tupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
tupTcNm TyConMap
tcm
           [DataCon
tupDc] = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
           !(W# Word#
a)  = Integer -> Word
forall a. Num a => Integer -> a
fromInteger Integer
i
           !(W# Word#
b)  = Integer -> Word
forall a. Num a => Integer -> a
fromInteger Integer
j
           !(# Word#
h', Word#
l #) = Word# -> Word# -> (# Word#, Word# #)
plusWord2# Word#
a Word#
b
       in  Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
           Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
tupDc) ((Type -> Either Term Type) -> [Type] -> [Either Term Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Either Term Type
forall a b. b -> Either a b
Right [Type]
tyArgs [Either Term Type] -> [Either Term Type] -> [Either Term Type]
forall a. [a] -> [a] -> [a]
++
                   [ Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Literal -> Term) -> (Word -> Literal) -> Word -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
WordLiteral (Integer -> Literal) -> (Word -> Integer) -> Word -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Integer
forall a. Integral a => a -> Integer
toInteger (Word -> Term) -> Word -> Term
forall a b. (a -> b) -> a -> b
$ Word# -> Word
W# Word#
h')
                   , Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Literal -> Term) -> (Word -> Literal) -> Word -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
WordLiteral (Integer -> Literal) -> (Word -> Integer) -> Word -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Integer
forall a. Integral a => a -> Integer
toInteger (Word -> Term) -> Word -> Term
forall a b. (a -> b) -> a -> b
$ Word# -> Word
W# Word#
l)])

  Text
"GHC.Prim.minusWord#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
wordLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToWordLiteral (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
j))
  Text
"GHC.Prim.timesWord#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
wordLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToWordLiteral (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
j))

  Text
"GHC.Prim.timesWord2#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
wordLiterals [Value]
args
    -> let ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
tupTcNm [Type]
tyArgs) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just TyCon
tupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
tupTcNm TyConMap
tcm
           [DataCon
tupDc] = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
           !(W# Word#
a)  = Integer -> Word
forall a. Num a => Integer -> a
fromInteger Integer
i
           !(W# Word#
b)  = Integer -> Word
forall a. Num a => Integer -> a
fromInteger Integer
j
           !(# Word#
h', Word#
l #) = Word# -> Word# -> (# Word#, Word# #)
timesWord2# Word#
a Word#
b
       in  Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
           Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
tupDc) ((Type -> Either Term Type) -> [Type] -> [Either Term Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Either Term Type
forall a b. b -> Either a b
Right [Type]
tyArgs [Either Term Type] -> [Either Term Type] -> [Either Term Type]
forall a. [a] -> [a] -> [a]
++
                   [ Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Literal -> Term) -> (Word -> Literal) -> Word -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
WordLiteral (Integer -> Literal) -> (Word -> Integer) -> Word -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Integer
forall a. Integral a => a -> Integer
toInteger (Word -> Term) -> Word -> Term
forall a b. (a -> b) -> a -> b
$ Word# -> Word
W# Word#
h')
                   , Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Literal -> Term) -> (Word -> Literal) -> Word -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
WordLiteral (Integer -> Literal) -> (Word -> Integer) -> Word -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Integer
forall a. Integral a => a -> Integer
toInteger (Word -> Term) -> Word -> Term
forall a b. (a -> b) -> a -> b
$ Word# -> Word
W# Word#
l)])

  Text
"GHC.Prim.quotWord#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
wordLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Term -> Term
catchDivByZero (Integer -> Term
integerToWordLiteral (Integer
i Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
j))
  Text
"GHC.Prim.remWord#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
wordLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Term -> Term
catchDivByZero (Integer -> Term
integerToWordLiteral (Integer
i Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`rem` Integer
j))
  Text
"GHC.Prim.quotRemWord#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
wordLiterals [Value]
args
    -> let ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
tupTcNm [Type]
tyArgs) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just TyCon
tupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
tupTcNm TyConMap
tcm
           [DataCon
tupDc] = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
           (Integer
q,Integer
r)   = Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
quotRem Integer
i Integer
j
           ret :: Term
ret     = Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
tupDc) ((Type -> Either Term Type) -> [Type] -> [Either Term Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Either Term Type
forall a b. b -> Either a b
Right [Type]
tyArgs [Either Term Type] -> [Either Term Type] -> [Either Term Type]
forall a. [a] -> [a] -> [a]
++
                    [Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> Either Term Type) -> Term -> Either Term Type
forall a b. (a -> b) -> a -> b
$ Term -> Term
catchDivByZero (Integer -> Term
integerToWordLiteral Integer
q)
                    ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> Either Term Type) -> Term -> Either Term Type
forall a b. (a -> b) -> a -> b
$ Term -> Term
catchDivByZero (Integer -> Term
integerToWordLiteral Integer
r)])
       in  Term -> Maybe Machine
reduce Term
ret
  Text
"GHC.Prim.quotRemWord2#" | [Integer
i,Integer
j,Integer
k'] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> let ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
tupTcNm [Type]
tyArgs) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just TyCon
tupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
tupTcNm TyConMap
tcm
           [DataCon
tupDc] = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
           !(W# Word#
a)  = Integer -> Word
forall a. Num a => Integer -> a
fromInteger Integer
i
           !(W# Word#
b)  = Integer -> Word
forall a. Num a => Integer -> a
fromInteger Integer
j
           !(W# Word#
c)  = Integer -> Word
forall a. Num a => Integer -> a
fromInteger Integer
k'
           !(# Word#
x, Word#
y #) = Word# -> Word# -> Word# -> (# Word#, Word# #)
quotRemWord2# Word#
a Word#
b Word#
c
       in  Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
           Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
tupDc) ((Type -> Either Term Type) -> [Type] -> [Either Term Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Either Term Type
forall a b. b -> Either a b
Right [Type]
tyArgs [Either Term Type] -> [Either Term Type] -> [Either Term Type]
forall a. [a] -> [a] -> [a]
++
                   [ Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> Either Term Type) -> Term -> Either Term Type
forall a b. (a -> b) -> a -> b
$ Term -> Term
catchDivByZero (Literal -> Term
Literal (Literal -> Term) -> (Word -> Literal) -> Word -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
WordLiteral (Integer -> Literal) -> (Word -> Integer) -> Word -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Integer
forall a. Integral a => a -> Integer
toInteger (Word -> Term) -> Word -> Term
forall a b. (a -> b) -> a -> b
$ Word# -> Word
W# Word#
x)
                   , Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> Either Term Type) -> Term -> Either Term Type
forall a b. (a -> b) -> a -> b
$ Term -> Term
catchDivByZero (Literal -> Term
Literal (Literal -> Term) -> (Word -> Literal) -> Word -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
WordLiteral (Integer -> Literal) -> (Word -> Integer) -> Word -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Integer
forall a. Integral a => a -> Integer
toInteger (Word -> Term) -> Word -> Term
forall a b. (a -> b) -> a -> b
$ Word# -> Word
W# Word#
y)])

  Text
"GHC.Prim.and#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
wordLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToWordLiteral (Integer
i Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
j))
  Text
"GHC.Prim.or#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
wordLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToWordLiteral (Integer
i Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer
j))
  Text
"GHC.Prim.xor#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
wordLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToWordLiteral (Integer
i Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
`xor` Integer
j))
  Text
"GHC.Prim.not#" | [Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToWordLiteral (Integer -> Integer
forall a. Bits a => a -> a
complement Integer
i))

  Text
"GHC.Prim.uncheckedShiftL#"
    | [ Lit (WordLiteral Integer
w)
      , Lit (IntLiteral  Integer
i)
      ] <- [Value]
args
    -> Term -> Maybe Machine
reduce (Literal -> Term
Literal (Integer -> Literal
WordLiteral (Integer
w Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i)))
  Text
"GHC.Prim.uncheckedShiftRL#"
    | [ Lit (WordLiteral Integer
w)
      , Lit (IntLiteral  Integer
i)
      ] <- [Value]
args
    -> Term -> Maybe Machine
reduce (Literal -> Term
Literal (Integer -> Literal
WordLiteral (Integer
w Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i)))

  Text
"GHC.Prim.word2Int#"
    | [Lit (WordLiteral Integer
i)] <- [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> (Int -> Term) -> Int -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Term
Literal (Literal -> Term) -> (Int -> Literal) -> Int -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral (Integer -> Literal) -> (Int -> Integer) -> Int -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Maybe Machine) -> Int -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ (Integer -> Int
forall a. Num a => Integer -> a
fromInteger :: Integer -> Int) Integer
i -- for overflow behavior

  Text
"GHC.Prim.gtWord#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
wordLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Bool -> Term
boolToIntLiteral (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
j))
  Text
"GHC.Prim.geWord#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
wordLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Bool -> Term
boolToIntLiteral (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
j))
  Text
"GHC.Prim.eqWord#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
wordLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Bool -> Term
boolToIntLiteral (Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
j))
  Text
"GHC.Prim.neWord#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
wordLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Bool -> Term
boolToIntLiteral (Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
j))
  Text
"GHC.Prim.ltWord#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
wordLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Bool -> Term
boolToIntLiteral (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
j))
  Text
"GHC.Prim.leWord#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
wordLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Bool -> Term
boolToIntLiteral (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
j))

  Text
"GHC.Prim.popCnt8#" | [Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine)
-> (Integer -> Term) -> Integer -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Term
integerToWordLiteral (Integer -> Term) -> (Integer -> Integer) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> (Integer -> Int) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a. Bits a => a -> Int
popCount (Word8 -> Int) -> (Integer -> Word8) -> Integer -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Word8
forall a. Num a => Integer -> a
fromInteger :: Integer -> Word8) (Integer -> Maybe Machine) -> Integer -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Integer
i
  Text
"GHC.Prim.popCnt16#" | [Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine)
-> (Integer -> Term) -> Integer -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Term
integerToWordLiteral (Integer -> Term) -> (Integer -> Integer) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> (Integer -> Int) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Int
forall a. Bits a => a -> Int
popCount (Word16 -> Int) -> (Integer -> Word16) -> Integer -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Word16
forall a. Num a => Integer -> a
fromInteger :: Integer -> Word16) (Integer -> Maybe Machine) -> Integer -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Integer
i
  Text
"GHC.Prim.popCnt32#" | [Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine)
-> (Integer -> Term) -> Integer -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Term
integerToWordLiteral (Integer -> Term) -> (Integer -> Integer) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> (Integer -> Int) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a. Bits a => a -> Int
popCount (Word32 -> Int) -> (Integer -> Word32) -> Integer -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Word32
forall a. Num a => Integer -> a
fromInteger :: Integer -> Word32) (Integer -> Maybe Machine) -> Integer -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Integer
i
  Text
"GHC.Prim.popCnt64#" | [Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine)
-> (Integer -> Term) -> Integer -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Term
integerToWordLiteral (Integer -> Term) -> (Integer -> Integer) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> (Integer -> Int) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Int
forall a. Bits a => a -> Int
popCount (Word64 -> Int) -> (Integer -> Word64) -> Integer -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Word64
forall a. Num a => Integer -> a
fromInteger :: Integer -> Word64) (Integer -> Maybe Machine) -> Integer -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Integer
i
  Text
"GHC.Prim.popCnt#" | [Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine)
-> (Integer -> Term) -> Integer -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Term
integerToWordLiteral (Integer -> Term) -> (Integer -> Integer) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> (Integer -> Int) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Int
forall a. Bits a => a -> Int
popCount (Word -> Int) -> (Integer -> Word) -> Integer -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Word
forall a. Num a => Integer -> a
fromInteger :: Integer -> Word) (Integer -> Maybe Machine) -> Integer -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Integer
i

  Text
"GHC.Prim.clz8#" | [Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine)
-> (Integer -> Term) -> Integer -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Term
integerToWordLiteral (Integer -> Term) -> (Integer -> Integer) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> (Integer -> Int) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros (Word8 -> Int) -> (Integer -> Word8) -> Integer -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Word8
forall a. Num a => Integer -> a
fromInteger :: Integer -> Word8) (Integer -> Maybe Machine) -> Integer -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Integer
i
  Text
"GHC.Prim.clz16#" | [Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine)
-> (Integer -> Term) -> Integer -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Term
integerToWordLiteral (Integer -> Term) -> (Integer -> Integer) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> (Integer -> Int) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros (Word16 -> Int) -> (Integer -> Word16) -> Integer -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Word16
forall a. Num a => Integer -> a
fromInteger :: Integer -> Word16) (Integer -> Maybe Machine) -> Integer -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Integer
i
  Text
"GHC.Prim.clz32#" | [Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine)
-> (Integer -> Term) -> Integer -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Term
integerToWordLiteral (Integer -> Term) -> (Integer -> Integer) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> (Integer -> Int) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros (Word32 -> Int) -> (Integer -> Word32) -> Integer -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Word32
forall a. Num a => Integer -> a
fromInteger :: Integer -> Word32) (Integer -> Maybe Machine) -> Integer -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Integer
i
  Text
"GHC.Prim.clz64#" | [Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine)
-> (Integer -> Term) -> Integer -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Term
integerToWordLiteral (Integer -> Term) -> (Integer -> Integer) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> (Integer -> Int) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros (Word64 -> Int) -> (Integer -> Word64) -> Integer -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Word64
forall a. Num a => Integer -> a
fromInteger :: Integer -> Word64) (Integer -> Maybe Machine) -> Integer -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Integer
i
  Text
"GHC.Prim.clz#" | [Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine)
-> (Integer -> Term) -> Integer -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Term
integerToWordLiteral (Integer -> Term) -> (Integer -> Integer) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> (Integer -> Int) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros (Word -> Int) -> (Integer -> Word) -> Integer -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Word
forall a. Num a => Integer -> a
fromInteger :: Integer -> Word) (Integer -> Maybe Machine) -> Integer -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Integer
i

  Text
"GHC.Prim.ctz8#" | [Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine)
-> (Integer -> Term) -> Integer -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Term
integerToWordLiteral (Integer -> Term) -> (Integer -> Integer) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> (Integer -> Int) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros (Word -> Int) -> (Integer -> Word) -> Integer -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Word
forall a. Num a => Integer -> a
fromInteger :: Integer -> Word) (Integer -> Maybe Machine) -> Integer -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Integer
i Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. (Int -> Integer
forall a. Bits a => Int -> a
bit Int
8 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)
  Text
"GHC.Prim.ctz16#" | [Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine)
-> (Integer -> Term) -> Integer -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Term
integerToWordLiteral (Integer -> Term) -> (Integer -> Integer) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> (Integer -> Int) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros (Word -> Int) -> (Integer -> Word) -> Integer -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Word
forall a. Num a => Integer -> a
fromInteger :: Integer -> Word) (Integer -> Maybe Machine) -> Integer -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Integer
i Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. (Int -> Integer
forall a. Bits a => Int -> a
bit Int
16 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)
  Text
"GHC.Prim.ctz32#" | [Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine)
-> (Integer -> Term) -> Integer -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Term
integerToWordLiteral (Integer -> Term) -> (Integer -> Integer) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> (Integer -> Int) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros (Word -> Int) -> (Integer -> Word) -> Integer -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Word
forall a. Num a => Integer -> a
fromInteger :: Integer -> Word) (Integer -> Maybe Machine) -> Integer -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Integer
i Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. (Int -> Integer
forall a. Bits a => Int -> a
bit Int
32 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)
  Text
"GHC.Prim.ctz64#" | [Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine)
-> (Integer -> Term) -> Integer -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Term
integerToWordLiteral (Integer -> Term) -> (Integer -> Integer) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> (Integer -> Int) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros (Word64 -> Int) -> (Integer -> Word64) -> Integer -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Word64
forall a. Num a => Integer -> a
fromInteger :: Integer -> Word64) (Integer -> Maybe Machine) -> Integer -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Integer
i Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. (Int -> Integer
forall a. Bits a => Int -> a
bit Int
64 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)
  Text
"GHC.Prim.ctz#" | [Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine)
-> (Integer -> Term) -> Integer -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Term
integerToWordLiteral (Integer -> Term) -> (Integer -> Integer) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> (Integer -> Int) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros (Word -> Int) -> (Integer -> Word) -> Integer -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Word
forall a. Num a => Integer -> a
fromInteger :: Integer -> Word) (Integer -> Maybe Machine) -> Integer -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Integer
i

  Text
"GHC.Prim.byteSwap16#" | [Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine)
-> (Integer -> Term) -> Integer -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Term
integerToWordLiteral (Integer -> Term) -> (Integer -> Integer) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word16 -> Integer) -> (Integer -> Word16) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Word16
byteSwap16 (Word16 -> Word16) -> (Integer -> Word16) -> Integer -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Word16
forall a. Num a => Integer -> a
fromInteger :: Integer -> Word16) (Integer -> Maybe Machine) -> Integer -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Integer
i
  Text
"GHC.Prim.byteSwap32#" | [Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine)
-> (Integer -> Term) -> Integer -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Term
integerToWordLiteral (Integer -> Term) -> (Integer -> Integer) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word32 -> Integer) -> (Integer -> Word32) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Word32
byteSwap32 (Word32 -> Word32) -> (Integer -> Word32) -> Integer -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Word32
forall a. Num a => Integer -> a
fromInteger :: Integer -> Word32) (Integer -> Maybe Machine) -> Integer -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Integer
i
  Text
"GHC.Prim.byteSwap64#" | [Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine)
-> (Integer -> Term) -> Integer -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Term
integerToWordLiteral (Integer -> Term) -> (Integer -> Integer) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word64 -> Integer) -> (Integer -> Word64) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Word64
byteSwap64 (Word64 -> Word64) -> (Integer -> Word64) -> Integer -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Word64
forall a. Num a => Integer -> a
fromInteger :: Integer -> Word64) (Integer -> Maybe Machine) -> Integer -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Integer
i
  Text
"GHC.Prim.byteSwap#" | [Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args -- assume 64bits
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine)
-> (Integer -> Term) -> Integer -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Term
integerToWordLiteral (Integer -> Term) -> (Integer -> Integer) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word64 -> Integer) -> (Integer -> Word64) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Word64
byteSwap64 (Word64 -> Word64) -> (Integer -> Word64) -> Integer -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Word64
forall a. Num a => Integer -> a
fromInteger :: Integer -> Word64) (Integer -> Maybe Machine) -> Integer -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Integer
i

#if MIN_VERSION_base(4,14,0)
  Text
"GHC.Prim.bitReverse#" | [Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine)
-> (Integer -> Term) -> Integer -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Term
integerToWordLiteral (Integer -> Term) -> (Integer -> Integer) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word64 -> Integer) -> (Integer -> Word64) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Word64
bitReverse64 (Word64 -> Word64) -> (Integer -> Word64) -> Integer -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Word64
forall a. Num a => Integer -> a
fromInteger (Integer -> Maybe Machine) -> Integer -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Integer
i -- assume 64bits
  Text
"GHC.Prim.bitReverse8#" | [Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine)
-> (Integer -> Term) -> Integer -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Term
integerToWordLiteral (Integer -> Term) -> (Integer -> Integer) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word8 -> Integer) -> (Integer -> Word8) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word8
bitReverse8 (Word8 -> Word8) -> (Integer -> Word8) -> Integer -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Word8
forall a. Num a => Integer -> a
fromInteger (Integer -> Maybe Machine) -> Integer -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Integer
i
  Text
"GHC.Prim.bitReverse16#" | [Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine)
-> (Integer -> Term) -> Integer -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Term
integerToWordLiteral (Integer -> Term) -> (Integer -> Integer) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word16 -> Integer) -> (Integer -> Word16) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Word16
bitReverse16 (Word16 -> Word16) -> (Integer -> Word16) -> Integer -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Word16
forall a. Num a => Integer -> a
fromInteger (Integer -> Maybe Machine) -> Integer -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Integer
i
  Text
"GHC.Prim.bitReverse32#" | [Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine)
-> (Integer -> Term) -> Integer -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Term
integerToWordLiteral (Integer -> Term) -> (Integer -> Integer) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word32 -> Integer) -> (Integer -> Word32) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Word32
bitReverse32 (Word32 -> Word32) -> (Integer -> Word32) -> Integer -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Word32
forall a. Num a => Integer -> a
fromInteger (Integer -> Maybe Machine) -> Integer -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Integer
i
  Text
"GHC.Prim.bitReverse64#" | [Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine)
-> (Integer -> Term) -> Integer -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Term
integerToWordLiteral (Integer -> Term) -> (Integer -> Integer) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word64 -> Integer) -> (Integer -> Word64) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Word64
bitReverse64 (Word64 -> Word64) -> (Integer -> Word64) -> Integer -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Word64
forall a. Num a => Integer -> a
fromInteger (Integer -> Maybe Machine) -> Integer -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Integer
i
#endif

------------
-- Narrowing
------------
  Text
"GHC.Prim.narrow8Int#" | [Integer
i] <- [Value] -> [Integer]
intLiterals' [Value]
args
    -> let !(I# Int#
a)  = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i
           b :: Int#
b = Int# -> Int#
narrow8Int# Int#
a
       in  Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> (Int -> Term) -> Int -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Term
Literal (Literal -> Term) -> (Int -> Literal) -> Int -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral (Integer -> Literal) -> (Int -> Integer) -> Int -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Maybe Machine) -> Int -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
b
  Text
"GHC.Prim.narrow16Int#" | [Integer
i] <- [Value] -> [Integer]
intLiterals' [Value]
args
    -> let !(I# Int#
a)  = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i
           b :: Int#
b = Int# -> Int#
narrow16Int# Int#
a
       in  Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> (Int -> Term) -> Int -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Term
Literal (Literal -> Term) -> (Int -> Literal) -> Int -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral (Integer -> Literal) -> (Int -> Integer) -> Int -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Maybe Machine) -> Int -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
b
  Text
"GHC.Prim.narrow32Int#" | [Integer
i] <- [Value] -> [Integer]
intLiterals' [Value]
args
    -> let !(I# Int#
a)  = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i
           b :: Int#
b = Int# -> Int#
narrow32Int# Int#
a
       in  Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> (Int -> Term) -> Int -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Term
Literal (Literal -> Term) -> (Int -> Literal) -> Int -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral (Integer -> Literal) -> (Int -> Integer) -> Int -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Maybe Machine) -> Int -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
b
  Text
"GHC.Prim.narrow8Word#" | [Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> let !(W# Word#
a)  = Integer -> Word
forall a. Num a => Integer -> a
fromInteger Integer
i
           b :: Word#
b = Word# -> Word#
narrow8Word# Word#
a
       in  Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> (Word -> Term) -> Word -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Term
Literal (Literal -> Term) -> (Word -> Literal) -> Word -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
WordLiteral (Integer -> Literal) -> (Word -> Integer) -> Word -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Integer
forall a. Integral a => a -> Integer
toInteger (Word -> Maybe Machine) -> Word -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Word# -> Word
W# Word#
b
  Text
"GHC.Prim.narrow16Word#" | [Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> let !(W# Word#
a)  = Integer -> Word
forall a. Num a => Integer -> a
fromInteger Integer
i
           b :: Word#
b = Word# -> Word#
narrow16Word# Word#
a
       in  Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> (Word -> Term) -> Word -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Term
Literal (Literal -> Term) -> (Word -> Literal) -> Word -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
WordLiteral (Integer -> Literal) -> (Word -> Integer) -> Word -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Integer
forall a. Integral a => a -> Integer
toInteger (Word -> Maybe Machine) -> Word -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Word# -> Word
W# Word#
b
  Text
"GHC.Prim.narrow32Word#" | [Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> let !(W# Word#
a)  = Integer -> Word
forall a. Num a => Integer -> a
fromInteger Integer
i
           b :: Word#
b = Word# -> Word#
narrow32Word# Word#
a
       in  Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> (Word -> Term) -> Word -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Term
Literal (Literal -> Term) -> (Word -> Literal) -> Word -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
WordLiteral (Integer -> Literal) -> (Word -> Integer) -> Word -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Integer
forall a. Integral a => a -> Integer
toInteger (Word -> Maybe Machine) -> Word -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Word# -> Word
W# Word#
b

----------
-- Double#
----------
  Text
"GHC.Prim.>##"  | Just Term
r <- (Double# -> Double# -> Int#) -> [Value] -> Maybe Term
liftDDI Double# -> Double# -> Int#
(>##)  [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.>=##" | Just Term
r <- (Double# -> Double# -> Int#) -> [Value] -> Maybe Term
liftDDI Double# -> Double# -> Int#
(>=##) [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.==##" | Just Term
r <- (Double# -> Double# -> Int#) -> [Value] -> Maybe Term
liftDDI Double# -> Double# -> Int#
(==##) [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim./=##" | Just Term
r <- (Double# -> Double# -> Int#) -> [Value] -> Maybe Term
liftDDI Double# -> Double# -> Int#
(/=##) [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.<##"  | Just Term
r <- (Double# -> Double# -> Int#) -> [Value] -> Maybe Term
liftDDI Double# -> Double# -> Int#
(<##)  [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.<=##" | Just Term
r <- (Double# -> Double# -> Int#) -> [Value] -> Maybe Term
liftDDI Double# -> Double# -> Int#
(<=##) [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.+##"  | Just Term
r <- (Double# -> Double# -> Double#) -> [Value] -> Maybe Term
liftDDD Double# -> Double# -> Double#
(+##)  [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.-##"  | Just Term
r <- (Double# -> Double# -> Double#) -> [Value] -> Maybe Term
liftDDD Double# -> Double# -> Double#
(-##)  [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.*##"  | Just Term
r <- (Double# -> Double# -> Double#) -> [Value] -> Maybe Term
liftDDD Double# -> Double# -> Double#
(*##)  [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim./##"  | Just Term
r <- (Double# -> Double# -> Double#) -> [Value] -> Maybe Term
liftDDD Double# -> Double# -> Double#
(/##)  [Value]
args
    -> Term -> Maybe Machine
reduce Term
r

  Text
"GHC.Prim.negateDouble#" | Just Term
r <- (Double# -> Double#) -> [Value] -> Maybe Term
liftDD Double# -> Double#
negateDouble# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.fabsDouble#" | Just Term
r <- (Double# -> Double#) -> [Value] -> Maybe Term
liftDD Double# -> Double#
fabsDouble# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r

  Text
"GHC.Prim.double2Int#" | [Rational
i] <- [Value] -> [Rational]
doubleLiterals' [Value]
args
    -> let !(D# Double#
a) = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
i
           r :: Int#
r = Double# -> Int#
double2Int# Double#
a
       in  Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> (Int -> Term) -> Int -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Term
Literal (Literal -> Term) -> (Int -> Literal) -> Int -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral (Integer -> Literal) -> (Int -> Integer) -> Int -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Maybe Machine) -> Int -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
r
  Text
"GHC.Prim.double2Float#"
    | [Lit (DoubleLiteral Rational
d)] <- [Value]
args
    -> Term -> Maybe Machine
reduce (Literal -> Term
Literal (Rational -> Literal
FloatLiteral (Float -> Rational
forall a. Real a => a -> Rational
toRational (Rational -> Float
forall a. Fractional a => Rational -> a
fromRational Rational
d :: Float))))


  Text
"GHC.Prim.expDouble#" | Just Term
r <- (Double# -> Double#) -> [Value] -> Maybe Term
liftDD Double# -> Double#
expDouble# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.logDouble#" | Just Term
r <- (Double# -> Double#) -> [Value] -> Maybe Term
liftDD Double# -> Double#
logDouble# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.sqrtDouble#" | Just Term
r <- (Double# -> Double#) -> [Value] -> Maybe Term
liftDD Double# -> Double#
sqrtDouble# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.sinDouble#" | Just Term
r <- (Double# -> Double#) -> [Value] -> Maybe Term
liftDD Double# -> Double#
sinDouble# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.cosDouble#" | Just Term
r <- (Double# -> Double#) -> [Value] -> Maybe Term
liftDD Double# -> Double#
cosDouble# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.tanDouble#" | Just Term
r <- (Double# -> Double#) -> [Value] -> Maybe Term
liftDD Double# -> Double#
tanDouble# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.asinDouble#" | Just Term
r <- (Double# -> Double#) -> [Value] -> Maybe Term
liftDD Double# -> Double#
asinDouble# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.acosDouble#" | Just Term
r <- (Double# -> Double#) -> [Value] -> Maybe Term
liftDD Double# -> Double#
acosDouble# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.atanDouble#" | Just Term
r <- (Double# -> Double#) -> [Value] -> Maybe Term
liftDD Double# -> Double#
atanDouble# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.sinhDouble#" | Just Term
r <- (Double# -> Double#) -> [Value] -> Maybe Term
liftDD Double# -> Double#
sinhDouble# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.coshDouble#" | Just Term
r <- (Double# -> Double#) -> [Value] -> Maybe Term
liftDD Double# -> Double#
coshDouble# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.tanhDouble#" | Just Term
r <- (Double# -> Double#) -> [Value] -> Maybe Term
liftDD Double# -> Double#
tanhDouble# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r

#if MIN_VERSION_ghc(8,7,0)
  Text
"GHC.Prim.asinhDouble#"  | Just Term
r <- (Double# -> Double#) -> [Value] -> Maybe Term
liftDD Double# -> Double#
asinhDouble# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.acoshDouble#"  | Just Term
r <- (Double# -> Double#) -> [Value] -> Maybe Term
liftDD Double# -> Double#
acoshDouble# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.atanhDouble#"  | Just Term
r <- (Double# -> Double#) -> [Value] -> Maybe Term
liftDD Double# -> Double#
atanhDouble# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
#endif

  Text
"GHC.Prim.**##" | Just Term
r <- (Double# -> Double# -> Double#) -> [Value] -> Maybe Term
liftDDD Double# -> Double# -> Double#
(**##) [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
-- decodeDouble_2Int# :: Double# -> (#Int#, Word#, Word#, Int##)
  Text
"GHC.Prim.decodeDouble_2Int#" | [Rational
i] <- [Value] -> [Rational]
doubleLiterals' [Value]
args
    -> let ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
tupTcNm [Type]
tyArgs) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just TyCon
tupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
tupTcNm TyConMap
tcm
           [DataCon
tupDc] = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
           !(D# Double#
a) = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
i
           !(# Int#
p, Word#
q, Word#
r, Int#
s #) = Double# -> (# Int#, Word#, Word#, Int# #)
decodeDouble_2Int# Double#
a
       in Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
          Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
tupDc) ((Type -> Either Term Type) -> [Type] -> [Either Term Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Either Term Type
forall a b. b -> Either a b
Right [Type]
tyArgs [Either Term Type] -> [Either Term Type] -> [Either Term Type]
forall a. [a] -> [a] -> [a]
++
                   [ Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Literal -> Term) -> (Int -> Literal) -> Int -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral  (Integer -> Literal) -> (Int -> Integer) -> Int -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Term) -> Int -> Term
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
p)
                   , Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Literal -> Term) -> (Word -> Literal) -> Word -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
WordLiteral (Integer -> Literal) -> (Word -> Integer) -> Word -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Integer
forall a. Integral a => a -> Integer
toInteger (Word -> Term) -> Word -> Term
forall a b. (a -> b) -> a -> b
$ Word# -> Word
W# Word#
q)
                   , Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Literal -> Term) -> (Word -> Literal) -> Word -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
WordLiteral (Integer -> Literal) -> (Word -> Integer) -> Word -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Integer
forall a. Integral a => a -> Integer
toInteger (Word -> Term) -> Word -> Term
forall a b. (a -> b) -> a -> b
$ Word# -> Word
W# Word#
r)
                   , Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Literal -> Term) -> (Int -> Literal) -> Int -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral  (Integer -> Literal) -> (Int -> Integer) -> Int -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Term) -> Int -> Term
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
s)])
-- decodeDouble_Int64# :: Double# -> (# Int64#, Int# #)
  Text
"GHC.Prim.decodeDouble_Int64#" | [Rational
i] <- [Value] -> [Rational]
doubleLiterals' [Value]
args
    -> let ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
tupTcNm [Type]
tyArgs) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just TyCon
tupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
tupTcNm TyConMap
tcm
           [DataCon
tupDc] = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
           !(D# Double#
a) = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
i
           !(# Int#
p, Int#
q #) = Double# -> (# Int#, Int# #)
decodeDouble_Int64# Double#
a
       in Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
          Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
tupDc) ((Type -> Either Term Type) -> [Type] -> [Either Term Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Either Term Type
forall a b. b -> Either a b
Right [Type]
tyArgs [Either Term Type] -> [Either Term Type] -> [Either Term Type]
forall a. [a] -> [a] -> [a]
++
                   [ Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Literal -> Term) -> (Int64 -> Literal) -> Int64 -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral  (Integer -> Literal) -> (Int64 -> Integer) -> Int64 -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int64 -> Term) -> Int64 -> Term
forall a b. (a -> b) -> a -> b
$ Int# -> Int64
I64# Int#
p)
                   , Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Literal -> Term) -> (Int -> Literal) -> Int -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral  (Integer -> Literal) -> (Int -> Integer) -> Int -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Term) -> Int -> Term
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
q)])

--------
-- Float
--------
  Text
"GHC.Prim.gtFloat#"  | Just Term
r <- (Float# -> Float# -> Int#) -> [Value] -> Maybe Term
liftFFI Float# -> Float# -> Int#
gtFloat# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.geFloat#"  | Just Term
r <- (Float# -> Float# -> Int#) -> [Value] -> Maybe Term
liftFFI Float# -> Float# -> Int#
geFloat# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.eqFloat#"  | Just Term
r <- (Float# -> Float# -> Int#) -> [Value] -> Maybe Term
liftFFI Float# -> Float# -> Int#
eqFloat# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.neFloat#"  | Just Term
r <- (Float# -> Float# -> Int#) -> [Value] -> Maybe Term
liftFFI Float# -> Float# -> Int#
neFloat# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.ltFloat#"  | Just Term
r <- (Float# -> Float# -> Int#) -> [Value] -> Maybe Term
liftFFI Float# -> Float# -> Int#
ltFloat# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.leFloat#"  | Just Term
r <- (Float# -> Float# -> Int#) -> [Value] -> Maybe Term
liftFFI Float# -> Float# -> Int#
leFloat# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r

  Text
"GHC.Prim.plusFloat#"  | Just Term
r <- (Float# -> Float# -> Float#) -> [Value] -> Maybe Term
liftFFF Float# -> Float# -> Float#
plusFloat# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.minusFloat#"  | Just Term
r <- (Float# -> Float# -> Float#) -> [Value] -> Maybe Term
liftFFF Float# -> Float# -> Float#
minusFloat# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.timesFloat#"  | Just Term
r <- (Float# -> Float# -> Float#) -> [Value] -> Maybe Term
liftFFF Float# -> Float# -> Float#
timesFloat# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.divideFloat#"  | Just Term
r <- (Float# -> Float# -> Float#) -> [Value] -> Maybe Term
liftFFF Float# -> Float# -> Float#
divideFloat# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r

  Text
"GHC.Prim.negateFloat#"  | Just Term
r <- (Float# -> Float#) -> [Value] -> Maybe Term
liftFF Float# -> Float#
negateFloat# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.fabsFloat#"  | Just Term
r <- (Float# -> Float#) -> [Value] -> Maybe Term
liftFF Float# -> Float#
fabsFloat# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r

  Text
"GHC.Prim.float2Int#" | [Rational
i] <- [Value] -> [Rational]
floatLiterals' [Value]
args
    -> let !(F# Float#
a) = Rational -> Float
forall a. Fractional a => Rational -> a
fromRational Rational
i
           r :: Int#
r = Float# -> Int#
float2Int# Float#
a
       in  Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> (Int -> Term) -> Int -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Term
Literal (Literal -> Term) -> (Int -> Literal) -> Int -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral (Integer -> Literal) -> (Int -> Integer) -> Int -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Maybe Machine) -> Int -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
r

  Text
"GHC.Prim.expFloat#"  | Just Term
r <- (Float# -> Float#) -> [Value] -> Maybe Term
liftFF Float# -> Float#
expFloat# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.logFloat#"  | Just Term
r <- (Float# -> Float#) -> [Value] -> Maybe Term
liftFF Float# -> Float#
logFloat# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.sqrtFloat#"  | Just Term
r <- (Float# -> Float#) -> [Value] -> Maybe Term
liftFF Float# -> Float#
sqrtFloat# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.sinFloat#"  | Just Term
r <- (Float# -> Float#) -> [Value] -> Maybe Term
liftFF Float# -> Float#
sinFloat# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.cosFloat#"  | Just Term
r <- (Float# -> Float#) -> [Value] -> Maybe Term
liftFF Float# -> Float#
cosFloat# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.tanFloat#"  | Just Term
r <- (Float# -> Float#) -> [Value] -> Maybe Term
liftFF Float# -> Float#
tanFloat# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.asinFloat#"  | Just Term
r <- (Float# -> Float#) -> [Value] -> Maybe Term
liftFF Float# -> Float#
asinFloat# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.acosFloat#"  | Just Term
r <- (Float# -> Float#) -> [Value] -> Maybe Term
liftFF Float# -> Float#
acosFloat# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.atanFloat#"  | Just Term
r <- (Float# -> Float#) -> [Value] -> Maybe Term
liftFF Float# -> Float#
atanFloat# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.sinhFloat#"  | Just Term
r <- (Float# -> Float#) -> [Value] -> Maybe Term
liftFF Float# -> Float#
sinhFloat# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.coshFloat#"  | Just Term
r <- (Float# -> Float#) -> [Value] -> Maybe Term
liftFF Float# -> Float#
coshFloat# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.tanhFloat#"  | Just Term
r <- (Float# -> Float#) -> [Value] -> Maybe Term
liftFF Float# -> Float#
tanhFloat# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.powerFloat#"  | Just Term
r <- (Float# -> Float# -> Float#) -> [Value] -> Maybe Term
liftFFF Float# -> Float# -> Float#
powerFloat# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r

#if MIN_VERSION_base(4,12,0)
  -- GHC.Float.asinh  -- XXX: Very fragile
  --  $w$casinh is the Double specialisation of asinh
  --  $w$casinh1 is the Float specialisation of asinh
  Text
"GHC.Float.$w$casinh" | Just Term
r <- (Double# -> Double#) -> [Value] -> Maybe Term
liftDD Double# -> Double#
go [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
    where go :: Double# -> Double#
go Double#
f = case Double -> Double
forall a. Floating a => a -> a
asinh (Double# -> Double
D# Double#
f) of
                   D# Double#
f' -> Double#
f'
  Text
"GHC.Float.$w$casinh1" | Just Term
r <- (Float# -> Float#) -> [Value] -> Maybe Term
liftFF Float# -> Float#
go [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
    where go :: Float# -> Float#
go Float#
f = case Float -> Float
forall a. Floating a => a -> a
asinh (Float# -> Float
F# Float#
f) of
                   F# Float#
f' -> Float#
f'
#endif

#if MIN_VERSION_ghc(8,7,0)
  Text
"GHC.Prim.asinhFloat#"  | Just Term
r <- (Float# -> Float#) -> [Value] -> Maybe Term
liftFF Float# -> Float#
asinhFloat# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.acoshFloat#"  | Just Term
r <- (Float# -> Float#) -> [Value] -> Maybe Term
liftFF Float# -> Float#
acoshFloat# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  Text
"GHC.Prim.atanhFloat#"  | Just Term
r <- (Float# -> Float#) -> [Value] -> Maybe Term
liftFF Float# -> Float#
atanhFloat# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
#endif

  Text
"GHC.Prim.float2Double#" | [Rational
i] <- [Value] -> [Rational]
floatLiterals' [Value]
args
    -> let !(F# Float#
a) = Rational -> Float
forall a. Fractional a => Rational -> a
fromRational Rational
i
           r :: Double#
r = Float# -> Double#
float2Double# Float#
a
       in  Term -> Maybe Machine
reduce (Term -> Maybe Machine)
-> (Double -> Term) -> Double -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Term
Literal (Literal -> Term) -> (Double -> Literal) -> Double -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Literal
DoubleLiteral (Rational -> Literal) -> (Double -> Rational) -> Double -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Rational
forall a. Real a => a -> Rational
toRational (Double -> Maybe Machine) -> Double -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Double# -> Double
D# Double#
r


  Text
"GHC.Prim.newByteArray#"
    | [Value
iV,PrimVal PrimInfo
rwTy [Type]
_ [Value]
_] <- [Value]
args
    , [Integer
i] <- [Value] -> [Integer]
intLiterals' [Value
iV]
    -> let ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
tupTcNm [Type]
tyArgs) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just TyCon
tupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
tupTcNm TyConMap
tcm
           [DataCon
tupDc] = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
           p :: Int
p = Machine -> Int
primCount Machine
mach
           lit :: Term
lit = Literal -> Term
Literal (Vector Word8 -> Literal
ByteArrayLiteral (Int -> Word8 -> Vector Word8
forall a. Prim a => Int -> a -> Vector a
Vector.replicate (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i) Word8
0))
           mbaTy :: Type
mbaTy = Type -> Type -> Type
mkFunTy Type
intPrimTy ([Type] -> Type
forall a. [a] -> a
last [Type]
tyArgs)
           newE :: Term
newE = Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
tupDc) ((Type -> Either Term Type) -> [Type] -> [Either Term Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Either Term Type
forall a b. b -> Either a b
Right [Type]
tyArgs [Either Term Type] -> [Either Term Type] -> [Either Term Type]
forall a. [a] -> [a] -> [a]
++
                    [Term -> Either Term Type
forall a b. a -> Either a b
Left (PrimInfo -> Term
Prim PrimInfo
rwTy)
                    ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> [Either Term Type] -> Term
mkApps (PrimInfo -> Term
Prim (Text -> Type -> WorkInfo -> PrimInfo
PrimInfo Text
"GHC.Prim.MutableByteArray#" Type
mbaTy WorkInfo
WorkNever))
                                  [Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Literal -> Term) -> (Integer -> Literal) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral (Integer -> Term) -> Integer -> Term
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
p)])
                    ])
       in Machine -> Maybe Machine
forall a. a -> Maybe a
Just (Machine -> Maybe Machine)
-> (Machine -> Machine) -> Machine -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Machine -> Machine
setTerm Term
newE (Machine -> Maybe Machine) -> Machine -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Int -> Term -> Machine -> Machine
primInsert Int
p Term
lit Machine
mach

  Text
"GHC.Prim.setByteArray#"
    | [PrimVal PrimInfo
_mbaTy [Type]
_ [Value
baV]
      ,Value
offV,Value
lenV,Value
cV
      ,PrimVal PrimInfo
rwTy [Type]
_ [Value]
_
      ] <- [Value]
args
    , [Integer
ba,Integer
off,Integer
len,Integer
c] <- [Value] -> [Integer]
intLiterals' [Value
baV,Value
offV,Value
lenV,Value
cV]
    -> let Just (Literal (ByteArrayLiteral (Vector.Vector Int
voff Int
vlen ByteArray
ba1))) =
              Int -> Machine -> Maybe Term
primLookup (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
ba) Machine
mach
           !(I# Int#
off') = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
off
           !(I# Int#
len') = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
len
           !(I# Int#
c')   = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
c
           ba2 :: ByteArray
ba2 = IO ByteArray -> ByteArray
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteArray -> ByteArray) -> IO ByteArray -> ByteArray
forall a b. (a -> b) -> a -> b
$ do
                  ByteArray.MutableByteArray MutableByteArray# RealWorld
mba <- ByteArray -> IO (MutableByteArray (PrimState IO))
forall (m :: Type -> Type).
PrimMonad m =>
ByteArray -> m (MutableByteArray (PrimState m))
ByteArray.unsafeThawByteArray ByteArray
ba1
                  (State# RealWorld -> State# RealWorld) -> IO ()
svoid (MutableByteArray# RealWorld
-> Int# -> Int# -> Int# -> State# RealWorld -> State# RealWorld
forall d.
MutableByteArray# d -> Int# -> Int# -> Int# -> State# d -> State# d
setByteArray# MutableByteArray# RealWorld
mba Int#
off' Int#
len' Int#
c')
                  MutableByteArray (PrimState IO) -> IO ByteArray
forall (m :: Type -> Type).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
ByteArray.unsafeFreezeByteArray (MutableByteArray# RealWorld -> MutableByteArray RealWorld
forall s. MutableByteArray# s -> MutableByteArray s
ByteArray.MutableByteArray MutableByteArray# RealWorld
mba)
           ba3 :: Term
ba3 = Literal -> Term
Literal (Vector Word8 -> Literal
ByteArrayLiteral (Int -> Int -> ByteArray -> Vector Word8
forall a. Int -> Int -> ByteArray -> Vector a
Vector.Vector Int
voff Int
vlen ByteArray
ba2))
       in Machine -> Maybe Machine
forall a. a -> Maybe a
Just (Machine -> Maybe Machine)
-> (Machine -> Machine) -> Machine -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Machine -> Machine
setTerm (PrimInfo -> Term
Prim PrimInfo
rwTy) (Machine -> Maybe Machine) -> Machine -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Int -> Term -> Machine -> Machine
primUpdate (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
ba) Term
ba3 Machine
mach

  Text
"GHC.Prim.writeWordArray#"
    | [PrimVal PrimInfo
_mbaTy [Type]
_  [Value
baV]
      ,Value
iV,Value
wV
      ,PrimVal PrimInfo
rwTy [Type]
_ [Value]
_
      ] <- [Value]
args
    , [Integer
ba,Integer
i] <- [Value] -> [Integer]
intLiterals' [Value
baV,Value
iV]
    , [Integer
w] <- [Value] -> [Integer]
wordLiterals' [Value
wV]
    -> let Just (Literal (ByteArrayLiteral (Vector.Vector Int
off Int
len ByteArray
ba1))) =
              Int -> Machine -> Maybe Term
primLookup (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
ba) Machine
mach
           !(I# Int#
i') = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i
           !(W# Word#
w') = Integer -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
w
           ba2 :: ByteArray
ba2 = IO ByteArray -> ByteArray
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteArray -> ByteArray) -> IO ByteArray -> ByteArray
forall a b. (a -> b) -> a -> b
$ do
                  ByteArray.MutableByteArray MutableByteArray# RealWorld
mba <- ByteArray -> IO (MutableByteArray (PrimState IO))
forall (m :: Type -> Type).
PrimMonad m =>
ByteArray -> m (MutableByteArray (PrimState m))
ByteArray.unsafeThawByteArray ByteArray
ba1
                  (State# RealWorld -> State# RealWorld) -> IO ()
svoid (MutableByteArray# RealWorld
-> Int# -> Word# -> State# RealWorld -> State# RealWorld
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWordArray# MutableByteArray# RealWorld
mba Int#
i' Word#
w')
                  MutableByteArray (PrimState IO) -> IO ByteArray
forall (m :: Type -> Type).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
ByteArray.unsafeFreezeByteArray (MutableByteArray# RealWorld -> MutableByteArray RealWorld
forall s. MutableByteArray# s -> MutableByteArray s
ByteArray.MutableByteArray MutableByteArray# RealWorld
mba)
           ba3 :: Term
ba3 = Literal -> Term
Literal (Vector Word8 -> Literal
ByteArrayLiteral (Int -> Int -> ByteArray -> Vector Word8
forall a. Int -> Int -> ByteArray -> Vector a
Vector.Vector Int
off Int
len ByteArray
ba2))
       in Machine -> Maybe Machine
forall a. a -> Maybe a
Just (Machine -> Maybe Machine)
-> (Machine -> Machine) -> Machine -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Machine -> Machine
setTerm (PrimInfo -> Term
Prim PrimInfo
rwTy) (Machine -> Maybe Machine) -> Machine -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Int -> Term -> Machine -> Machine
primUpdate (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
ba) Term
ba3 Machine
mach

  Text
"GHC.Prim.unsafeFreezeByteArray#"
    | [PrimVal PrimInfo
_mbaTy [Type]
_ [Value
baV]
      ,PrimVal PrimInfo
rwTy [Type]
_ [Value]
_
      ] <- [Value]
args
    , [Integer
ba] <-  [Value] -> [Integer]
intLiterals' [Value
baV]
    -> let ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
tupTcNm [Type]
tyArgs) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just TyCon
tupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
tupTcNm TyConMap
tcm
           [DataCon
tupDc] = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
           Just Term
ba' = Int -> Machine -> Maybe Term
primLookup (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
ba) Machine
mach
       in  Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
tupDc) ((Type -> Either Term Type) -> [Type] -> [Either Term Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Either Term Type
forall a b. b -> Either a b
Right [Type]
tyArgs [Either Term Type] -> [Either Term Type] -> [Either Term Type]
forall a. [a] -> [a] -> [a]
++
                      [Term -> Either Term Type
forall a b. a -> Either a b
Left (PrimInfo -> Term
Prim PrimInfo
rwTy)
                      ,Term -> Either Term Type
forall a b. a -> Either a b
Left Term
ba'])

  Text
"GHC.Prim.sizeofByteArray#"
    | [Lit (ByteArrayLiteral Vector Word8
ba)] <- [Value]
args
    -> Term -> Maybe Machine
reduce (Literal -> Term
Literal (Integer -> Literal
IntLiteral (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Vector Word8 -> Int
forall a. Prim a => Vector a -> Int
Vector.length Vector Word8
ba))))

  Text
"GHC.Prim.indexWordArray#"
    | [Lit (ByteArrayLiteral (Vector.Vector Int
_ Int
_ (ByteArray.ByteArray ByteArray#
ba))),Value
iV] <- [Value]
args
    , [Integer
i] <- [Value] -> [Integer]
intLiterals' [Value
iV]
    -> let !(I# Int#
i') = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i
           !w :: Word#
w       = ByteArray# -> Int# -> Word#
indexWordArray# ByteArray#
ba Int#
i'
       in  Term -> Maybe Machine
reduce (Literal -> Term
Literal (Integer -> Literal
WordLiteral (Word -> Integer
forall a. Integral a => a -> Integer
toInteger (Word# -> Word
W# Word#
w))))

  Text
"GHC.Prim.getSizeofMutBigNat#"
    | [PrimVal PrimInfo
_mbaTy [Type]
_ [Value
baV]
      ,PrimVal PrimInfo
rwTy [Type]
_ [Value]
_
      ] <- [Value]
args
    , [Integer
ba] <- [Value] -> [Integer]
intLiterals' [Value
baV]
    -> let ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
tupTcNm [Type]
tyArgs) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just TyCon
tupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
tupTcNm TyConMap
tcm
           [DataCon
tupDc] = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
           Just (Literal (ByteArrayLiteral Vector Word8
ba')) = Int -> Machine -> Maybe Term
primLookup (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
ba) Machine
mach
           lit :: Term
lit = Literal -> Term
Literal (Integer -> Literal
IntLiteral (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Vector Word8 -> Int
forall a. Prim a => Vector a -> Int
Vector.length Vector Word8
ba')))
       in  Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
tupDc) ((Type -> Either Term Type) -> [Type] -> [Either Term Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Either Term Type
forall a b. b -> Either a b
Right [Type]
tyArgs [Either Term Type] -> [Either Term Type] -> [Either Term Type]
forall a. [a] -> [a] -> [a]
++
                      [Term -> Either Term Type
forall a b. a -> Either a b
Left (PrimInfo -> Term
Prim PrimInfo
rwTy)
                      ,Term -> Either Term Type
forall a b. a -> Either a b
Left Term
lit])

  Text
"GHC.Prim.resizeMutableByteArray#"
    | [PrimVal PrimInfo
mbaTy [Type]
_ [Value
baV]
      ,Value
iV
      ,PrimVal PrimInfo
rwTy [Type]
_ [Value]
_
      ] <- [Value]
args
    , [Integer
ba,Integer
i] <- [Value] -> [Integer]
intLiterals' [Value
baV,Value
iV]
    -> let ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
tupTcNm [Type]
tyArgs) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just TyCon
tupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
tupTcNm TyConMap
tcm
           [DataCon
tupDc] = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
           p :: Int
p = Machine -> Int
primCount Machine
mach
           Just (Literal (ByteArrayLiteral (Vector.Vector Int
0 Int
_ ByteArray
ba1)))
            = Int -> Machine -> Maybe Term
primLookup (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
ba) Machine
mach
           !(I# Int#
i') = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i
           ba2 :: ByteArray
ba2 = IO ByteArray -> ByteArray
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteArray -> ByteArray) -> IO ByteArray -> ByteArray
forall a b. (a -> b) -> a -> b
$ do
                   ByteArray.MutableByteArray MutableByteArray# RealWorld
mba <- ByteArray -> IO (MutableByteArray (PrimState IO))
forall (m :: Type -> Type).
PrimMonad m =>
ByteArray -> m (MutableByteArray (PrimState m))
ByteArray.unsafeThawByteArray ByteArray
ba1
                   MutableByteArray RealWorld
mba' <- (State# RealWorld
 -> (# State# RealWorld, MutableByteArray RealWorld #))
-> IO (MutableByteArray RealWorld)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO (\State# RealWorld
s -> case MutableByteArray# RealWorld
-> Int#
-> State# RealWorld
-> (# State# RealWorld, MutableByteArray# RealWorld #)
forall d.
MutableByteArray# d
-> Int# -> State# d -> (# State# d, MutableByteArray# d #)
resizeMutableByteArray# MutableByteArray# RealWorld
mba Int#
i' State# RealWorld
s of
                                 (# State# RealWorld
s', MutableByteArray# RealWorld
mba' #) -> (# State# RealWorld
s', MutableByteArray# RealWorld -> MutableByteArray RealWorld
forall s. MutableByteArray# s -> MutableByteArray s
ByteArray.MutableByteArray MutableByteArray# RealWorld
mba' #))
                   MutableByteArray (PrimState IO) -> IO ByteArray
forall (m :: Type -> Type).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
ByteArray.unsafeFreezeByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
mba'
           ba3 :: Term
ba3 = Literal -> Term
Literal (Vector Word8 -> Literal
ByteArrayLiteral (Int -> Int -> ByteArray -> Vector Word8
forall a. Int -> Int -> ByteArray -> Vector a
Vector.Vector Int
0 (Int# -> Int
I# Int#
i') ByteArray
ba2))
           newE :: Term
newE = Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
tupDc) ((Type -> Either Term Type) -> [Type] -> [Either Term Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Either Term Type
forall a b. b -> Either a b
Right [Type]
tyArgs [Either Term Type] -> [Either Term Type] -> [Either Term Type]
forall a. [a] -> [a] -> [a]
++
                    [Term -> Either Term Type
forall a b. a -> Either a b
Left (PrimInfo -> Term
Prim PrimInfo
rwTy)
                    ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> [Either Term Type] -> Term
mkApps (PrimInfo -> Term
Prim PrimInfo
mbaTy)
                                  [Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Literal -> Term) -> (Integer -> Literal) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral (Integer -> Term) -> Integer -> Term
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
p)])
                    ])
       in Machine -> Maybe Machine
forall a. a -> Maybe a
Just (Machine -> Maybe Machine)
-> (Machine -> Machine) -> Machine -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Machine -> Machine
setTerm Term
newE (Machine -> Maybe Machine) -> Machine -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Int -> Term -> Machine -> Machine
primInsert Int
p Term
ba3 Machine
mach

  Text
"GHC.Prim.shrinkMutableByteArray#"
    | [PrimVal PrimInfo
_mbaTy [Type]
_ [Value
baV]
      ,Value
lenV
      ,PrimVal PrimInfo
rwTy [Type]
_ [Value]
_
      ] <- [Value]
args
    , [Integer
ba,Integer
len] <- [Value] -> [Integer]
intLiterals' [Value
baV,Value
lenV]
    -> let Just (Literal (ByteArrayLiteral (Vector.Vector Int
voff Int
vlen ByteArray
ba1))) =
              Int -> Machine -> Maybe Term
primLookup (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
ba) Machine
mach
           !(I# Int#
len') = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
len
           ba2 :: ByteArray
ba2 = IO ByteArray -> ByteArray
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteArray -> ByteArray) -> IO ByteArray -> ByteArray
forall a b. (a -> b) -> a -> b
$ do
                  ByteArray.MutableByteArray MutableByteArray# RealWorld
mba <- ByteArray -> IO (MutableByteArray (PrimState IO))
forall (m :: Type -> Type).
PrimMonad m =>
ByteArray -> m (MutableByteArray (PrimState m))
ByteArray.unsafeThawByteArray ByteArray
ba1
                  (State# RealWorld -> State# RealWorld) -> IO ()
svoid (MutableByteArray# RealWorld
-> Int# -> State# RealWorld -> State# RealWorld
forall d. MutableByteArray# d -> Int# -> State# d -> State# d
shrinkMutableByteArray# MutableByteArray# RealWorld
mba Int#
len')
                  MutableByteArray (PrimState IO) -> IO ByteArray
forall (m :: Type -> Type).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
ByteArray.unsafeFreezeByteArray (MutableByteArray# RealWorld -> MutableByteArray RealWorld
forall s. MutableByteArray# s -> MutableByteArray s
ByteArray.MutableByteArray MutableByteArray# RealWorld
mba)
           ba3 :: Term
ba3 = Literal -> Term
Literal (Vector Word8 -> Literal
ByteArrayLiteral (Int -> Int -> ByteArray -> Vector Word8
forall a. Int -> Int -> ByteArray -> Vector a
Vector.Vector Int
voff Int
vlen ByteArray
ba2))
       in Machine -> Maybe Machine
forall a. a -> Maybe a
Just (Machine -> Maybe Machine)
-> (Machine -> Machine) -> Machine -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Machine -> Machine
setTerm (PrimInfo -> Term
Prim PrimInfo
rwTy) (Machine -> Maybe Machine) -> Machine -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Int -> Term -> Machine -> Machine
primUpdate (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
ba) Term
ba3 Machine
mach

  Text
"GHC.Prim.copyByteArray#"
    | [Lit (ByteArrayLiteral (Vector.Vector Int
_ Int
_ (ByteArray.ByteArray ByteArray#
src_ba)))
      ,Value
src_offV
      ,PrimVal PrimInfo
_mbaTy [Type]
_ [Value
dst_mbaV]
      ,Value
dst_offV, Value
nV
      ,PrimVal PrimInfo
rwTy [Type]
_ [Value]
_
      ] <- [Value]
args
    , [Integer
src_off,Integer
dst_mba,Integer
dst_off,Integer
n] <- [Value] -> [Integer]
intLiterals' [Value
src_offV,Value
dst_mbaV,Value
dst_offV,Value
nV]
    -> let Just (Literal (ByteArrayLiteral (Vector.Vector Int
voff Int
vlen ByteArray
dst_ba))) =
              Int -> Machine -> Maybe Term
primLookup (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
dst_mba) Machine
mach
           !(I# Int#
src_off') = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
src_off
           !(I# Int#
dst_off') = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
dst_off
           !(I# Int#
n')       = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n
           ba2 :: ByteArray
ba2 = IO ByteArray -> ByteArray
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteArray -> ByteArray) -> IO ByteArray -> ByteArray
forall a b. (a -> b) -> a -> b
$ do
                  ByteArray.MutableByteArray MutableByteArray# RealWorld
dst_mba1 <- ByteArray -> IO (MutableByteArray (PrimState IO))
forall (m :: Type -> Type).
PrimMonad m =>
ByteArray -> m (MutableByteArray (PrimState m))
ByteArray.unsafeThawByteArray ByteArray
dst_ba
                  (State# RealWorld -> State# RealWorld) -> IO ()
svoid (ByteArray#
-> Int#
-> MutableByteArray# RealWorld
-> Int#
-> Int#
-> State# RealWorld
-> State# RealWorld
forall d.
ByteArray#
-> Int#
-> MutableByteArray# d
-> Int#
-> Int#
-> State# d
-> State# d
copyByteArray# ByteArray#
src_ba Int#
src_off' MutableByteArray# RealWorld
dst_mba1 Int#
dst_off' Int#
n')
                  MutableByteArray (PrimState IO) -> IO ByteArray
forall (m :: Type -> Type).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
ByteArray.unsafeFreezeByteArray (MutableByteArray# RealWorld -> MutableByteArray RealWorld
forall s. MutableByteArray# s -> MutableByteArray s
ByteArray.MutableByteArray MutableByteArray# RealWorld
dst_mba1)
           ba3 :: Term
ba3 = Literal -> Term
Literal (Vector Word8 -> Literal
ByteArrayLiteral (Int -> Int -> ByteArray -> Vector Word8
forall a. Int -> Int -> ByteArray -> Vector a
Vector.Vector Int
voff Int
vlen ByteArray
ba2))
       in Machine -> Maybe Machine
forall a. a -> Maybe a
Just (Machine -> Maybe Machine)
-> (Machine -> Machine) -> Machine -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Machine -> Machine
setTerm (PrimInfo -> Term
Prim PrimInfo
rwTy) (Machine -> Maybe Machine) -> Machine -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Int -> Term -> Machine -> Machine
primUpdate (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
dst_mba) Term
ba3 Machine
mach

  Text
"GHC.Prim.readWordArray#"
    | [PrimVal PrimInfo
_mbaTy [Type]
_  [Value
baV]
      ,Value
offV
      ,PrimVal PrimInfo
rwTy [Type]
_ [Value]
_
      ] <- [Value]
args
    , [Integer
ba,Integer
off] <- [Value] -> [Integer]
intLiterals' [Value
baV,Value
offV]
    -> let ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
tupTcNm [Type]
tyArgs) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just TyCon
tupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
tupTcNm TyConMap
tcm
           [DataCon
tupDc] = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
           Just (Literal (ByteArrayLiteral (Vector.Vector Int
_ Int
_ ByteArray
ba1))) =
              Int -> Machine -> Maybe Term
primLookup (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
ba) Machine
mach
           !(I# Int#
off') = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
off
           w :: Word
w = IO Word -> Word
forall a. IO a -> a
unsafeDupablePerformIO (IO Word -> Word) -> IO Word -> Word
forall a b. (a -> b) -> a -> b
$ do
                  ByteArray.MutableByteArray MutableByteArray# RealWorld
mba <- ByteArray -> IO (MutableByteArray (PrimState IO))
forall (m :: Type -> Type).
PrimMonad m =>
ByteArray -> m (MutableByteArray (PrimState m))
ByteArray.unsafeThawByteArray ByteArray
ba1
                  (State# RealWorld -> (# State# RealWorld, Word #)) -> IO Word
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO (\State# RealWorld
s -> case MutableByteArray# RealWorld
-> Int# -> State# RealWorld -> (# State# RealWorld, Word# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
readWordArray# MutableByteArray# RealWorld
mba Int#
off' State# RealWorld
s of
                        (# State# RealWorld
s', Word#
w' #) -> (# State# RealWorld
s',  Word# -> Word
W# Word#
w' #))
           newE :: Term
newE = Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
tupDc) ((Type -> Either Term Type) -> [Type] -> [Either Term Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Either Term Type
forall a b. b -> Either a b
Right [Type]
tyArgs [Either Term Type] -> [Either Term Type] -> [Either Term Type]
forall a. [a] -> [a] -> [a]
++
                    [Term -> Either Term Type
forall a b. a -> Either a b
Left (PrimInfo -> Term
Prim PrimInfo
rwTy)
                    ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
WordLiteral (Word -> Integer
forall a. Integral a => a -> Integer
toInteger Word
w)))
                    ])
       in Term -> Maybe Machine
reduce Term
newE

-- decodeFloat_Int# :: Float# -> (#Int#, Int##)
  Text
"GHC.Prim.decodeFloat_Int#" | [Rational
i] <- [Value] -> [Rational]
floatLiterals' [Value]
args
    -> let ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
tupTcNm [Type]
tyArgs) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just TyCon
tupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
tupTcNm TyConMap
tcm
           [DataCon
tupDc] = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
           !(F# Float#
a) = Rational -> Float
forall a. Fractional a => Rational -> a
fromRational Rational
i
           !(# Int#
p, Int#
q #) = Float# -> (# Int#, Int# #)
decodeFloat_Int# Float#
a
       in Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
          Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
tupDc) ((Type -> Either Term Type) -> [Type] -> [Either Term Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Either Term Type
forall a b. b -> Either a b
Right [Type]
tyArgs [Either Term Type] -> [Either Term Type] -> [Either Term Type]
forall a. [a] -> [a] -> [a]
++
                   [ Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Literal -> Term) -> (Int -> Literal) -> Int -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral  (Integer -> Literal) -> (Int -> Integer) -> Int -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Term) -> Int -> Term
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
p)
                   , Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Literal -> Term) -> (Int -> Literal) -> Int -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral  (Integer -> Literal) -> (Int -> Integer) -> Int -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Term) -> Int -> Term
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
q)])

  Text
"GHC.Prim.tagToEnum#"
    | [ConstTy (TyCon TyConName
tcN)] <- [Type]
tys
    , [Lit (IntLiteral Integer
i)]  <- [Value]
args
    -> let dc :: Maybe DataCon
dc = do { TyCon
tc <- TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
tcN TyConMap
tcm
                   ; let dcs :: [DataCon]
dcs = TyCon -> [DataCon]
tyConDataCons TyCon
tc
                   ; (DataCon -> Bool) -> [DataCon] -> Maybe DataCon
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Maybe a
List.find ((Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1)) (Integer -> Bool) -> (DataCon -> Integer) -> DataCon -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> (DataCon -> Int) -> DataCon -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataCon -> Int
dcTag) [DataCon]
dcs
                   }
       in (\DataCon
e -> Term -> Machine -> Machine
setTerm (DataCon -> Term
Data DataCon
e) Machine
mach) (DataCon -> Machine) -> Maybe DataCon -> Maybe Machine
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe DataCon
dc


  Text
"GHC.Classes.geInt" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
intCLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
j))

  Text
"GHC.Classes.&&"
    | [ Value
lArg , Value
rArg ] <- [Value]
args
    -- evaluation of the arguments is deferred until the evaluation of the unwindPrim
    -- to make `&&` lazy in both arguments
    , mach1 :: Machine
mach1@Machine{mStack :: Machine -> Stack
mStack=[],mTerm :: Machine -> Term
mTerm=Term
lArgWHNF} <- TyConMap -> Bool -> Machine -> Machine
whnf TyConMap
tcm Bool
True (Term -> Machine -> Machine
setTerm (Value -> Term
valToTerm Value
lArg) (Machine -> Machine) -> Machine -> Machine
forall a b. (a -> b) -> a -> b
$ Machine -> Machine
stackClear Machine
mach)
    , mach2 :: Machine
mach2@Machine{mStack :: Machine -> Stack
mStack=[],mTerm :: Machine -> Term
mTerm=Term
rArgWHNF} <- TyConMap -> Bool -> Machine -> Machine
whnf TyConMap
tcm Bool
True (Term -> Machine -> Machine
setTerm (Value -> Term
valToTerm Value
rArg) (Machine -> Machine) -> Machine -> Machine
forall a b. (a -> b) -> a -> b
$ Machine -> Machine
stackClear Machine
mach1)
    -> case [ Term
lArgWHNF, Term
rArgWHNF ] of
         [ Data DataCon
lCon, Data DataCon
rCon ] ->
           Machine -> Maybe Machine
forall a. a -> Maybe a
Just (Machine -> Maybe Machine) -> Machine -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Machine
mach2
             { mStack :: Stack
mStack = Machine -> Stack
mStack Machine
mach
             , mTerm :: Term
mTerm = TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (DataCon -> Bool
isTrueDC DataCon
lCon Bool -> Bool -> Bool
&& DataCon -> Bool
isTrueDC DataCon
rCon)
             }

         [ Data DataCon
lCon, Term
_ ]
           | DataCon -> Bool
isTrueDC DataCon
lCon -> Term -> Maybe Machine
reduce Term
rArgWHNF
           | Bool
otherwise     -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty Bool
False)

         [ Term
_, Data DataCon
rCon ]
           | DataCon -> Bool
isTrueDC DataCon
rCon -> Term -> Maybe Machine
reduce Term
lArgWHNF
           | Bool
otherwise     -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty Bool
False)

         [Term]
_ -> Maybe Machine
forall a. Maybe a
Nothing

  Text
"GHC.Classes.||"
    | [ Value
lArg , Value
rArg ] <- [Value]
args
    -- evaluation of the arguments is deferred until the evaluation of the unwindPrim
    -- to make `||` lazy in both arguments
    , mach1 :: Machine
mach1@Machine{mStack :: Machine -> Stack
mStack=[],mTerm :: Machine -> Term
mTerm=Term
lArgWHNF} <- TyConMap -> Bool -> Machine -> Machine
whnf TyConMap
tcm Bool
True (Term -> Machine -> Machine
setTerm (Value -> Term
valToTerm Value
lArg) (Machine -> Machine) -> Machine -> Machine
forall a b. (a -> b) -> a -> b
$ Machine -> Machine
stackClear Machine
mach)
    , mach2 :: Machine
mach2@Machine{mStack :: Machine -> Stack
mStack=[],mTerm :: Machine -> Term
mTerm=Term
rArgWHNF} <- TyConMap -> Bool -> Machine -> Machine
whnf TyConMap
tcm Bool
True (Term -> Machine -> Machine
setTerm (Value -> Term
valToTerm Value
rArg) (Machine -> Machine) -> Machine -> Machine
forall a b. (a -> b) -> a -> b
$ Machine -> Machine
stackClear Machine
mach1)
    -> case [ Term
lArgWHNF, Term
rArgWHNF ] of
         [ Data DataCon
lCon, Data DataCon
rCon ] ->
           Machine -> Maybe Machine
forall a. a -> Maybe a
Just (Machine -> Maybe Machine) -> Machine -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Machine
mach2
             { mStack :: Stack
mStack = Machine -> Stack
mStack Machine
mach
             , mTerm :: Term
mTerm = TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (DataCon -> Bool
isTrueDC DataCon
lCon Bool -> Bool -> Bool
|| DataCon -> Bool
isTrueDC DataCon
rCon)
             }

         [ Data DataCon
lCon, Term
_ ]
           | DataCon -> Bool
isFalseDC DataCon
lCon -> Term -> Maybe Machine
reduce Term
rArgWHNF
           | Bool
otherwise      -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty Bool
True)

         [ Term
_, Data DataCon
rCon ]
           | DataCon -> Bool
isFalseDC DataCon
rCon -> Term -> Maybe Machine
reduce Term
lArgWHNF
           | Bool
otherwise      -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty Bool
True)

         [Term]
_ -> Maybe Machine
forall a. Maybe a
Nothing

  Text
"GHC.Classes.divInt#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
intLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToIntLiteral (Integer
i Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
j))

  -- modInt# :: Int# -> Int# -> Int#
  Text
"GHC.Classes.modInt#"
    | [Integer
dividend, Integer
divisor] <- [Value] -> [Integer]
intLiterals' [Value]
args
    ->
      if Integer
divisor Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then
        let iTy :: Type
iTy = ([Either TyVar Type], Type) -> Type
forall a b. (a, b) -> b
snd (Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty) in
        Term -> Maybe Machine
reduce (Type -> Term
undefinedTm Type
iTy)
      else
        Term -> Maybe Machine
reduce (Literal -> Term
Literal (Integer -> Literal
IntLiteral (Integer
dividend Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
divisor)))

  Text
"GHC.Classes.not"
    | [DC DataCon
bCon [Either Term Type]
_] <- [Value]
args
    -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (Name DataCon -> Text
forall a. Name a -> Text
nameOcc (DataCon -> Name DataCon
dcName DataCon
bCon) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"GHC.Types.False"))

  Text
"GHC.Integer.Logarithms.integerLogBase#"
    | Just (Integer
a,Integer
b) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    , Just Int
c <- Integer -> Integer -> Maybe Int
flogBase Integer
a Integer
b
    -> (Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> (Int -> Term) -> Int -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Term
Literal (Literal -> Term) -> (Int -> Literal) -> Int -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral (Integer -> Literal) -> (Int -> Integer) -> Int -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger) Int
c

  Text
"GHC.Integer.Type.smallInteger"
    | [Lit (IntLiteral Integer
i)] <- [Value]
args
    -> Term -> Maybe Machine
reduce (Literal -> Term
Literal (Integer -> Literal
IntegerLiteral Integer
i))

  Text
"GHC.Integer.Type.integerToInt"
    | [Integer
i] <- [Value] -> [Integer]
integerLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToIntLiteral Integer
i)

  Text
"GHC.Integer.Type.decodeDoubleInteger" -- :: Double# -> (#Integer, Int##)
    | [Lit (DoubleLiteral Rational
i)] <- [Value]
args
    -> let ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
tupTcNm [Type]
tyArgs) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just TyCon
tupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
tupTcNm TyConMap
tcm
           [DataCon
tupDc] = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
           !(D# Double#
a)  = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
i
           !(# Integer
b, Int#
c #) = Double# -> (# Integer, Int# #)
decodeDoubleInteger Double#
a
    in Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
       Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
tupDc) ((Type -> Either Term Type) -> [Type] -> [Either Term Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Either Term Type
forall a b. b -> Either a b
Right [Type]
tyArgs [Either Term Type] -> [Either Term Type] -> [Either Term Type]
forall a. [a] -> [a] -> [a]
++
                [ Term -> Either Term Type
forall a b. a -> Either a b
Left (Integer -> Term
integerToIntegerLiteral Integer
b)
                , Term -> Either Term Type
forall a b. a -> Either a b
Left (Integer -> Term
integerToIntLiteral (Integer -> Term) -> (Int -> Integer) -> Int -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Term) -> Int -> Term
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
c)])

  Text
"GHC.Integer.Type.encodeDoubleInteger" -- :: Integer -> Int# -> Double#
    | [Value
iV, Lit (IntLiteral Integer
j)] <- [Value]
args
    , [Integer
i] <- [Value] -> [Integer]
integerLiterals' [Value
iV]
    -> let !(I# Int#
k') = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
j
           r :: Double#
r = Integer -> Int# -> Double#
encodeDoubleInteger Integer
i Int#
k'
    in  Term -> Maybe Machine
reduce (Term -> Maybe Machine)
-> (Double -> Term) -> Double -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Term
Literal (Literal -> Term) -> (Double -> Literal) -> Double -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Literal
DoubleLiteral (Rational -> Literal) -> (Double -> Rational) -> Double -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Rational
forall a. Real a => a -> Rational
toRational (Double -> Maybe Machine) -> Double -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Double# -> Double
D# Double#
r

  Text
"GHC.Integer.Type.quotRemInteger" -- :: Integer -> Integer -> (#Integer, Integer#)
    | [Integer
i, Integer
j] <- [Value] -> [Integer]
integerLiterals' [Value]
args
    -> let ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
tupTcNm [Type]
tyArgs) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just TyCon
tupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
tupTcNm TyConMap
tcm
           [DataCon
tupDc] = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
           (Integer
q,Integer
r) = Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
quotRem Integer
i Integer
j
    in Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
         Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
tupDc) ((Type -> Either Term Type) -> [Type] -> [Either Term Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Either Term Type
forall a b. b -> Either a b
Right [Type]
tyArgs [Either Term Type] -> [Either Term Type] -> [Either Term Type]
forall a. [a] -> [a] -> [a]
++
                [ Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> Either Term Type) -> Term -> Either Term Type
forall a b. (a -> b) -> a -> b
$ Term -> Term
catchDivByZero (Integer -> Term
integerToIntegerLiteral Integer
q)
                , Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> Either Term Type) -> Term -> Either Term Type
forall a b. (a -> b) -> a -> b
$ Term -> Term
catchDivByZero (Integer -> Term
integerToIntegerLiteral Integer
r)])

  Text
"GHC.Integer.Type.plusInteger" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToIntegerLiteral (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
j))

  Text
"GHC.Integer.Type.minusInteger" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToIntegerLiteral (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
j))

  Text
"GHC.Integer.Type.timesInteger" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToIntegerLiteral (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
j))

  Text
"GHC.Integer.Type.negateInteger"
    | [Integer
i] <- [Value] -> [Integer]
integerLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToIntegerLiteral (Integer -> Integer
forall a. Num a => a -> a
negate Integer
i))

  Text
"GHC.Integer.Type.divInteger" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Term -> Term
catchDivByZero (Integer -> Term
integerToIntegerLiteral (Integer
i Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
j))

  Text
"GHC.Integer.Type.modInteger" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Term -> Term
catchDivByZero (Integer -> Term
integerToIntegerLiteral (Integer
i Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
j))

  Text
"GHC.Integer.Type.quotInteger" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Term -> Term
catchDivByZero (Integer -> Term
integerToIntegerLiteral (Integer
i Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
j))

  Text
"GHC.Integer.Type.remInteger" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Term -> Term
catchDivByZero (Integer -> Term
integerToIntegerLiteral (Integer
i Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`rem` Integer
j))

  Text
"GHC.Integer.Type.divModInteger" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> let ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
ubTupTcNm [Type
liftedKi,Type
_,Type
intTy,Type
_]) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just TyCon
ubTupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
ubTupTcNm TyConMap
tcm
           [DataCon
ubTupDc] = TyCon -> [DataCon]
tyConDataCons TyCon
ubTupTc
           (Integer
d,Integer
m) = Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
divMod Integer
i Integer
j
       in  Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
           Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
ubTupDc) [ Type -> Either Term Type
forall a b. b -> Either a b
Right Type
liftedKi, Type -> Either Term Type
forall a b. b -> Either a b
Right Type
liftedKi
                                 , Type -> Either Term Type
forall a b. b -> Either a b
Right Type
intTy,    Type -> Either Term Type
forall a b. b -> Either a b
Right Type
intTy
                                 , Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> Either Term Type) -> Term -> Either Term Type
forall a b. (a -> b) -> a -> b
$ Term -> Term
catchDivByZero (Literal -> Term
Literal (Integer -> Literal
IntegerLiteral Integer
d))
                                 , Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> Either Term Type) -> Term -> Either Term Type
forall a b. (a -> b) -> a -> b
$ Term -> Term
catchDivByZero (Literal -> Term
Literal (Integer -> Literal
IntegerLiteral Integer
m))
                                 ]

  Text
"GHC.Integer.Type.gtInteger" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
j))

  Text
"GHC.Integer.Type.geInteger" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
j))

  Text
"GHC.Integer.Type.eqInteger" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
j))

  Text
"GHC.Integer.Type.neqInteger" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
j))

  Text
"GHC.Integer.Type.ltInteger" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
j))

  Text
"GHC.Integer.Type.leInteger" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
j))

  Text
"GHC.Integer.Type.gtInteger#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Bool -> Term
boolToIntLiteral (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
j))

  Text
"GHC.Integer.Type.geInteger#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Bool -> Term
boolToIntLiteral (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
j))

  Text
"GHC.Integer.Type.eqInteger#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Bool -> Term
boolToIntLiteral (Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
j))

  Text
"GHC.Integer.Type.neqInteger#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Bool -> Term
boolToIntLiteral (Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
j))

  Text
"GHC.Integer.Type.ltInteger#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Bool -> Term
boolToIntLiteral (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
j))

  Text
"GHC.Integer.Type.leInteger#" | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Bool -> Term
boolToIntLiteral (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
j))

  Text
"GHC.Integer.Type.compareInteger" -- :: Integer -> Integer -> Ordering
    | [Integer
i, Integer
j] <- [Value] -> [Integer]
integerLiterals' [Value]
args
    -> let -- Get the required result type (viewed as an applied type constructor name)
           ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
tupTcNm []) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           -- Find the type constructor from the name
           (Just TyCon
tupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
tupTcNm TyConMap
tcm
           -- Get the data constructors of that type
           -- The type is 'Ordering', so they are: 'LT', 'EQ', 'GT'
           [DataCon
ltDc, DataCon
eqDc, DataCon
gtDc] = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
           -- Do the actual compile-time evaluation
           ordVal :: Ordering
ordVal = Integer -> Integer -> Ordering
compareInteger Integer
i Integer
j
    in Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ case Ordering
ordVal of
        Ordering
LT -> DataCon -> Term
Data DataCon
ltDc
        Ordering
EQ -> DataCon -> Term
Data DataCon
eqDc
        Ordering
GT -> DataCon -> Term
Data DataCon
gtDc

  Text
"GHC.Integer.Type.shiftRInteger"
    | [Value
iV, Lit (IntLiteral Integer
j)] <- [Value]
args
    , [Integer
i] <- [Value] -> [Integer]
integerLiterals' [Value
iV]
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToIntegerLiteral (Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
j))

  Text
"GHC.Integer.Type.shiftLInteger"
    | [Value
iV, Lit (IntLiteral Integer
j)] <- [Value]
args
    , [Integer
i] <- [Value] -> [Integer]
integerLiterals' [Value
iV]
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToIntegerLiteral (Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
j))

  Text
"GHC.Integer.Type.wordToInteger"
    | [Lit (WordLiteral Integer
w)] <- [Value]
args
    -> Term -> Maybe Machine
reduce (Literal -> Term
Literal (Integer -> Literal
IntegerLiteral Integer
w))

  Text
"GHC.Integer.Type.integerToWord"
    | [Integer
i] <- [Value] -> [Integer]
integerLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToWordLiteral Integer
i)

  Text
"GHC.Integer.Type.testBitInteger" -- :: Integer -> Int# -> Bool
    | [Lit (IntegerLiteral Integer
i), Lit (IntLiteral Integer
j)] <- [Value]
args
    -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (Integer -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Integer
i (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
j)))

  Text
"GHC.Natural.NatS#"
    | [Lit (WordLiteral Integer
w)] <- [Value]
args
    -> Term -> Maybe Machine
reduce (Literal -> Term
Literal (Integer -> Literal
NaturalLiteral Integer
w))

  Text
"GHC.Natural.naturalToInteger"
    | [Integer
i] <- [Value] -> [Integer]
naturalLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Literal -> Term
Literal (Integer -> Literal
IntegerLiteral (Integer -> Integer
forall a. Integral a => a -> Integer
toInteger Integer
i)))

  Text
"GHC.Natural.naturalFromInteger"
    | [Integer
i] <- [Value] -> [Integer]
integerLiterals' [Value]
args
    ->
     let nTy :: Type
nTy = ([Either TyVar Type], Type) -> Type
forall a b. (a, b) -> b
snd (Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty) in
     Term -> Maybe Machine
reduce (Type -> Integer -> (Natural -> Natural) -> Term
checkNaturalRange1 Type
nTy Integer
i Natural -> Natural
forall a. a -> a
id)

  -- GHC.shiftLNatural --- XXX: Fragile worker of GHC.shiflLNatural
  Text
"GHC.Natural.$wshiftLNatural"
    | [Value
nV,Value
iV] <- [Value]
args
    , [Integer
n] <- [Value] -> [Integer]
naturalLiterals' [Value
nV]
    , [Int
i] <- Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> [Integer] -> [Int]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [Value] -> [Integer]
intLiterals' [Value
iV]
    ->
     let nTy :: Type
nTy = ([Either TyVar Type], Type) -> Type
forall a b. (a, b) -> b
snd (Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty) in
     Term -> Maybe Machine
reduce (Type -> Integer -> (Natural -> Natural) -> Term
checkNaturalRange1 Type
nTy Integer
n (((Natural -> Int -> Natural) -> Int -> Natural -> Natural
forall a b c. (a -> b -> c) -> b -> a -> c
flip Natural -> Int -> Natural
forall a. Bits a => a -> Int -> a
shiftL) Int
i))

  Text
"GHC.Natural.plusNatural"
    | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
naturalLiterals [Value]
args
    ->
     let nTy :: Type
nTy = ([Either TyVar Type], Type) -> Type
forall a b. (a, b) -> b
snd (Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty) in
     Term -> Maybe Machine
reduce (Type
-> Integer -> Integer -> (Natural -> Natural -> Natural) -> Term
checkNaturalRange2 Type
nTy Integer
i Integer
j Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
(+))

  Text
"GHC.Natural.timesNatural"
    | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
naturalLiterals [Value]
args
    ->
     let nTy :: Type
nTy = ([Either TyVar Type], Type) -> Type
forall a b. (a, b) -> b
snd (Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty) in
     Term -> Maybe Machine
reduce (Type
-> Integer -> Integer -> (Natural -> Natural -> Natural) -> Term
checkNaturalRange2 Type
nTy Integer
i Integer
j Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
(*))

  Text
"GHC.Natural.minusNatural"
    | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
naturalLiterals [Value]
args
    ->
     let nTy :: Type
nTy = ([Either TyVar Type], Type) -> Type
forall a b. (a, b) -> b
snd (Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty) in
     Term -> Maybe Machine
reduce (Type -> [Integer] -> ([Natural] -> Term) -> Term
checkNaturalRange Type
nTy [Integer
i, Integer
j] (\[Natural
i', Natural
j'] ->
                case Natural -> Natural -> Maybe Natural
minusNaturalMaybe Natural
i' Natural
j' of
                  Maybe Natural
Nothing -> Type -> Integer -> (Natural -> Natural) -> Term
checkNaturalRange1 Type
nTy (-Integer
1) Natural -> Natural
forall a. a -> a
id
                  Just Natural
n -> Natural -> Term
naturalToNaturalLiteral Natural
n))

  Text
"GHC.Natural.wordToNatural#"
    | [Lit (WordLiteral Integer
w)] <- [Value]
args
    ->
     let nTy :: Type
nTy = ([Either TyVar Type], Type) -> Type
forall a b. (a, b) -> b
snd (Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty) in
     Term -> Maybe Machine
reduce (Type -> Integer -> (Natural -> Natural) -> Term
checkNaturalRange1 Type
nTy Integer
w Natural -> Natural
forall a. a -> a
id)

  Text
"GHC.Natural.gcdNatural"
    | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
naturalLiterals [Value]
args
    ->
     let nTy :: Type
nTy = ([Either TyVar Type], Type) -> Type
forall a b. (a, b) -> b
snd (Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty) in
     Term -> Maybe Machine
reduce (Type
-> Integer -> Integer -> (Natural -> Natural -> Natural) -> Term
checkNaturalRange2 Type
nTy Integer
i Integer
j Natural -> Natural -> Natural
forall a. Integral a => a -> a -> a
gcd)

  -- GHC.Real.^  -- XXX: Very fragile
  --   ^_f, $wf, $wf1 are specialisations of the internal function f in the implementation of (^) in GHC.Real
  Text
"GHC.Real.^_f"  -- :: Integer -> Integer -> Integer
    | [Integer
i,Integer
j] <- [Value] -> [Integer]
integerLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToIntegerLiteral (Integer -> Term) -> Integer -> Term
forall a b. (a -> b) -> a -> b
$ Integer
i Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
j)
  Text
"GHC.Real.$wf"  -- :: Integer -> Int# -> Integer
    | [Value
iV, Lit (IntLiteral Integer
j)] <- [Value]
args
    , [Integer
i] <- [Value] -> [Integer]
integerLiterals' [Value
iV]
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToIntegerLiteral (Integer -> Term) -> Integer -> Term
forall a b. (a -> b) -> a -> b
$ Integer
i Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
j)
  Text
"GHC.Real.$wf1" -- :: Int# -> Int# -> Int#
    | [Lit (IntLiteral Integer
i), Lit (IntLiteral Integer
j)] <- [Value]
args
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToIntLiteral (Integer -> Term) -> Integer -> Term
forall a b. (a -> b) -> a -> b
$ Integer
i Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
j)

  -- Type level ^    -- XXX: Very fragile
  -- These is are specialized versions of ^_f, named by some combination of ghc and singletons.
  Text
"Data.Singletons.TypeLits.Internal.$s^_f"            -- ghc-8.4.4, singletons-2.4.1
    | [Integer
i,Integer
j] <- [Value] -> [Integer]
naturalLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Literal -> Term
Literal (Integer -> Literal
NaturalLiteral (Integer
i Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
j)))
  Text
"Data.Singletons.TypeLits.Internal.$fSingI->^@#@$_f" -- ghc-8.6.5, singletons-2.5.1
    | [Integer
i,Integer
j] <- [Value] -> [Integer]
naturalLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Literal -> Term
Literal (Integer -> Literal
NaturalLiteral (Integer
i Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
j)))
  Text
"Data.Singletons.TypeLits.Internal.%^_f"             -- ghc-8.8.1, singletons-2.6
    | [Integer
i,Integer
j] <- [Value] -> [Integer]
naturalLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Literal -> Term
Literal (Integer -> Literal
NaturalLiteral (Integer
i Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
j)))

  Text
"GHC.TypeLits.natVal"
    | [Lit (NaturalLiteral Integer
n), Value
_] <- [Value]
args
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToIntegerLiteral Integer
n)

  Text
"GHC.TypeNats.natVal"
    | [Lit (NaturalLiteral Integer
n), Value
_] <- [Value]
args
    -> Term -> Maybe Machine
reduce (Literal -> Term
Literal (Integer -> Literal
NaturalLiteral Integer
n))

  Text
"GHC.Types.C#"
    | Bool
isSubj
    , [Lit (CharLiteral Char
c)] <- [Value]
args
    ->  let ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
charTcNm []) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
            (Just TyCon
charTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
charTcNm TyConMap
tcm
            [DataCon
charDc] = TyCon -> [DataCon]
tyConDataCons TyCon
charTc
        in  Term -> Maybe Machine
reduce (Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
charDc) [Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Char -> Literal
CharLiteral Char
c))])

  Text
"GHC.Types.I#"
    | Bool
isSubj
    , [Lit (IntLiteral Integer
i)] <- [Value]
args
    ->  let ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
intTcNm []) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
            (Just TyCon
intTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
intTcNm TyConMap
tcm
            [DataCon
intDc] = TyCon -> [DataCon]
tyConDataCons TyCon
intTc
        in  Term -> Maybe Machine
reduce (Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
intDc) [Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
IntLiteral Integer
i))])
  Text
"GHC.Int.I8#"
    | Bool
isSubj
    , [Lit (IntLiteral Integer
i)] <- [Value]
args
    ->  let ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
intTcNm []) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
            (Just TyCon
intTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
intTcNm TyConMap
tcm
            [DataCon
intDc] = TyCon -> [DataCon]
tyConDataCons TyCon
intTc
        in  Term -> Maybe Machine
reduce (Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
intDc) [Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
IntLiteral Integer
i))])
  Text
"GHC.Int.I16#"
    | Bool
isSubj
    , [Lit (IntLiteral Integer
i)] <- [Value]
args
    ->  let ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
intTcNm []) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
            (Just TyCon
intTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
intTcNm TyConMap
tcm
            [DataCon
intDc] = TyCon -> [DataCon]
tyConDataCons TyCon
intTc
        in  Term -> Maybe Machine
reduce (Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
intDc) [Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
IntLiteral Integer
i))])
  Text
"GHC.Int.I32#"
    | Bool
isSubj
    , [Lit (IntLiteral Integer
i)] <- [Value]
args
    ->  let ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
intTcNm []) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
            (Just TyCon
intTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
intTcNm TyConMap
tcm
            [DataCon
intDc] = TyCon -> [DataCon]
tyConDataCons TyCon
intTc
        in  Term -> Maybe Machine
reduce (Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
intDc) [Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
IntLiteral Integer
i))])
  Text
"GHC.Int.I64#"
    | Bool
isSubj
    , [Lit (IntLiteral Integer
i)] <- [Value]
args
    ->  let ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
intTcNm []) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
            (Just TyCon
intTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
intTcNm TyConMap
tcm
            [DataCon
intDc] = TyCon -> [DataCon]
tyConDataCons TyCon
intTc
        in  Term -> Maybe Machine
reduce (Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
intDc) [Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
IntLiteral Integer
i))])

  Text
"GHC.Types.W#"
    | Bool
isSubj
    , [Lit (WordLiteral Integer
c)] <- [Value]
args
    ->  let ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
wordTcNm []) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
            (Just TyCon
wordTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
wordTcNm TyConMap
tcm
            [DataCon
wordDc] = TyCon -> [DataCon]
tyConDataCons TyCon
wordTc
        in  Term -> Maybe Machine
reduce (Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
wordDc) [Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
WordLiteral Integer
c))])
  Text
"GHC.Word.W8#"
<