{-|
  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 BangPatterns      #-}
{-# LANGUAGE CPP               #-}
{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE KindSignatures    #-}
{-# LANGUAGE MagicHash         #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes        #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# LANGUAGE TupleSections     #-}
{-# LANGUAGE UnboxedTuples     #-}
{-# LANGUAGE ViewPatterns      #-}

module Clash.GHC.Evaluator where

import           Control.Applicative (liftA2)
import           Control.Concurrent.Supply  (Supply,freshId)
import           Control.DeepSeq            (force)
import           Control.Exception          (ArithException(..), Exception, tryJust, evaluate)
import           Control.Monad              (ap)
import           Control.Monad.Trans.Except (runExcept)
import           Data.Bits
import           Data.Char           (chr,ord)
import qualified Data.Either         as Either
import qualified Data.IntMap         as IntMap
import           Data.Maybe
  (fromMaybe, mapMaybe, catMaybes)
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           Debug.Trace         (trace)
import           GHC.Float
import           GHC.Int
import           GHC.Integer
  (decodeDoubleInteger,encodeDoubleInteger,compareInteger,orInteger,andInteger,
   xorInteger,complementInteger,absInteger,signumInteger)
import           GHC.Natural
import           GHC.Prim
import           GHC.Real            (Ratio (..))
import           GHC.Stack           (HasCallStack)
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)
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
  (Heap (..), PrimEvaluator, Stack, Value (..), valToTerm, whnf, integerLiteral,
  naturalLiteral)
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 (..))
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
  (mkApps,mkRTree,mkVec,piResultTys,tyNatSize,dataConInstArgTys,primCo,
   undefinedTm)
import           Clash.Core.Var      (mkLocalId, mkTyVar)
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)

newtype PrimEvalMonad a = PEM { PrimEvalMonad a -> Supply -> (a, Supply)
runPEM :: Supply -> (a,Supply) }

instance Functor PrimEvalMonad where
  fmap :: (a -> b) -> PrimEvalMonad a -> PrimEvalMonad b
fmap f :: a -> b
f m :: PrimEvalMonad a
m = (Supply -> (b, Supply)) -> PrimEvalMonad b
forall a. (Supply -> (a, Supply)) -> PrimEvalMonad a
PEM (\s :: Supply
s -> case PrimEvalMonad a -> Supply -> (a, Supply)
forall a. PrimEvalMonad a -> Supply -> (a, Supply)
runPEM PrimEvalMonad a
m Supply
s of (a :: a
a,s' :: Supply
s') -> (a -> b
f a
a, Supply
s'))

instance Applicative PrimEvalMonad where
  pure :: a -> PrimEvalMonad a
pure  = a -> PrimEvalMonad a
forall (m :: * -> *) a. Monad m => a -> m a
return
  <*> :: PrimEvalMonad (a -> b) -> PrimEvalMonad a -> PrimEvalMonad b
(<*>) = PrimEvalMonad (a -> b) -> PrimEvalMonad a -> PrimEvalMonad b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad PrimEvalMonad where
  return :: a -> PrimEvalMonad a
return a :: a
a = (Supply -> (a, Supply)) -> PrimEvalMonad a
forall a. (Supply -> (a, Supply)) -> PrimEvalMonad a
PEM (\s :: Supply
s -> (a
a,Supply
s))
  m :: PrimEvalMonad a
m >>= :: PrimEvalMonad a -> (a -> PrimEvalMonad b) -> PrimEvalMonad b
>>= k :: a -> PrimEvalMonad b
k  = (Supply -> (b, Supply)) -> PrimEvalMonad b
forall a. (Supply -> (a, Supply)) -> PrimEvalMonad a
PEM (\s :: Supply
s -> case PrimEvalMonad a -> Supply -> (a, Supply)
forall a. PrimEvalMonad a -> Supply -> (a, Supply)
runPEM PrimEvalMonad a
m Supply
s of (a :: a
a,s' :: Supply
s') -> PrimEvalMonad b -> Supply -> (b, Supply)
forall a. PrimEvalMonad a -> Supply -> (a, Supply)
runPEM (a -> PrimEvalMonad b
k a
a) Supply
s')

instance MonadUnique PrimEvalMonad where
  getUniqueM :: PrimEvalMonad Int
getUniqueM = (Supply -> (Int, Supply)) -> PrimEvalMonad Int
forall a. (Supply -> (a, Supply)) -> PrimEvalMonad a
PEM (\s :: Supply
s -> case Supply -> (Int, Supply)
freshId Supply
s of (!Int
i,!Supply
s') -> (Int
i,Supply
s'))

reduceConstant :: PrimEvaluator
reduceConstant :: PrimEvaluator
reduceConstant isSubj :: Bool
isSubj tcm :: TyConMap
tcm h :: Heap
h k :: Stack
k nm :: Text
nm pInfo :: PrimInfo
pInfo tys :: [Type]
tys args :: [Value]
args = case Text
nm of
-----------------
-- GHC.Prim.Char#
-----------------
  "GHC.Prim.gtChar#" | Just (i :: Char
i,j :: Char
j) <- [Value] -> Maybe (Char, Char)
charLiterals [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Bool -> Term
boolToIntLiteral (Char
i Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
> Char
j))
  "GHC.Prim.geChar#" | Just (i :: Char
i,j :: Char
j) <- [Value] -> Maybe (Char, Char)
charLiterals [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Bool -> Term
boolToIntLiteral (Char
i Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
j))
  "GHC.Prim.eqChar#" | Just (i :: Char
i,j :: Char
j) <- [Value] -> Maybe (Char, Char)
charLiterals [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Bool -> Term
boolToIntLiteral (Char
i Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
j))
  "GHC.Prim.neChar#" | Just (i :: Char
i,j :: Char
j) <- [Value] -> Maybe (Char, Char)
charLiterals [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Bool -> Term
boolToIntLiteral (Char
i Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
j))
  "GHC.Prim.ltChar#" | Just (i :: Char
i,j :: Char
j) <- [Value] -> Maybe (Char, Char)
charLiterals [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Bool -> Term
boolToIntLiteral (Char
i Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
j))
  "GHC.Prim.leChar#" | Just (i :: Char
i,j :: Char
j) <- [Value] -> Maybe (Char, Char)
charLiterals [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Bool -> Term
boolToIntLiteral (Char
i Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
j))
  "GHC.Prim.ord#" | [i :: Char
i] <- [Value] -> [Char]
charLiterals' [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
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#
----------------
  "GHC.Prim.+#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
intLiterals [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Integer -> Term
integerToIntLiteral (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
j))
  "GHC.Prim.-#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
intLiterals [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Integer -> Term
integerToIntLiteral (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
j))
  "GHC.Prim.*#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
intLiterals [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Integer -> Term
integerToIntLiteral (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
j))

  "GHC.Prim.mulIntMayOflo#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
intLiterals  [Value]
args
    -> let !(I# a :: Int#
a)  = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i
           !(I# b :: 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 (Heap, Stack, Term)
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.quotInt#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
intLiterals [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
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))
  "GHC.Prim.remInt#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
intLiterals [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
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))
  "GHC.Prim.quotRemInt#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
intLiterals [Value]
args
    -> let (_,Type -> TypeView
tyView -> TyConApp tupTcNm :: TyConName
tupTcNm tyArgs :: [Type]
tyArgs) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just tupTc :: TyCon
tupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
tupTcNm TyConMap
tcm
           [tupDc :: DataCon
tupDc] = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
           (q :: Integer
q,r :: 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 (Heap, Stack, Term)
reduce Term
ret

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

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

  "GHC.Prim.addIntC#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
intLiterals [Value]
args
    -> let (_,Type -> TypeView
tyView -> TyConApp tupTcNm :: TyConName
tupTcNm tyArgs :: [Type]
tyArgs) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just tupTc :: TyCon
tupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
tupTcNm TyConMap
tcm
           [tupDc :: DataCon
tupDc] = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
           !(I# a :: Int#
a)  = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i
           !(I# b :: Int#
b)  = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
j
           !(# d :: Int#
d, c :: Int#
c #) = Int# -> Int# -> (# Int#, Int# #)
addIntC# Int#
a Int#
b
       in  Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
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)])
  "GHC.Prim.subIntC#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
intLiterals [Value]
args
    -> let (_,Type -> TypeView
tyView -> TyConApp tupTcNm :: TyConName
tupTcNm tyArgs :: [Type]
tyArgs) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just tupTc :: TyCon
tupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
tupTcNm TyConMap
tcm
           [tupDc :: DataCon
tupDc] = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
           !(I# a :: Int#
a)  = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i
           !(I# b :: Int#
b)  = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
j
           !(# d :: Int#
d, c :: Int#
c #) = Int# -> Int# -> (# Int#, Int# #)
subIntC# Int#
a Int#
b
       in  Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
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)])

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

  "GHC.Prim.chr#" | [i :: Integer
i] <- [Value] -> [Integer]
intLiterals' [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
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))

  "GHC.Prim.int2Word#"
    | [Lit (IntLiteral i :: Integer
i)] <- [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> (Word -> Term) -> Word -> Maybe (Heap, Stack, Term)
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 (Heap, Stack, Term))
-> Word -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$ (Integer -> Word
forall a. Num a => Integer -> a
fromInteger :: Integer -> Word) Integer
i -- for overflow behavior

  "GHC.Prim.int2Float#"
    | [Lit (IntLiteral i :: Integer
i)] <- [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> (Float -> Term) -> Float -> Maybe (Heap, Stack, Term)
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 (Heap, Stack, Term))
-> Float -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$ (Integer -> Float
forall a. Num a => Integer -> a
fromInteger Integer
i :: Float)
  "GHC.Prim.int2Double#"
    | [Lit (IntLiteral i :: Integer
i)] <- [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> (Double -> Term) -> Double -> Maybe (Heap, Stack, Term)
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 (Heap, Stack, Term))
-> Double -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$ (Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
i :: Double)

  "GHC.Prim.word2Float#"
    | [Lit (WordLiteral i :: Integer
i)] <- [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> (Float -> Term) -> Float -> Maybe (Heap, Stack, Term)
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 (Heap, Stack, Term))
-> Float -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$ (Integer -> Float
forall a. Num a => Integer -> a
fromInteger Integer
i :: Float)
  "GHC.Prim.word2Double#"
    | [Lit (WordLiteral i :: Integer
i)] <- [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> (Double -> Term) -> Double -> Maybe (Heap, Stack, Term)
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 (Heap, Stack, Term))
-> Double -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$ (Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
i :: Double)

  "GHC.Prim.uncheckedIShiftL#"
    | [ Lit (IntLiteral i :: Integer
i)
      , Lit (IntLiteral s :: Integer
s)
      ] <- [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
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))
  "GHC.Prim.uncheckedIShiftRA#"
    | [ Lit (IntLiteral i :: Integer
i)
      , Lit (IntLiteral s :: Integer
s)
      ] <- [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
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))
  "GHC.Prim.uncheckedIShiftRL#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
intLiterals [Value]
args
    -> let !(I# a :: Int#
a)  = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i
           !(I# b :: 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 (Heap, Stack, Term)
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#
-----------------
  "GHC.Prim.plusWord#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
wordLiterals [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Integer -> Term
integerToWordLiteral (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
j))

  "GHC.Prim.subWordC#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
wordLiterals [Value]
args
    -> let (_,Type -> TypeView
tyView -> TyConApp tupTcNm :: TyConName
tupTcNm tyArgs :: [Type]
tyArgs) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just tupTc :: TyCon
tupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
tupTcNm TyConMap
tcm
           [tupDc :: DataCon
tupDc] = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
           !(W# a :: Word#
a)  = Integer -> Word
forall a. Num a => Integer -> a
fromInteger Integer
i
           !(W# b :: Word#
b)  = Integer -> Word
forall a. Num a => Integer -> a
fromInteger Integer
j
           !(# d :: Word#
d, c :: Int#
c #) = Word# -> Word# -> (# Word#, Int# #)
subWordC# Word#
a Word#
b
       in  Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
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)])

  "GHC.Prim.plusWord2#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
wordLiterals [Value]
args
    -> let (_,Type -> TypeView
tyView -> TyConApp tupTcNm :: TyConName
tupTcNm tyArgs :: [Type]
tyArgs) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just tupTc :: TyCon
tupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
tupTcNm TyConMap
tcm
           [tupDc :: DataCon
tupDc] = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
           !(W# a :: Word#
a)  = Integer -> Word
forall a. Num a => Integer -> a
fromInteger Integer
i
           !(W# b :: Word#
b)  = Integer -> Word
forall a. Num a => Integer -> a
fromInteger Integer
j
           !(# h' :: Word#
h', l :: Word#
l #) = Word# -> Word# -> (# Word#, Word# #)
plusWord2# Word#
a Word#
b
       in  Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
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)])

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

  "GHC.Prim.timesWord2#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
wordLiterals [Value]
args
    -> let (_,Type -> TypeView
tyView -> TyConApp tupTcNm :: TyConName
tupTcNm tyArgs :: [Type]
tyArgs) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just tupTc :: TyCon
tupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
tupTcNm TyConMap
tcm
           [tupDc :: DataCon
tupDc] = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
           !(W# a :: Word#
a)  = Integer -> Word
forall a. Num a => Integer -> a
fromInteger Integer
i
           !(W# b :: Word#
b)  = Integer -> Word
forall a. Num a => Integer -> a
fromInteger Integer
j
           !(# h' :: Word#
h', l :: Word#
l #) = Word# -> Word# -> (# Word#, Word# #)
timesWord2# Word#
a Word#
b
       in  Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
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)])

  "GHC.Prim.quotWord#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
wordLiterals [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
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))
  "GHC.Prim.remWord#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
wordLiterals [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
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))
  "GHC.Prim.quotRemWord#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
wordLiterals [Value]
args
    -> let (_,Type -> TypeView
tyView -> TyConApp tupTcNm :: TyConName
tupTcNm tyArgs :: [Type]
tyArgs) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just tupTc :: TyCon
tupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
tupTcNm TyConMap
tcm
           [tupDc :: DataCon
tupDc] = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
           (q :: Integer
q,r :: 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 (Heap, Stack, Term)
reduce Term
ret
  "GHC.Prim.quotRemWord2#" | [i :: Integer
i,j :: Integer
j,k' :: Integer
k'] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> let (_,Type -> TypeView
tyView -> TyConApp tupTcNm :: TyConName
tupTcNm tyArgs :: [Type]
tyArgs) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just tupTc :: TyCon
tupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
tupTcNm TyConMap
tcm
           [tupDc :: DataCon
tupDc] = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
           !(W# a :: Word#
a)  = Integer -> Word
forall a. Num a => Integer -> a
fromInteger Integer
i
           !(W# b :: Word#
b)  = Integer -> Word
forall a. Num a => Integer -> a
fromInteger Integer
j
           !(W# c :: Word#
c)  = Integer -> Word
forall a. Num a => Integer -> a
fromInteger Integer
k'
           !(# x :: Word#
x, y :: Word#
y #) = Word# -> Word# -> Word# -> (# Word#, Word# #)
quotRemWord2# Word#
a Word#
b Word#
c
       in  Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
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)])

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

  "GHC.Prim.uncheckedShiftL#"
    | [ Lit (WordLiteral w :: Integer
w)
      , Lit (IntLiteral  i :: Integer
i)
      ] <- [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
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)))
  "GHC.Prim.uncheckedShiftRL#"
    | [ Lit (WordLiteral w :: Integer
w)
      , Lit (IntLiteral  i :: Integer
i)
      ] <- [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
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)))

  "GHC.Prim.word2Int#"
    | [Lit (WordLiteral i :: Integer
i)] <- [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> (Int -> Term) -> Int -> Maybe (Heap, Stack, Term)
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 (Heap, Stack, Term))
-> Int -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$ (Integer -> Int
forall a. Num a => Integer -> a
fromInteger :: Integer -> Int) Integer
i -- for overflow behavior

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

  "GHC.Prim.popCnt8#" | [i :: Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> (Integer -> Term) -> Integer -> Maybe (Heap, Stack, Term)
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 (Heap, Stack, Term))
-> Integer -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$ Integer
i
  "GHC.Prim.popCnt16#" | [i :: Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> (Integer -> Term) -> Integer -> Maybe (Heap, Stack, Term)
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 (Heap, Stack, Term))
-> Integer -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$ Integer
i
  "GHC.Prim.popCnt32#" | [i :: Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> (Integer -> Term) -> Integer -> Maybe (Heap, Stack, Term)
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 (Heap, Stack, Term))
-> Integer -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$ Integer
i
  "GHC.Prim.popCnt64#" | [i :: Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> (Integer -> Term) -> Integer -> Maybe (Heap, Stack, Term)
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 (Heap, Stack, Term))
-> Integer -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$ Integer
i
  "GHC.Prim.popCnt#" | [i :: Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> (Integer -> Term) -> Integer -> Maybe (Heap, Stack, Term)
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 (Heap, Stack, Term))
-> Integer -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$ Integer
i

  "GHC.Prim.clz8#" | [i :: Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> (Integer -> Term) -> Integer -> Maybe (Heap, Stack, Term)
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 (Heap, Stack, Term))
-> Integer -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$ Integer
i
  "GHC.Prim.clz16#" | [i :: Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> (Integer -> Term) -> Integer -> Maybe (Heap, Stack, Term)
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 (Heap, Stack, Term))
-> Integer -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$ Integer
i
  "GHC.Prim.clz32#" | [i :: Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> (Integer -> Term) -> Integer -> Maybe (Heap, Stack, Term)
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 (Heap, Stack, Term))
-> Integer -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$ Integer
i
  "GHC.Prim.clz64#" | [i :: Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> (Integer -> Term) -> Integer -> Maybe (Heap, Stack, Term)
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 (Heap, Stack, Term))
-> Integer -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$ Integer
i
  "GHC.Prim.clz#" | [i :: Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> (Integer -> Term) -> Integer -> Maybe (Heap, Stack, Term)
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 (Heap, Stack, Term))
-> Integer -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$ Integer
i

  "GHC.Prim.ctz8#" | [i :: Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> (Integer -> Term) -> Integer -> Maybe (Heap, Stack, Term)
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 (Heap, Stack, Term))
-> Integer -> Maybe (Heap, Stack, Term)
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 8 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 1)
  "GHC.Prim.ctz16#" | [i :: Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> (Integer -> Term) -> Integer -> Maybe (Heap, Stack, Term)
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 (Heap, Stack, Term))
-> Integer -> Maybe (Heap, Stack, Term)
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 16 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 1)
  "GHC.Prim.ctz32#" | [i :: Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> (Integer -> Term) -> Integer -> Maybe (Heap, Stack, Term)
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 (Heap, Stack, Term))
-> Integer -> Maybe (Heap, Stack, Term)
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 32 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 1)
  "GHC.Prim.ctz64#" | [i :: Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> (Integer -> Term) -> Integer -> Maybe (Heap, Stack, Term)
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 (Heap, Stack, Term))
-> Integer -> Maybe (Heap, Stack, Term)
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 64 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 1)
  "GHC.Prim.ctz#" | [i :: Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> (Integer -> Term) -> Integer -> Maybe (Heap, Stack, Term)
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 (Heap, Stack, Term))
-> Integer -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$ Integer
i

  "GHC.Prim.byteSwap16#" | [i :: Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> (Integer -> Term) -> Integer -> Maybe (Heap, Stack, Term)
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 (Heap, Stack, Term))
-> Integer -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$ Integer
i
  "GHC.Prim.byteSwap32#" | [i :: Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> (Integer -> Term) -> Integer -> Maybe (Heap, Stack, Term)
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 (Heap, Stack, Term))
-> Integer -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$ Integer
i
  "GHC.Prim.byteSwap64#" | [i :: Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> (Integer -> Term) -> Integer -> Maybe (Heap, Stack, Term)
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 (Heap, Stack, Term))
-> Integer -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$ Integer
i
  "GHC.Prim.byteSwap#" | [i :: Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args -- assume 64bits
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> (Integer -> Term) -> Integer -> Maybe (Heap, Stack, Term)
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 (Heap, Stack, Term))
-> Integer -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$ Integer
i

------------
-- Narrowing
------------
  "GHC.Prim.narrow8Int#" | [i :: Integer
i] <- [Value] -> [Integer]
intLiterals' [Value]
args
    -> let !(I# a :: Int#
a)  = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i
           b :: Int#
b = Int# -> Int#
narrow8Int# Int#
a
       in  Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> (Int -> Term) -> Int -> Maybe (Heap, Stack, Term)
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 (Heap, Stack, Term))
-> Int -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
b
  "GHC.Prim.narrow16Int#" | [i :: Integer
i] <- [Value] -> [Integer]
intLiterals' [Value]
args
    -> let !(I# a :: Int#
a)  = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i
           b :: Int#
b = Int# -> Int#
narrow16Int# Int#
a
       in  Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> (Int -> Term) -> Int -> Maybe (Heap, Stack, Term)
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 (Heap, Stack, Term))
-> Int -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
b
  "GHC.Prim.narrow32Int#" | [i :: Integer
i] <- [Value] -> [Integer]
intLiterals' [Value]
args
    -> let !(I# a :: Int#
a)  = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i
           b :: Int#
b = Int# -> Int#
narrow32Int# Int#
a
       in  Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> (Int -> Term) -> Int -> Maybe (Heap, Stack, Term)
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 (Heap, Stack, Term))
-> Int -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
b
  "GHC.Prim.narrow8Word#" | [i :: Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> let !(W# a :: Word#
a)  = Integer -> Word
forall a. Num a => Integer -> a
fromInteger Integer
i
           b :: Word#
b = Word# -> Word#
narrow8Word# Word#
a
       in  Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> (Word -> Term) -> Word -> Maybe (Heap, Stack, Term)
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 (Heap, Stack, Term))
-> Word -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$ Word# -> Word
W# Word#
b
  "GHC.Prim.narrow16Word#" | [i :: Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> let !(W# a :: Word#
a)  = Integer -> Word
forall a. Num a => Integer -> a
fromInteger Integer
i
           b :: Word#
b = Word# -> Word#
narrow16Word# Word#
a
       in  Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> (Word -> Term) -> Word -> Maybe (Heap, Stack, Term)
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 (Heap, Stack, Term))
-> Word -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$ Word# -> Word
W# Word#
b
  "GHC.Prim.narrow32Word#" | [i :: Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> let !(W# a :: Word#
a)  = Integer -> Word
forall a. Num a => Integer -> a
fromInteger Integer
i
           b :: Word#
b = Word# -> Word#
narrow32Word# Word#
a
       in  Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> (Word -> Term) -> Word -> Maybe (Heap, Stack, Term)
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 (Heap, Stack, Term))
-> Word -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$ Word# -> Word
W# Word#
b

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

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

  "GHC.Prim.double2Int#" | [i :: Rational
i] <- [Value] -> [Rational]
doubleLiterals' [Value]
args
    -> let !(D# a :: Double#
a) = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
i
           r :: Int#
r = Double# -> Int#
double2Int# Double#
a
       in  Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> (Int -> Term) -> Int -> Maybe (Heap, Stack, Term)
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 (Heap, Stack, Term))
-> Int -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
r
  "GHC.Prim.double2Float#"
    | [Lit (DoubleLiteral d :: Rational
d)] <- [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
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))))


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

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

  "GHC.Prim.**##" | Just r :: Term
r <- (Double# -> Double# -> Double#) -> [Value] -> Maybe Term
liftDDD Double# -> Double# -> Double#
(**##) [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce Term
r
-- decodeDouble_2Int# :: Double# -> (#Int#, Word#, Word#, Int##)
  "GHC.Prim.decodeDouble_2Int#" | [i :: Rational
i] <- [Value] -> [Rational]
doubleLiterals' [Value]
args
    -> let (_,Type -> TypeView
tyView -> TyConApp tupTcNm :: TyConName
tupTcNm tyArgs :: [Type]
tyArgs) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just tupTc :: TyCon
tupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
tupTcNm TyConMap
tcm
           [tupDc :: DataCon
tupDc] = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
           !(D# a :: Double#
a) = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
i
           !(# p :: Int#
p, q :: Word#
q, r :: Word#
r, s :: Int#
s #) = Double# -> (# Int#, Word#, Word#, Int# #)
decodeDouble_2Int# Double#
a
       in Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
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# #)
  "GHC.Prim.decodeDouble_Int64#" | [i :: Rational
i] <- [Value] -> [Rational]
doubleLiterals' [Value]
args
    -> let (_,Type -> TypeView
tyView -> TyConApp tupTcNm :: TyConName
tupTcNm tyArgs :: [Type]
tyArgs) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just tupTc :: TyCon
tupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
tupTcNm TyConMap
tcm
           [tupDc :: DataCon
tupDc] = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
           !(D# a :: Double#
a) = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
i
           !(# p :: Int#
p, q :: Int#
q #) = Double# -> (# Int#, Int# #)
decodeDouble_Int64# Double#
a
       in Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
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
--------
  "GHC.Prim.gtFloat#"  | Just r :: Term
r <- (Float# -> Float# -> Int#) -> [Value] -> Maybe Term
liftFFI Float# -> Float# -> Int#
gtFloat# [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce Term
r
  "GHC.Prim.geFloat#"  | Just r :: Term
r <- (Float# -> Float# -> Int#) -> [Value] -> Maybe Term
liftFFI Float# -> Float# -> Int#
geFloat# [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce Term
r
  "GHC.Prim.eqFloat#"  | Just r :: Term
r <- (Float# -> Float# -> Int#) -> [Value] -> Maybe Term
liftFFI Float# -> Float# -> Int#
eqFloat# [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce Term
r
  "GHC.Prim.neFloat#"  | Just r :: Term
r <- (Float# -> Float# -> Int#) -> [Value] -> Maybe Term
liftFFI Float# -> Float# -> Int#
neFloat# [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce Term
r
  "GHC.Prim.ltFloat#"  | Just r :: Term
r <- (Float# -> Float# -> Int#) -> [Value] -> Maybe Term
liftFFI Float# -> Float# -> Int#
ltFloat# [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce Term
r
  "GHC.Prim.leFloat#"  | Just r :: Term
r <- (Float# -> Float# -> Int#) -> [Value] -> Maybe Term
liftFFI Float# -> Float# -> Int#
leFloat# [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce Term
r

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

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

  "GHC.Prim.float2Int#" | [i :: Rational
i] <- [Value] -> [Rational]
floatLiterals' [Value]
args
    -> let !(F# a :: Float#
a) = Rational -> Float
forall a. Fractional a => Rational -> a
fromRational Rational
i
           r :: Int#
r = Float# -> Int#
float2Int# Float#
a
       in  Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> (Int -> Term) -> Int -> Maybe (Heap, Stack, Term)
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 (Heap, Stack, Term))
-> Int -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
r

  "GHC.Prim.expFloat#"  | Just r :: Term
r <- (Float# -> Float#) -> [Value] -> Maybe Term
liftFF Float# -> Float#
expFloat# [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce Term
r
  "GHC.Prim.logFloat#"  | Just r :: Term
r <- (Float# -> Float#) -> [Value] -> Maybe Term
liftFF Float# -> Float#
logFloat# [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce Term
r
  "GHC.Prim.sqrtFloat#"  | Just r :: Term
r <- (Float# -> Float#) -> [Value] -> Maybe Term
liftFF Float# -> Float#
sqrtFloat# [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce Term
r
  "GHC.Prim.sinFloat#"  | Just r :: Term
r <- (Float# -> Float#) -> [Value] -> Maybe Term
liftFF Float# -> Float#
sinFloat# [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce Term
r
  "GHC.Prim.cosFloat#"  | Just r :: Term
r <- (Float# -> Float#) -> [Value] -> Maybe Term
liftFF Float# -> Float#
cosFloat# [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce Term
r
  "GHC.Prim.tanFloat#"  | Just r :: Term
r <- (Float# -> Float#) -> [Value] -> Maybe Term
liftFF Float# -> Float#
tanFloat# [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce Term
r
  "GHC.Prim.asinFloat#"  | Just r :: Term
r <- (Float# -> Float#) -> [Value] -> Maybe Term
liftFF Float# -> Float#
asinFloat# [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce Term
r
  "GHC.Prim.acosFloat#"  | Just r :: Term
r <- (Float# -> Float#) -> [Value] -> Maybe Term
liftFF Float# -> Float#
acosFloat# [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce Term
r
  "GHC.Prim.atanFloat#"  | Just r :: Term
r <- (Float# -> Float#) -> [Value] -> Maybe Term
liftFF Float# -> Float#
atanFloat# [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce Term
r
  "GHC.Prim.sinhFloat#"  | Just r :: Term
r <- (Float# -> Float#) -> [Value] -> Maybe Term
liftFF Float# -> Float#
sinhFloat# [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce Term
r
  "GHC.Prim.coshFloat#"  | Just r :: Term
r <- (Float# -> Float#) -> [Value] -> Maybe Term
liftFF Float# -> Float#
coshFloat# [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce Term
r
  "GHC.Prim.tanhFloat#"  | Just r :: Term
r <- (Float# -> Float#) -> [Value] -> Maybe Term
liftFF Float# -> Float#
tanhFloat# [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce Term
r
  "GHC.Prim.powerFloat#"  | Just r :: Term
r <- (Float# -> Float# -> Float#) -> [Value] -> Maybe Term
liftFFF Float# -> Float# -> Float#
powerFloat# [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
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
  "GHC.Float.$w$casinh" | Just r :: Term
r <- (Double# -> Double#) -> [Value] -> Maybe Term
liftDD Double# -> Double#
go [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce Term
r
    where go :: Double# -> Double#
go f :: Double#
f = case Double -> Double
forall a. Floating a => a -> a
asinh (Double# -> Double
D# Double#
f) of
                   D# f' :: Double#
f' -> Double#
f'
  "GHC.Float.$w$casinh1" | Just r :: Term
r <- (Float# -> Float#) -> [Value] -> Maybe Term
liftFF Float# -> Float#
go [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce Term
r
    where go :: Float# -> Float#
go f :: Float#
f = case Float -> Float
forall a. Floating a => a -> a
asinh (Float# -> Float
F# Float#
f) of
                   F# f' :: Float#
f' -> Float#
f'
#endif

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

  "GHC.Prim.float2Double#" | [i :: Rational
i] <- [Value] -> [Rational]
floatLiterals' [Value]
args
    -> let !(F# a :: Float#
a) = Rational -> Float
forall a. Fractional a => Rational -> a
fromRational Rational
i
           r :: Double#
r = Float# -> Double#
float2Double# Float#
a
       in  Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> (Double -> Term) -> Double -> Maybe (Heap, Stack, Term)
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 (Heap, Stack, Term))
-> Double -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$ Double# -> Double
D# Double#
r


  "GHC.Prim.newByteArray#"
    | [iV :: Value
iV,PrimVal rwNm :: Text
rwNm rwTy :: PrimInfo
rwTy _ _] <- [Value]
args
    , [i :: Integer
i] <- [Value] -> [Integer]
intLiterals' [Value
iV]
    -> let (_,Type -> TypeView
tyView -> TyConApp tupTcNm :: TyConName
tupTcNm tyArgs :: [Type]
tyArgs) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just tupTc :: TyCon
tupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
tupTcNm TyConMap
tcm
           [tupDc :: DataCon
tupDc] = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
           Heap (gh :: IntMap Term
gh,p :: Int
p) gbl :: GPureHeap
gbl ph :: PureHeap
ph ids :: Supply
ids is0 :: InScopeSet
is0 = Heap
h
           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) 0))
           h' :: Heap
h' = GlobalHeap -> GPureHeap -> PureHeap -> Supply -> InScopeSet -> Heap
Heap (Int -> Term -> IntMap Term -> IntMap Term
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
p Term
lit IntMap Term
gh,Int
pInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) GPureHeap
gbl PureHeap
ph Supply
ids InScopeSet
is0
           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 (Text -> PrimInfo -> Term
Prim Text
rwNm PrimInfo
rwTy)
                    ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> [Either Term Type] -> Term
mkApps (Text -> PrimInfo -> Term
Prim "GHC.Prim.MutableByteArray#"
                                        (Type -> WorkInfo -> PrimInfo
PrimInfo 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 (Heap, Stack, Term) -> Maybe (Heap, Stack, Term)
forall a. a -> Maybe a
Just (Heap
h',Stack
k,Term
newE)

  "GHC.Prim.setByteArray#"
    | [PrimVal _mbaNm :: Text
_mbaNm _mbaTy :: PrimInfo
_mbaTy _ [baV :: Value
baV]
      ,offV :: Value
offV,lenV :: Value
lenV,cV :: Value
cV
      ,PrimVal rwNm :: Text
rwNm rwTy :: PrimInfo
rwTy _ _
      ] <- [Value]
args
    , [ba :: Integer
ba,off :: Integer
off,len :: Integer
len,c :: Integer
c] <- [Value] -> [Integer]
intLiterals' [Value
baV,Value
offV,Value
lenV,Value
cV]
    -> let Heap (gh :: IntMap Term
gh,p :: Int
p) gbl :: GPureHeap
gbl ph :: PureHeap
ph ids :: Supply
ids is0 :: InScopeSet
is0 = Heap
h
           Just (Literal (ByteArrayLiteral (Vector.Vector voff :: Int
voff vlen :: Int
vlen ba1 :: ByteArray
ba1))) =
              Int -> IntMap Term -> Maybe Term
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
ba) IntMap Term
gh
           !(I# off' :: Int#
off') = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
off
           !(I# len' :: Int#
len') = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
len
           !(I# c' :: 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 mba :: MutableByteArray# RealWorld
mba <- ByteArray -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
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 :: * -> *).
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))
           h' :: Heap
h'  = GlobalHeap -> GPureHeap -> PureHeap -> Supply -> InScopeSet -> Heap
Heap (Int -> Term -> IntMap Term -> IntMap Term
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
ba) Term
ba3 IntMap Term
gh,Int
p) GPureHeap
gbl PureHeap
ph Supply
ids InScopeSet
is0
       in (Heap, Stack, Term) -> Maybe (Heap, Stack, Term)
forall a. a -> Maybe a
Just (Heap
h',Stack
k,Text -> PrimInfo -> Term
Prim Text
rwNm PrimInfo
rwTy)

  "GHC.Prim.writeWordArray#"
    | [PrimVal _mbaNm :: Text
_mbaNm _mbaTy :: PrimInfo
_mbaTy _  [baV :: Value
baV]
      ,iV :: Value
iV,wV :: Value
wV
      ,PrimVal rwNm :: Text
rwNm rwTy :: PrimInfo
rwTy _ _
      ] <- [Value]
args
    , [ba :: Integer
ba,i :: Integer
i] <- [Value] -> [Integer]
intLiterals' [Value
baV,Value
iV]
    , [w :: Integer
w] <- [Value] -> [Integer]
wordLiterals' [Value
wV]
    -> let Heap (gh :: IntMap Term
gh,p :: Int
p) gbl :: GPureHeap
gbl ph :: PureHeap
ph ids :: Supply
ids is0 :: InScopeSet
is0 = Heap
h
           Just (Literal (ByteArrayLiteral (Vector.Vector off :: Int
off len :: Int
len ba1 :: ByteArray
ba1))) =
              Int -> IntMap Term -> Maybe Term
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
ba) IntMap Term
gh
           !(I# i' :: Int#
i') = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i
           !(W# 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 mba :: MutableByteArray# RealWorld
mba <- ByteArray -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
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 :: * -> *).
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))
           h' :: Heap
h'  = GlobalHeap -> GPureHeap -> PureHeap -> Supply -> InScopeSet -> Heap
Heap (Int -> Term -> IntMap Term -> IntMap Term
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
ba) Term
ba3 IntMap Term
gh,Int
p) GPureHeap
gbl PureHeap
ph Supply
ids InScopeSet
is0
       in (Heap, Stack, Term) -> Maybe (Heap, Stack, Term)
forall a. a -> Maybe a
Just (Heap
h',Stack
k,Text -> PrimInfo -> Term
Prim Text
rwNm PrimInfo
rwTy)

  "GHC.Prim.unsafeFreezeByteArray#"
    | [PrimVal _mbaNm :: Text
_mbaNm _mbaTy :: PrimInfo
_mbaTy _ [baV :: Value
baV]
      ,PrimVal rwNm :: Text
rwNm rwTy :: PrimInfo
rwTy _ _
      ] <- [Value]
args
    , [ba :: Integer
ba] <-  [Value] -> [Integer]
intLiterals' [Value
baV]
    -> let (_,Type -> TypeView
tyView -> TyConApp tupTcNm :: TyConName
tupTcNm tyArgs :: [Type]
tyArgs) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just tupTc :: TyCon
tupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
tupTcNm TyConMap
tcm
           [tupDc :: DataCon
tupDc] = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
           Heap (gh :: IntMap Term
gh,_) _ _ _ _ = Heap
h
           Just ba' :: Term
ba' = Int -> IntMap Term -> Maybe Term
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
ba) IntMap Term
gh
       in  Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
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 (Text -> PrimInfo -> Term
Prim Text
rwNm PrimInfo
rwTy)
                      ,Term -> Either Term Type
forall a b. a -> Either a b
Left Term
ba'])

  "GHC.Prim.sizeofByteArray#"
    | [Lit (ByteArrayLiteral ba :: Vector Word8
ba)] <- [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
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))))

  "GHC.Prim.indexWordArray#"
    | [Lit (ByteArrayLiteral (Vector.Vector _ _ (ByteArray.ByteArray ba :: ByteArray#
ba))),iV :: Value
iV] <- [Value]
args
    , [i :: Integer
i] <- [Value] -> [Integer]
intLiterals' [Value
iV]
    -> let !(I# 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 (Heap, Stack, Term)
reduce (Literal -> Term
Literal (Integer -> Literal
WordLiteral (Word -> Integer
forall a. Integral a => a -> Integer
toInteger (Word# -> Word
W# Word#
w))))

  "GHC.Prim.getSizeofMutBigNat#"
    | [PrimVal _mbaNm :: Text
_mbaNm _mbaTy :: PrimInfo
_mbaTy _ [baV :: Value
baV]
      ,PrimVal rwNm :: Text
rwNm rwTy :: PrimInfo
rwTy _ _
      ] <- [Value]
args
    , [ba :: Integer
ba] <- [Value] -> [Integer]
intLiterals' [Value
baV]
    -> let (_,Type -> TypeView
tyView -> TyConApp tupTcNm :: TyConName
tupTcNm tyArgs :: [Type]
tyArgs) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just tupTc :: TyCon
tupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
tupTcNm TyConMap
tcm
           [tupDc :: DataCon
tupDc] = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
           Heap (gh :: IntMap Term
gh,_) _ _ _ _ = Heap
h
           Just (Literal (ByteArrayLiteral ba' :: Vector Word8
ba')) = Int -> IntMap Term -> Maybe Term
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
ba) IntMap Term
gh
           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 (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
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 (Text -> PrimInfo -> Term
Prim Text
rwNm PrimInfo
rwTy)
                      ,Term -> Either Term Type
forall a b. a -> Either a b
Left Term
lit])

  "GHC.Prim.resizeMutableByteArray#"
    | [PrimVal mbaNm :: Text
mbaNm mbaTy :: PrimInfo
mbaTy _ [baV :: Value
baV]
      ,iV :: Value
iV
      ,PrimVal rwNm :: Text
rwNm rwTy :: PrimInfo
rwTy _ _
      ] <- [Value]
args
    , [ba :: Integer
ba,i :: Integer
i] <- [Value] -> [Integer]
intLiterals' [Value
baV,Value
iV]
    -> let (_,Type -> TypeView
tyView -> TyConApp tupTcNm :: TyConName
tupTcNm tyArgs :: [Type]
tyArgs) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just tupTc :: TyCon
tupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
tupTcNm TyConMap
tcm
           [tupDc :: DataCon
tupDc] = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
           Heap (gh :: IntMap Term
gh,p :: Int
p) gbl :: GPureHeap
gbl ph :: PureHeap
ph ids :: Supply
ids is0 :: InScopeSet
is0 = Heap
h
           Just (Literal (ByteArrayLiteral (Vector.Vector 0 _ ba1 :: ByteArray
ba1)))
            = Int -> IntMap Term -> Maybe Term
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
ba) IntMap Term
gh
           !(I# 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 mba :: MutableByteArray# RealWorld
mba <- ByteArray -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
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 (\s :: 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
                                 (# s' :: State# RealWorld
s', mba' :: 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 :: * -> *).
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 0 (Int# -> Int
I# Int#
i') ByteArray
ba2))
           h' :: Heap
h'  = GlobalHeap -> GPureHeap -> PureHeap -> Supply -> InScopeSet -> Heap
Heap (Int -> Term -> IntMap Term -> IntMap Term
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
p Term
ba3 IntMap Term
gh,Int
pInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) GPureHeap
gbl PureHeap
ph Supply
ids InScopeSet
is0
           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 (Text -> PrimInfo -> Term
Prim Text
rwNm PrimInfo
rwTy)
                    ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> [Either Term Type] -> Term
mkApps (Text -> PrimInfo -> Term
Prim Text
mbaNm 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  (Heap, Stack, Term) -> Maybe (Heap, Stack, Term)
forall a. a -> Maybe a
Just (Heap
h',Stack
k,Term
newE)

  "GHC.Prim.shrinkMutableByteArray#"
    | [PrimVal _mbaNm :: Text
_mbaNm _mbaTy :: PrimInfo
_mbaTy _ [baV :: Value
baV]
      ,lenV :: Value
lenV
      ,PrimVal rwNm :: Text
rwNm rwTy :: PrimInfo
rwTy _ _
      ] <- [Value]
args
    , [ba :: Integer
ba,len :: Integer
len] <- [Value] -> [Integer]
intLiterals' [Value
baV,Value
lenV]
    -> let Heap (gh :: IntMap Term
gh,p :: Int
p) gbl :: GPureHeap
gbl ph :: PureHeap
ph ids :: Supply
ids is0 :: InScopeSet
is0 = Heap
h
           Just (Literal (ByteArrayLiteral (Vector.Vector voff :: Int
voff vlen :: Int
vlen ba1 :: ByteArray
ba1))) =
              Int -> IntMap Term -> Maybe Term
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
ba) IntMap Term
gh
           !(I# len' :: 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 mba :: MutableByteArray# RealWorld
mba <- ByteArray -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
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 :: * -> *).
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))
           h' :: Heap
h'  = GlobalHeap -> GPureHeap -> PureHeap -> Supply -> InScopeSet -> Heap
Heap (Int -> Term -> IntMap Term -> IntMap Term
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
ba) Term
ba3 IntMap Term
gh,Int
p) GPureHeap
gbl PureHeap
ph Supply
ids InScopeSet
is0
       in (Heap, Stack, Term) -> Maybe (Heap, Stack, Term)
forall a. a -> Maybe a
Just (Heap
h',Stack
k,Text -> PrimInfo -> Term
Prim Text
rwNm PrimInfo
rwTy)

  "GHC.Prim.copyByteArray#"
    | [Lit (ByteArrayLiteral (Vector.Vector _ _ (ByteArray.ByteArray src_ba :: ByteArray#
src_ba)))
      ,src_offV :: Value
src_offV
      ,PrimVal _mbaNm :: Text
_mbaNm _mbaTy :: PrimInfo
_mbaTy _ [dst_mbaV :: Value
dst_mbaV]
      ,dst_offV :: Value
dst_offV, nV :: Value
nV
      ,PrimVal rwNm :: Text
rwNm rwTy :: PrimInfo
rwTy _ _
      ] <- [Value]
args
    , [src_off :: Integer
src_off,dst_mba :: Integer
dst_mba,dst_off :: Integer
dst_off,n :: Integer
n] <- [Value] -> [Integer]
intLiterals' [Value
src_offV,Value
dst_mbaV,Value
dst_offV,Value
nV]
    -> let Heap (gh :: IntMap Term
gh,p :: Int
p) gbl :: GPureHeap
gbl ph :: PureHeap
ph ids :: Supply
ids is0 :: InScopeSet
is0 = Heap
h
           Just (Literal (ByteArrayLiteral (Vector.Vector voff :: Int
voff vlen :: Int
vlen dst_ba :: ByteArray
dst_ba))) =
              Int -> IntMap Term -> Maybe Term
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
dst_mba) IntMap Term
gh
           !(I# src_off' :: Int#
src_off') = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
src_off
           !(I# dst_off' :: Int#
dst_off') = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
dst_off
           !(I# n' :: 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 dst_mba1 :: MutableByteArray# RealWorld
dst_mba1 <- ByteArray -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
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 :: * -> *).
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))
           h' :: Heap
h'  = GlobalHeap -> GPureHeap -> PureHeap -> Supply -> InScopeSet -> Heap
Heap (Int -> Term -> IntMap Term -> IntMap Term
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
dst_mba) Term
ba3 IntMap Term
gh,Int
p) GPureHeap
gbl PureHeap
ph Supply
ids InScopeSet
is0
       in (Heap, Stack, Term) -> Maybe (Heap, Stack, Term)
forall a. a -> Maybe a
Just (Heap
h',Stack
k,Text -> PrimInfo -> Term
Prim Text
rwNm PrimInfo
rwTy)

  "GHC.Prim.readWordArray#"
    | [PrimVal _mbaNm :: Text
_mbaNm _mbaTy :: PrimInfo
_mbaTy _  [baV :: Value
baV]
      ,offV :: Value
offV
      ,PrimVal rwNm :: Text
rwNm rwTy :: PrimInfo
rwTy _ _
      ] <- [Value]
args
    , [ba :: Integer
ba,off :: Integer
off] <- [Value] -> [Integer]
intLiterals' [Value
baV,Value
offV]
    -> let (_,Type -> TypeView
tyView -> TyConApp tupTcNm :: TyConName
tupTcNm tyArgs :: [Type]
tyArgs) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just tupTc :: TyCon
tupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
tupTcNm TyConMap
tcm
           [tupDc :: DataCon
tupDc] = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
           Heap (gh :: IntMap Term
gh,_) _ _ _ _ = Heap
h
           Just (Literal (ByteArrayLiteral (Vector.Vector _ _ ba1 :: ByteArray
ba1))) =
              Int -> IntMap Term -> Maybe Term
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
ba) IntMap Term
gh
           !(I# off' :: 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 mba :: MutableByteArray# RealWorld
mba <- ByteArray -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
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 (\s :: 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
                        (# s' :: State# RealWorld
s', w' :: 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 (Text -> PrimInfo -> Term
Prim Text
rwNm 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 (Heap, Stack, Term)
reduce Term
newE

-- decodeFloat_Int# :: Float# -> (#Int#, Int##)
  "GHC.Prim.decodeFloat_Int#" | [i :: Rational
i] <- [Value] -> [Rational]
floatLiterals' [Value]
args
    -> let (_,Type -> TypeView
tyView -> TyConApp tupTcNm :: TyConName
tupTcNm tyArgs :: [Type]
tyArgs) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just tupTc :: TyCon
tupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
tupTcNm TyConMap
tcm
           [tupDc :: DataCon
tupDc] = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
           !(F# a :: Float#
a) = Rational -> Float
forall a. Fractional a => Rational -> a
fromRational Rational
i
           !(# p :: Int#
p, q :: Int#
q #) = Float# -> (# Int#, Int# #)
decodeFloat_Int# Float#
a
       in Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
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)])


  "GHC.Prim.tagToEnum#"
    | [ConstTy (TyCon tcN :: TyConName
tcN)] <- [Type]
tys
    , [Lit (IntLiteral i :: 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 :: * -> *) 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
+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 ((Heap
h,Stack
k,) (Term -> (Heap, Stack, Term))
-> (DataCon -> Term) -> DataCon -> (Heap, Stack, Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataCon -> Term
Data) (DataCon -> (Heap, Stack, Term))
-> Maybe DataCon -> Maybe (Heap, Stack, Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe DataCon
dc


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

  "GHC.Classes.&&"
    | [DC lCon :: DataCon
lCon _
      ,DC rCon :: DataCon
rCon _] <- [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$ TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty
         ((Name DataCon -> Text
forall a. Name a -> Text
nameOcc (DataCon -> Name DataCon
dcName DataCon
lCon) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "GHC.Types.True") Bool -> Bool -> Bool
&&
          (Name DataCon -> Text
forall a. Name a -> Text
nameOcc (DataCon -> Name DataCon
dcName DataCon
rCon) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "GHC.Types.True"))

  "GHC.Classes.||"
    | [DC lCon :: DataCon
lCon _
      ,DC rCon :: DataCon
rCon _] <- [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$ TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty
         ((Name DataCon -> Text
forall a. Name a -> Text
nameOcc (DataCon -> Name DataCon
dcName DataCon
lCon) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "GHC.Types.True") Bool -> Bool -> Bool
||
          (Name DataCon -> Text
forall a. Name a -> Text
nameOcc (DataCon -> Name DataCon
dcName DataCon
rCon) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "GHC.Types.True"))

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

  -- modInt# :: Int# -> Int# -> Int#
  "GHC.Classes.modInt#"
    | [dividend :: Integer
dividend, divisor :: Integer
divisor] <- [Value] -> [Integer]
intLiterals' [Value]
args
    ->
      if Integer
divisor Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 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 (Heap, Stack, Term)
reduce (Type -> Term
undefinedTm Type
iTy)
      else
        Term -> Maybe (Heap, Stack, Term)
reduce (Literal -> Term
Literal (Integer -> Literal
IntLiteral (Integer
dividend Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
divisor)))

  "GHC.Classes.not"
    | [DC bCon :: DataCon
bCon _] <- [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
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
== "GHC.Types.False"))

  "GHC.Integer.Logarithms.integerLogBase#"
    | Just (a :: Integer
a,b :: Integer
b) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    , Just c :: Int
c <- Integer -> Integer -> Maybe Int
flogBase Integer
a Integer
b
    -> (Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> (Int -> Term) -> Int -> Maybe (Heap, Stack, Term)
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

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

  "GHC.Integer.Type.integerToInt"
    | [i :: Integer
i] <- [Value] -> [Integer]
integerLiterals' [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Integer -> Term
integerToIntLiteral Integer
i)

  "GHC.Integer.Type.decodeDoubleInteger" -- :: Double# -> (#Integer, Int##)
    | [Lit (DoubleLiteral i :: Rational
i)] <- [Value]
args
    -> let (_,Type -> TypeView
tyView -> TyConApp tupTcNm :: TyConName
tupTcNm tyArgs :: [Type]
tyArgs) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just tupTc :: TyCon
tupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
tupTcNm TyConMap
tcm
           [tupDc :: DataCon
tupDc] = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
           !(D# a :: Double#
a)  = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
i
           !(# b :: Integer
b, c :: Int#
c #) = Double# -> (# Integer, Int# #)
decodeDoubleInteger Double#
a
    in Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
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)])

  "GHC.Integer.Type.encodeDoubleInteger" -- :: Integer -> Int# -> Double#
    | [iV :: Value
iV, Lit (IntLiteral j :: Integer
j)] <- [Value]
args
    , [i :: Integer
i] <- [Value] -> [Integer]
integerLiterals' [Value
iV]
    -> let !(I# k' :: 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 (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> (Double -> Term) -> Double -> Maybe (Heap, Stack, Term)
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 (Heap, Stack, Term))
-> Double -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$ Double# -> Double
D# Double#
r

  "GHC.Integer.Type.quotRemInteger" -- :: Integer -> Integer -> (#Integer, Integer#)
    | [i :: Integer
i, j :: Integer
j] <- [Value] -> [Integer]
integerLiterals' [Value]
args
    -> let (_,Type -> TypeView
tyView -> TyConApp tupTcNm :: TyConName
tupTcNm tyArgs :: [Type]
tyArgs) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just tupTc :: TyCon
tupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
tupTcNm TyConMap
tcm
           [tupDc :: DataCon
tupDc] = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
           (q :: Integer
q,r :: Integer
r) = Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
quotRem Integer
i Integer
j
    in Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
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)])

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

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

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

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

  "GHC.Integer.Type.divInteger" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
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))

  "GHC.Integer.Type.modInteger" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
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))

  "GHC.Integer.Type.quotInteger" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
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))

  "GHC.Integer.Type.remInteger" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
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))

  "GHC.Integer.Type.divModInteger" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> let (_,Type -> TypeView
tyView -> TyConApp ubTupTcNm :: TyConName
ubTupTcNm [liftedKi :: Type
liftedKi,_,intTy :: Type
intTy,_]) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just ubTupTc :: TyCon
ubTupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
ubTupTcNm TyConMap
tcm
           [ubTupDc :: DataCon
ubTupDc] = TyCon -> [DataCon]
tyConDataCons TyCon
ubTupTc
           (d :: Integer
d,m :: Integer
m) = Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
divMod Integer
i Integer
j
       in  Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
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))
                                 ]

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

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

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

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

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

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

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

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

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

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

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

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

  "GHC.Integer.Type.compareInteger" -- :: Integer -> Integer -> Ordering
    | [i :: Integer
i, j :: Integer
j] <- [Value] -> [Integer]
integerLiterals' [Value]
args
    -> let -- Get the required result type (viewed as an applied type constructor name)
           (_,Type -> TypeView
tyView -> TyConApp tupTcNm :: TyConName
tupTcNm []) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           -- Find the type constructor from the name
           (Just tupTc :: 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'
           [ltDc :: DataCon
ltDc, eqDc :: DataCon
eqDc, gtDc :: 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 (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$ case Ordering
ordVal of
        LT -> DataCon -> Term
Data DataCon
ltDc
        EQ -> DataCon -> Term
Data DataCon
eqDc
        GT -> DataCon -> Term
Data DataCon
gtDc

  "GHC.Integer.Type.shiftRInteger"
    | [iV :: Value
iV, Lit (IntLiteral j :: Integer
j)] <- [Value]
args
    , [i :: Integer
i] <- [Value] -> [Integer]
integerLiterals' [Value
iV]
    -> Term -> Maybe (Heap, Stack, Term)
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))

  "GHC.Integer.Type.shiftLInteger"
    | [iV :: Value
iV, Lit (IntLiteral j :: Integer
j)] <- [Value]
args
    , [i :: Integer
i] <- [Value] -> [Integer]
integerLiterals' [Value
iV]
    -> Term -> Maybe (Heap, Stack, Term)
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))

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

  "GHC.Integer.Type.integerToWord"
    | [i :: Integer
i] <- [Value] -> [Integer]
integerLiterals' [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Integer -> Term
integerToWordLiteral Integer
i)

  "GHC.Integer.Type.testBitInteger" -- :: Integer -> Int# -> Bool
    | [Lit (IntegerLiteral i :: Integer
i), Lit (IntLiteral j :: Integer
j)] <- [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
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)))

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

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

  "GHC.Natural.naturalFromInteger"
    | [i :: 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 (Heap, Stack, Term)
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
  "GHC.Natural.$wshiftLNatural"
    | [nV :: Value
nV,iV :: Value
iV] <- [Value]
args
    , [n :: Integer
n] <- [Value] -> [Integer]
naturalLiterals' [Value
nV]
    , [i :: Int
i] <- Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> [Integer] -> [Int]
forall (f :: * -> *) 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 (Heap, Stack, Term)
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))

  "GHC.Natural.plusNatural"
    | Just (i :: Integer
i,j :: 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 (Heap, Stack, Term)
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
(+))

  "GHC.Natural.timesNatural"
    | Just (i :: Integer
i,j :: 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 (Heap, Stack, Term)
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
(*))

  "GHC.Natural.minusNatural"
    | Just (i :: Integer
i,j :: 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 (Heap, Stack, Term)
reduce (Type -> [Integer] -> ([Natural] -> Term) -> Term
checkNaturalRange Type
nTy [Integer
i, Integer
j] (\[i' :: Natural
i', j' :: Natural
j'] ->
                case Natural -> Natural -> Maybe Natural
minusNaturalMaybe Natural
i' Natural
j' of
                  Nothing -> Type -> Integer -> (Natural -> Natural) -> Term
checkNaturalRange1 Type
nTy (-1) Natural -> Natural
forall a. a -> a
id
                  Just n :: Natural
n -> Natural -> Term
naturalToNaturalLiteral Natural
n))

  "GHC.Natural.wordToNatural#"
    | [Lit (WordLiteral w :: 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 (Heap, Stack, Term)
reduce (Type -> Integer -> (Natural -> Natural) -> Term
checkNaturalRange1 Type
nTy Integer
w Natural -> Natural
forall a. a -> a
id)

  -- GHC.Real.^  -- XXX: Very fragile
  --   ^_f, $wf, $wf1 are specialisations of the internal function f in the implementation of (^) in GHC.Real
  "GHC.Real.^_f"  -- :: Integer -> Integer -> Integer
    | [i :: Integer
i,j :: Integer
j] <- [Value] -> [Integer]
integerLiterals' [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
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)
  "GHC.Real.$wf"  -- :: Integer -> Int# -> Integer
    | [iV :: Value
iV, Lit (IntLiteral j :: Integer
j)] <- [Value]
args
    , [i :: Integer
i] <- [Value] -> [Integer]
integerLiterals' [Value
iV]
    -> Term -> Maybe (Heap, Stack, Term)
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)
  "GHC.Real.$wf1" -- :: Int# -> Int# -> Int#
    | [Lit (IntLiteral i :: Integer
i), Lit (IntLiteral j :: Integer
j)] <- [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
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)

  -- XXX: Very fragile. /$s^_f/ is a specialized version of ^_f. That means that
  -- it is type applied to some specific type.
  "Data.Singletons.TypeLits.Internal.$s^_f"
    | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
naturalLiterals [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Literal -> Term
Literal (Integer -> Literal
NaturalLiteral (Integer
i Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
j)))

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

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

  "GHC.Types.C#"
    | Bool
isSubj
    , [Lit (CharLiteral c :: Char
c)] <- [Value]
args
    ->  let (_,Type -> TypeView
tyView -> TyConApp charTcNm :: TyConName
charTcNm []) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
            (Just charTc :: TyCon
charTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
charTcNm TyConMap
tcm
            [charDc :: DataCon
charDc] = TyCon -> [DataCon]
tyConDataCons TyCon
charTc
        in  Term -> Maybe (Heap, Stack, Term)
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))])

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

  "GHC.Types.W#"
    | Bool
isSubj
    , [Lit (WordLiteral c :: Integer
c)] <- [Value]
args
    ->  let (_,Type -> TypeView
tyView -> TyConApp wordTcNm :: TyConName
wordTcNm []) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
            (Just wordTc :: TyCon
wordTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
wordTcNm TyConMap
tcm
            [wordDc :: DataCon
wordDc] = TyCon -> [DataCon]
tyConDataCons TyCon
wordTc
        in  Term -> Maybe (Heap, Stack, Term)
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))])
  "GHC.Word.W8#"
    | Bool
isSubj
    , [Lit (WordLiteral c :: Integer
c)] <- [Value]
args
    ->  let (_,Type -> TypeView
tyView -> TyConApp wordTcNm :: TyConName
wordTcNm []) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
            (Just wordTc :: TyCon
wordTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
wordTcNm TyConMap
tcm
            [wordDc :: DataCon
wordDc] = TyCon -> [DataCon]
tyConDataCons TyCon
wordTc
        in  Term -> Maybe (Heap, Stack, Term)
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))])
  "GHC.Word.W16#"
    | Bool
isSubj
    , [Lit (WordLiteral c :: Integer
c)] <- [Value]
args
    ->  let (_,Type -> TypeView
tyView -> TyConApp wordTcNm :: TyConName
wordTcNm []) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
            (Just wordTc :: TyCon
wordTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
wordTcNm TyConMap
tcm
            [wordDc :: DataCon
wordDc] = TyCon -> [DataCon]
tyConDataCons TyCon
wordTc
        in  Term -> Maybe (Heap, Stack, Term)
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))])
  "GHC.Word.W32#"
    | Bool
isSubj
    , [Lit (WordLiteral c :: Integer
c)] <- [Value]
args
    ->  let (_,Type -> TypeView
tyView -> TyConApp wordTcNm :: TyConName
wordTcNm []) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
            (Just wordTc :: TyCon
wordTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
wordTcNm TyConMap
tcm
            [wordDc :: DataCon
wordDc] = TyCon -> [DataCon]
tyConDataCons TyCon
wordTc
        in  Term -> Maybe (Heap, Stack, Term)
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))])
  "GHC.Word.W64#"
    | [Lit (WordLiteral c :: Integer
c)] <- [Value]
args
    ->  let (_,Type -> TypeView
tyView -> TyConApp wordTcNm :: TyConName
wordTcNm []) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
            (Just wordTc :: TyCon
wordTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
wordTcNm TyConMap
tcm
            [wordDc :: DataCon
wordDc] = TyCon -> [DataCon]
tyConDataCons TyCon
wordTc
        in  Term -> Maybe (Heap, Stack, Term)
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))])

  "GHC.Float.$w$sfromRat''" -- XXX: Very fragile
    | [Lit (IntLiteral _minEx :: Integer
_minEx)
      ,Lit (IntLiteral matDigs :: Integer
matDigs)
      ,nV :: Value
nV
      ,dV :: Value
dV] <- [Value]
args
    , [n :: Integer
n,d :: Integer
d] <- [Value] -> [Integer]
integerLiterals' [Value
nV,Value
dV]
    -> case Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
matDigs of
          matDigs' :: Int
matDigs'
            | Int
matDigs' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Float -> Int
forall a. RealFloat a => a -> Int
floatDigits (Float
forall a. HasCallStack => a
undefined :: Float)
            -> Term -> Maybe (Heap, Stack, Term)
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 (Integer
n Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% Integer
d) :: Float))))
            | Int
matDigs' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Double -> Int
forall a. RealFloat a => a -> Int
floatDigits (Double
forall a. HasCallStack => a
undefined :: Double)
            -> Term -> Maybe (Heap, Stack, Term)
reduce (Literal -> Term
Literal (Rational -> Literal
DoubleLiteral (Double -> Rational
forall a. Real a => a -> Rational
toRational (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Integer
n Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% Integer
d) :: Double))))
          _ -> [Char] -> Maybe (Heap, Stack, Term)
forall a. HasCallStack => [Char] -> a
error ([Char] -> Maybe (Heap, Stack, Term))
-> [Char] -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$ $(curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "GHC.Float.$w$sfromRat'': Not a Float or Double"

  "GHC.Float.$w$sfromRat''1" -- XXX: Very fragile
    | [Lit (IntLiteral _minEx :: Integer
_minEx)
      ,Lit (IntLiteral matDigs :: Integer
matDigs)
      ,nV :: Value
nV
      ,dV :: Value
dV] <- [Value]
args
    , [n :: Integer
n,d :: Integer
d] <- [Value] -> [Integer]
integerLiterals' [Value
nV,Value
dV]
    -> case Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
matDigs of
          matDigs' :: Int
matDigs'
            | Int
matDigs' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Float -> Int
forall a. RealFloat a => a -> Int
floatDigits (Float
forall a. HasCallStack => a
undefined :: Float)
            -> Term -> Maybe (Heap, Stack, Term)
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 (Integer
n Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% Integer
d) :: Float))))
            | Int
matDigs' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Double -> Int
forall a. RealFloat a => a -> Int
floatDigits (Double
forall a. HasCallStack => a
undefined :: Double)
            -> Term -> Maybe (Heap, Stack, Term)
reduce (Literal -> Term
Literal (Rational -> Literal
DoubleLiteral (Double -> Rational
forall a. Real a => a -> Rational
toRational (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Integer
n Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% Integer
d) :: Double))))
          _ -> [Char] -> Maybe (Heap, Stack, Term)
forall a. HasCallStack => [Char] -> a
error ([Char] -> Maybe (Heap, Stack, Term))
-> [Char] -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$ $(curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "GHC.Float.$w$sfromRat'': Not a Float or Double"

  "GHC.Integer.Type.$wsignumInteger" -- XXX: Not super-fragile, but still..
    | [i :: Integer
i] <- [Value] -> [Integer]
integerLiterals' [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Literal -> Term
Literal (Integer -> Literal
IntLiteral (Integer -> Integer
forall a. Num a => a -> a
signum Integer
i)))


  "GHC.Integer.Type.signumInteger"
    | [i :: Integer
i] <- [Value] -> [Integer]
integerLiterals' [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Literal -> Term
Literal (Integer -> Literal
IntegerLiteral (Integer -> Integer
signumInteger Integer
i)))

  "GHC.Integer.Type.absInteger"
    | [i :: Integer
i] <- [Value] -> [Integer]
integerLiterals' [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Literal -> Term
Literal (Integer -> Literal
IntegerLiteral (Integer -> Integer
absInteger Integer
i)))

  "GHC.Integer.Type.bitInteger"
    | [i :: Integer
i] <- [Value] -> [Integer]
intLiterals' [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Literal -> Term
Literal (Integer -> Literal
IntegerLiteral (Int -> Integer
forall a. Bits a => Int -> a
bit (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i))))

  "GHC.Integer.Type.complementInteger"
    | [i :: Integer
i] <- [Value] -> [Integer]
integerLiterals' [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Literal -> Term
Literal (Integer -> Literal
IntegerLiteral (Integer -> Integer
complementInteger Integer
i)))

  "GHC.Integer.Type.orInteger"
    | [i :: Integer
i, j :: Integer
j] <- [Value] -> [Integer]
integerLiterals' [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Literal -> Term
Literal (Integer -> Literal
IntegerLiteral (Integer -> Integer -> Integer
orInteger Integer
i Integer
j)))

  "GHC.Integer.Type.xorInteger"
    | [i :: Integer
i, j :: Integer
j] <- [Value] -> [Integer]
integerLiterals' [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Literal -> Term
Literal (Integer -> Literal
IntegerLiteral (Integer -> Integer -> Integer
xorInteger Integer
i Integer
j)))

  "GHC.Integer.Type.andInteger"
    | [i :: Integer
i, j :: Integer
j] <- [Value] -> [Integer]
integerLiterals' [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Literal -> Term
Literal (Integer -> Literal
IntegerLiteral (Integer -> Integer -> Integer
andInteger Integer
i Integer
j)))

  "GHC.Integer.Type.doubleFromInteger"
    | [i :: Integer
i] <- [Value] -> [Integer]
integerLiterals' [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Literal -> Term
Literal (Rational -> Literal
DoubleLiteral (Double -> Rational
forall a. Real a => a -> Rational
toRational (Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
i :: Double))))

  "GHC.Base.eqString"
    | [PrimVal _ _ _ [Lit (StringLiteral s1 :: [Char]
s1)]
      ,PrimVal _ _ _ [Lit (StringLiteral s2 :: [Char]
s2)]
      ] <- [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty ([Char]
s1 [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
s2))
    | Bool
otherwise -> [Char] -> Maybe (Heap, Stack, Term)
forall a. HasCallStack => [Char] -> a
error ([Value] -> [Char]
forall a. Show a => a -> [Char]
show [Value]
args)


  "Clash.Class.BitPack.packDouble#" -- :: Double -> BitVector 64
    | [DC _ [Left arg :: Term
arg]] <- [Value]
args
    , (h2 :: Heap
h2,[],Literal (DoubleLiteral i :: Rational
i)) <- PrimEvaluator
-> TyConMap -> Bool -> (Heap, Stack, Term) -> (Heap, Stack, Term)
whnf PrimEvaluator
reduceConstant TyConMap
tcm Bool
True (Heap
h,[],Term
arg)
    -> let resTyInfo :: (Type, Type, Integer)
resTyInfo = TyConMap -> Type -> [Type] -> (Type, Type, Integer)
extractTySizeInfo TyConMap
tcm Type
ty [Type]
tys
       in  (Heap, Stack, Term) -> Maybe (Heap, Stack, Term)
forall a. a -> Maybe a
Just (Heap
h2,Stack
k,(Type, Type, Integer) -> Integer -> Integer -> Term
mkBitVectorLit' (Type, Type, Integer)
resTyInfo 0 (BitVector 64 -> Integer
forall (n :: Nat). BitVector n -> Integer
BitVector.unsafeToInteger (BitVector 64 -> Integer) -> BitVector 64 -> Integer
forall a b. (a -> b) -> a -> b
$ (Double -> BitVector 64
forall a. BitPack a => a -> BitVector (BitSize a)
pack :: Double -> BitVector 64) (Double -> BitVector 64) -> Double -> BitVector 64
forall a b. (a -> b) -> a -> b
$ Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
i))

  "Clash.Class.BitPack.packFloat#" -- :: Float -> BitVector 32
    | [DC _ [Left arg :: Term
arg]] <- [Value]
args
    , (h2 :: Heap
h2,[],Literal (FloatLiteral i :: Rational
i)) <- PrimEvaluator
-> TyConMap -> Bool -> (Heap, Stack, Term) -> (Heap, Stack, Term)
whnf PrimEvaluator
reduceConstant TyConMap
tcm Bool
True (Heap
h,[],Term
arg)
    -> let resTyInfo :: (Type, Type, Integer)
resTyInfo = TyConMap -> Type -> [Type] -> (Type, Type, Integer)
extractTySizeInfo TyConMap
tcm Type
ty [Type]
tys
       in  (Heap, Stack, Term) -> Maybe (Heap, Stack, Term)
forall a. a -> Maybe a
Just (Heap
h2,Stack
k,(Type, Type, Integer) -> Integer -> Integer -> Term
mkBitVectorLit' (Type, Type, Integer)
resTyInfo 0 (BitVector 32 -> Integer
forall (n :: Nat). BitVector n -> Integer
BitVector.unsafeToInteger (BitVector 32 -> Integer) -> BitVector 32 -> Integer
forall a b. (a -> b) -> a -> b
$ (Float -> BitVector 32
forall a. BitPack a => a -> BitVector (BitSize a)
pack :: Float -> BitVector 32) (Float -> BitVector 32) -> Float -> BitVector 32
forall a b. (a -> b) -> a -> b
$ Rational -> Float
forall a. Fractional a => Rational -> a
fromRational Rational
i))

  "Clash.Class.BitPack.unpackFloat#"
    | [i :: (Integer, Integer)
i] <- [Value] -> [(Integer, Integer)]
bitVectorLiterals' [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Literal -> Term
Literal (Rational -> Literal
FloatLiteral (Float -> Rational
forall a. Real a => a -> Rational
toRational (Float -> Rational) -> Float -> Rational
forall a b. (a -> b) -> a -> b
$ (BitVector 32 -> Float
forall a. BitPack a => BitVector (BitSize a) -> a
unpack :: BitVector 32 -> Float) ((Integer, Integer) -> BitVector 32
forall (n :: Nat). (Integer, Integer) -> BitVector n
toBV (Integer, Integer)
i))))

  "Clash.Class.BitPack.unpackDouble#"
    | [i :: (Integer, Integer)
i] <- [Value] -> [(Integer, Integer)]
bitVectorLiterals' [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Literal -> Term
Literal (Rational -> Literal
DoubleLiteral (Double -> Rational
forall a. Real a => a -> Rational
toRational (Double -> Rational) -> Double -> Rational
forall a b. (a -> b) -> a -> b
$ (BitVector 64 -> Double
forall a. BitPack a => BitVector (BitSize a) -> a
unpack :: BitVector 64 -> Double) ((Integer, Integer) -> BitVector 64
forall (n :: Nat). (Integer, Integer) -> BitVector n
toBV (Integer, Integer)
i))))

  -- expIndex#
  --   :: KnownNat m
  --   => Index m
  --   -> SNat n
  --   -> Index (n^m)
  "Clash.Class.Exp.expIndex#"
    | [b :: Integer
b] <- [Value] -> [Integer]
indexLiterals' [Value]
args
    , [(_mTy :: Type
_mTy, km :: Integer
km), (_, e :: Integer
e)] <- TyConMap -> [Type] -> [(Type, Integer)]
extractKnownNats TyConMap
tcm [Type]
tys
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkIndexLit Type
ty (LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
kmInteger -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
e))) (Integer
kmInteger -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
e) (Integer
bInteger -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
e))

  -- expSigned#
  --   :: KnownNat m
  --   => Signed m
  --   -> SNat n
  --   -> Signed (n*m)
  "Clash.Class.Exp.expSigned#"
    | [b :: Integer
b] <- [Value] -> [Integer]
signedLiterals' [Value]
args
    , [(_mTy :: Type
_mTy, km :: Integer
km), (_, e :: Integer
e)] <- TyConMap -> [Type] -> [(Type, Integer)]
extractKnownNats TyConMap
tcm [Type]
tys
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkSignedLit Type
ty (LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
kmInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
e))) (Integer
kmInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
e) (Integer
bInteger -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
e))

  -- expUnsigned#
  --   :: KnownNat m
  --   => Unsigned m
  --   -> SNat n
  --   -> Unsigned m
  "Clash.Class.Exp.expUnsigned#"
    | [b :: Integer
b] <- [Value] -> [Integer]
unsignedLiterals' [Value]
args
    , [(_mTy :: Type
_mTy, km :: Integer
km), (_, e :: Integer
e)