{-|
  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)] <- TyConMap -> [Type] -> [(Type, Integer)]
extractKnownNats TyConMap
tcm [Type]
tys
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkUnsignedLit 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))

  "Clash.Promoted.Nat.powSNat"
    | [Right a :: Integer
a, Right b :: Integer
b] <- (Type -> Either [Char] Integer)
-> [Type] -> [Either [Char] Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (Except [Char] Integer -> Either [Char] Integer)
-> (Type -> Except [Char] Integer) -> Type -> Either [Char] Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm) [Type]
tys
    -> let c :: Integer
c = case Integer
a of
                 2 -> 1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
b)
                 _ -> Integer
a Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
b
           (_,Type -> TypeView
tyView -> TyConApp snatTcNm :: TyConName
snatTcNm _) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just snatTc :: TyCon
snatTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
snatTcNm TyConMap
tcm
           [snatDc :: DataCon
snatDc] = TyCon -> [DataCon]
tyConDataCons TyCon
snatTc
       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
snatDc) [ Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy Integer
c))
                                , Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
NaturalLiteral Integer
c))]

  "Clash.Promoted.Nat.flogBaseSNat"
    | [_,_,Right a :: Integer
a, Right b :: Integer
b] <- (Type -> Either [Char] Integer)
-> [Type] -> [Either [Char] Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (Except [Char] Integer -> Either [Char] Integer)
-> (Type -> Except [Char] Integer) -> Type -> Either [Char] Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm) [Type]
tys
    , Just c :: Int
c <- Integer -> Integer -> Maybe Int
flogBase Integer
a Integer
b
    , let c' :: Integer
c' = Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
c
    -> let (_,Type -> TypeView
tyView -> TyConApp snatTcNm :: TyConName
snatTcNm _) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just snatTc :: TyCon
snatTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
snatTcNm TyConMap
tcm
           [snatDc :: DataCon
snatDc] = TyCon -> [DataCon]
tyConDataCons TyCon
snatTc
       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
snatDc) [ Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy Integer
c'))
                                , Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
NaturalLiteral Integer
c'))]

  "Clash.Promoted.Nat.clogBaseSNat"
    | [_,_,Right a :: Integer
a, Right b :: Integer
b] <- (Type -> Either [Char] Integer)
-> [Type] -> [Either [Char] Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (Except [Char] Integer -> Either [Char] Integer)
-> (Type -> Except [Char] Integer) -> Type -> Either [Char] Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm) [Type]
tys
    , Just c :: Int
c <- Integer -> Integer -> Maybe Int
clogBase Integer
a Integer
b
    , let c' :: Integer
c' = Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
c
    -> let (_,Type -> TypeView
tyView -> TyConApp snatTcNm :: TyConName
snatTcNm _) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just snatTc :: TyCon
snatTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
snatTcNm TyConMap
tcm
           [snatDc :: DataCon
snatDc] = TyCon -> [DataCon]
tyConDataCons TyCon
snatTc
       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
snatDc) [ Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy Integer
c'))
                                , Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
NaturalLiteral Integer
c'))]

  "Clash.Promoted.Nat.logBaseSNat"
    | [_,Right a :: Integer
a, Right b :: Integer
b] <- (Type -> Either [Char] Integer)
-> [Type] -> [Either [Char] Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (Except [Char] Integer -> Either [Char] Integer)
-> (Type -> Except [Char] Integer) -> Type -> Either [Char] Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm) [Type]
tys
    , Just c :: Int
c <- Integer -> Integer -> Maybe Int
flogBase Integer
a Integer
b
    , let c' :: Integer
c' = Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
c
    -> let (_,Type -> TypeView
tyView -> TyConApp snatTcNm :: TyConName
snatTcNm _) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just snatTc :: TyCon
snatTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
snatTcNm TyConMap
tcm
           [snatDc :: DataCon
snatDc] = TyCon -> [DataCon]
tyConDataCons TyCon
snatTc
       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
snatDc) [ Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy Integer
c'))
                                , Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
NaturalLiteral Integer
c'))]

------------
-- BitVector
------------
-- Constructor
  "Clash.Sized.Internal.BitVector.BV"
    | [Right _] <- (Type -> Either [Char] Integer)
-> [Type] -> [Either [Char] Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (Except [Char] Integer -> Either [Char] Integer)
-> (Type -> Except [Char] Integer) -> Type -> Either [Char] Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm) [Type]
tys
    , Just (m :: Integer
m,i :: Integer
i) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> let resTyInfo :: (Type, Type, Integer)
resTyInfo = TyConMap -> Type -> [Type] -> (Type, Type, Integer)
extractTySizeInfo TyConMap
tcm Type
ty [Type]
tys
       in  Term -> Maybe (Heap, Stack, Term)
reduce ((Type, Type, Integer) -> Integer -> Integer -> Term
mkBitVectorLit' (Type, Type, Integer)
resTyInfo Integer
m Integer
i)

  "Clash.Sized.Internal.BitVector.Bit"
    | Just (m :: Integer
m,i :: Integer
i) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Integer -> Integer -> Term
mkBitLit Type
ty Integer
m Integer
i)

-- Initialisation
  "Clash.Sized.Internal.BitVector.size#"
    | Just (_, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    -> 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
           [intCon :: DataCon
intCon] = TyCon -> [DataCon]
tyConDataCons TyCon
intTc
       in  Term -> Maybe (Heap, Stack, Term)
reduce (Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
intCon) [Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
IntLiteral Integer
kn))])
  "Clash.Sized.Internal.BitVector.maxIndex#"
    | Just (_, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    -> 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
           [intCon :: DataCon
intCon] = TyCon -> [DataCon]
tyConDataCons TyCon
intTc
       in  Term -> Maybe (Heap, Stack, Term)
reduce (Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
intCon) [Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
IntLiteral (Integer
knInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))])

-- Construction
  "Clash.Sized.Internal.BitVector.high"
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Integer -> Integer -> Term
mkBitLit Type
ty 0 1)
  "Clash.Sized.Internal.BitVector.low"
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Integer -> Integer -> Term
mkBitLit Type
ty 0 0)

-- Eq
  "Clash.Sized.Internal.BitVector.eq##" | [(0,i :: Integer
i),(0,j :: Integer
j)] <- [Value] -> [(Integer, Integer)]
bitLiterals [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))
  "Clash.Sized.Internal.BitVector.neq##" | [(0,i :: Integer
i),(0,j :: Integer
j)] <- [Value] -> [(Integer, Integer)]
bitLiterals [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))

-- Ord
  "Clash.Sized.Internal.BitVector.lt##" | [(0,i :: Integer
i),(0,j :: Integer
j)] <- [Value] -> [(Integer, Integer)]
bitLiterals [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))
  "Clash.Sized.Internal.BitVector.ge##" | [(0,i :: Integer
i),(0,j :: Integer
j)] <- [Value] -> [(Integer, Integer)]
bitLiterals [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))
  "Clash.Sized.Internal.BitVector.gt##" | [(0,i :: Integer
i),(0,j :: Integer
j)] <- [Value] -> [(Integer, Integer)]
bitLiterals [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))
  "Clash.Sized.Internal.BitVector.le##" | [(0,i :: Integer
i),(0,j :: Integer
j)] <- [Value] -> [(Integer, Integer)]
bitLiterals [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))

-- Bits
  "Clash.Sized.Internal.BitVector.and##"
    | [(0,i :: Integer
i),(0,j :: Integer
j)] <- [Value] -> [(Integer, Integer)]
bitLiterals [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Integer -> Integer -> Term
mkBitLit Type
ty 0 (Integer
i Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
j))
  "Clash.Sized.Internal.BitVector.or##"
    | [(0,i :: Integer
i),(0,j :: Integer
j)] <- [Value] -> [(Integer, Integer)]
bitLiterals [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Integer -> Integer -> Term
mkBitLit Type
ty 0 (Integer
i Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer
j))
  "Clash.Sized.Internal.BitVector.xor##"
    | [(0,i :: Integer
i),(0,j :: Integer
j)] <- [Value] -> [(Integer, Integer)]
bitLiterals [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Integer -> Integer -> Term
mkBitLit Type
ty 0 (Integer
i Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
`xor` Integer
j))

  "Clash.Sized.Internal.BitVector.complement##"
    | [(0,i :: Integer
i)] <- [Value] -> [(Integer, Integer)]
bitLiterals [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Integer -> Integer -> Term
mkBitLit Type
ty 0 (Integer -> Integer
forall a. Bits a => a -> a
complement Integer
i))

-- Pack
  "Clash.Sized.Internal.BitVector.pack#"
    | [(msk :: Integer
msk,i :: Integer
i)] <- [Value] -> [(Integer, Integer)]
bitLiterals [Value]
args
    -> let resTyInfo :: (Type, Type, Integer)
resTyInfo = TyConMap -> Type -> [Type] -> (Type, Type, Integer)
extractTySizeInfo TyConMap
tcm Type
ty [Type]
tys
       in  Term -> Maybe (Heap, Stack, Term)
reduce ((Type, Type, Integer) -> Integer -> Integer -> Term
mkBitVectorLit' (Type, Type, Integer)
resTyInfo Integer
msk Integer
i)

  "Clash.Sized.Internal.BitVector.unpack#"
    | [(msk :: Integer
msk,i :: Integer
i)] <- [Value] -> [(Integer, Integer)]
bitVectorLiterals' [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Integer -> Integer -> Term
mkBitLit Type
ty Integer
msk Integer
i)

-- Concatenation
  "Clash.Sized.Internal.BitVector.++#" -- :: KnownNat m => BitVector n -> BitVector m -> BitVector (n + m)
    | Just (_,m :: Integer
m) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , [(mski :: Integer
mski,i :: Integer
i),(mskj :: Integer
mskj,j :: Integer
j)] <- [Value] -> [(Integer, Integer)]
bitVectorLiterals' [Value]
args
    -> let val :: Integer
val = Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
m Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer
j
           msk :: Integer
msk = Integer
mski Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
m Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer
mskj
           resTyInfo :: (Type, Type, Integer)
resTyInfo = TyConMap -> Type -> [Type] -> (Type, Type, Integer)
extractTySizeInfo TyConMap
tcm Type
ty [Type]
tys
       in Term -> Maybe (Heap, Stack, Term)
reduce ((Type, Type, Integer) -> Integer -> Integer -> Term
mkBitVectorLit' (Type, Type, Integer)
resTyInfo Integer
msk Integer
val)

-- Reduction
  "Clash.Sized.Internal.BitVector.reduceAnd#" -- :: KnownNat n => BitVector n -> Bit
    | [i :: (Integer, Integer)
i] <- [Value] -> [(Integer, Integer)]
bitVectorLiterals' [Value]
args
    , Just (_, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    -> let resTy :: Type
resTy = TyConMap -> Type -> [Type] -> Type
getResultTy TyConMap
tcm Type
ty [Type]
tys
           val :: Integer
val = Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Integer) -> Integer
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn (BitVector n -> Proxy n -> Integer
forall (n :: Nat). KnownNat n => BitVector n -> Proxy n -> Integer
op ((Integer, Integer) -> BitVector n
forall (n :: Nat). (Integer, Integer) -> BitVector n
toBV (Integer, Integer)
i))
       in Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Integer -> Integer -> Term
mkBitLit Type
resTy 0 Integer
val)
    where
      op :: KnownNat n => BitVector n -> Proxy n -> Integer
      op :: BitVector n -> Proxy n -> Integer
op u :: BitVector n
u _ = Bit -> Integer
forall a. Integral a => a -> Integer
toInteger (BitVector n -> Bit
forall (n :: Nat). KnownNat n => BitVector n -> Bit
BitVector.reduceAnd# BitVector n
u)
  "Clash.Sized.Internal.BitVector.reduceOr#" -- :: KnownNat n => BitVector n -> Bit
    | [i :: (Integer, Integer)
i] <- [Value] -> [(Integer, Integer)]
bitVectorLiterals' [Value]
args
    , Just (_, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    -> let resTy :: Type
resTy = TyConMap -> Type -> [Type] -> Type
getResultTy TyConMap
tcm Type
ty [Type]
tys
           val :: Integer
val = Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Integer) -> Integer
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn (BitVector n -> Proxy n -> Integer
forall (n :: Nat). KnownNat n => BitVector n -> Proxy n -> Integer
op ((Integer, Integer) -> BitVector n
forall (n :: Nat). (Integer, Integer) -> BitVector n
toBV (Integer, Integer)
i))
       in Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Integer -> Integer -> Term
mkBitLit Type
resTy 0 Integer
val)
    where
      op :: KnownNat n => BitVector n -> Proxy n -> Integer
      op :: BitVector n -> Proxy n -> Integer
op u :: BitVector n
u _ = Bit -> Integer
forall a. Integral a => a -> Integer
toInteger (BitVector n -> Bit
forall (n :: Nat). KnownNat n => BitVector n -> Bit
BitVector.reduceOr# BitVector n
u)
  "Clash.Sized.Internal.BitVector.reduceXor#" -- :: KnownNat n => BitVector n -> Bit
    | [i :: (Integer, Integer)
i] <- [Value] -> [(Integer, Integer)]
bitVectorLiterals' [Value]
args
    , Just (_, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    -> let resTy :: Type
resTy = TyConMap -> Type -> [Type] -> Type
getResultTy TyConMap
tcm Type
ty [Type]
tys
           val :: Integer
val = Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Integer) -> Integer
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn (BitVector n -> Proxy n -> Integer
forall (n :: Nat). KnownNat n => BitVector n -> Proxy n -> Integer
op ((Integer, Integer) -> BitVector n
forall (n :: Nat). (Integer, Integer) -> BitVector n
toBV (Integer, Integer)
i))
       in Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Integer -> Integer -> Term
mkBitLit Type
resTy 0 Integer
val)
    where
      op :: KnownNat n => BitVector n -> Proxy n -> Integer
      op :: BitVector n -> Proxy n -> Integer
op u :: BitVector n
u _ = Bit -> Integer
forall a. Integral a => a -> Integer
toInteger (BitVector n -> Bit
forall (n :: Nat). KnownNat n => BitVector n -> Bit
BitVector.reduceXor# BitVector n
u)


-- Indexing
  "Clash.Sized.Internal.BitVector.index#" -- :: KnownNat n => BitVector n -> Int -> Bit
    | Just (_,kn :: Integer
kn,i :: (Integer, Integer)
i,j :: Integer
j) <- TyConMap
-> [Type]
-> [Value]
-> Maybe (Type, Integer, (Integer, Integer), Integer)
bitVectorLitIntLit TyConMap
tcm [Type]
tys [Value]
args
      -> let resTy :: Type
resTy = TyConMap -> Type -> [Type] -> Type
getResultTy TyConMap
tcm Type
ty [Type]
tys
             (msk :: Integer
msk,val :: Integer
val) = Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> (Integer, Integer))
-> (Integer, Integer)
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn (BitVector n -> Int -> Proxy n -> (Integer, Integer)
forall (n :: Nat).
KnownNat n =>
BitVector n -> Int -> Proxy n -> (Integer, Integer)
op ((Integer, Integer) -> BitVector n
forall (n :: Nat). (Integer, Integer) -> BitVector n
toBV (Integer, Integer)
i) (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
j))
         in Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Integer -> Integer -> Term
mkBitLit Type
resTy Integer
msk Integer
val)
      where
        op :: KnownNat n => BitVector n -> Int -> Proxy n -> (Integer,Integer)
        op :: BitVector n -> Int -> Proxy n -> (Integer, Integer)
op u :: BitVector n
u i :: Int
i _ = (Integer
m, Integer
v)
          where Bit m :: Integer
m v :: Integer
v = (BitVector n -> Int -> Bit
forall (n :: Nat). KnownNat n => BitVector n -> Int -> Bit
BitVector.index# BitVector n
u Int
i)
  "Clash.Sized.Internal.BitVector.replaceBit#" -- :: :: KnownNat n => BitVector n -> Int -> Bit -> BitVector n
    | Just (_, n :: Integer
n) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , [ _
      , PrimVal bvNm :: Text
bvNm _ _ [_, Lit (IntegerLiteral mskBv :: Integer
mskBv), Lit (IntegerLiteral bv :: Integer
bv)]
      , Value -> Maybe [Term]
valArgs -> Just [Literal (IntLiteral i :: Integer
i)]
      , PrimVal bNm :: Text
bNm  _ _ [Lit (IntegerLiteral mskB :: Integer
mskB), Lit (IntegerLiteral b :: Integer
b)]
      ] <- [Value]
args
    , Text
bvNm Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "Clash.Sized.Internal.BitVector.fromInteger#"
    , Text
bNm  Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "Clash.Sized.Internal.BitVector.fromInteger##"
      -> let resTyInfo :: (Type, Type, Integer)
resTyInfo = TyConMap -> Type -> [Type] -> (Type, Type, Integer)
extractTySizeInfo TyConMap
tcm Type
ty [Type]
tys
             (mskVal :: Integer
mskVal,val :: Integer
val) = Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> (Integer, Integer))
-> (Integer, Integer)
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
n (BitVector n -> Int -> Bit -> Proxy n -> (Integer, Integer)
forall (n :: Nat).
KnownNat n =>
BitVector n -> Int -> Bit -> Proxy n -> (Integer, Integer)
op (Integer -> Integer -> BitVector n
forall (n :: Nat). Integer -> Integer -> BitVector n
BV Integer
mskBv Integer
bv) (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i) (Integer -> Integer -> Bit
Bit Integer
mskB Integer
b))
      in Term -> Maybe (Heap, Stack, Term)
reduce ((Type, Type, Integer) -> Integer -> Integer -> Term
mkBitVectorLit' (Type, Type, Integer)
resTyInfo Integer
mskVal Integer
val)
      where
        op :: KnownNat n => BitVector n -> Int -> Bit -> Proxy n -> (Integer,Integer)
        -- op bv i b _ = (BitVector.unsafeMask res, BitVector.unsafeToInteger res)
        op :: BitVector n -> Int -> Bit -> Proxy n -> (Integer, Integer)
op bv :: BitVector n
bv i :: Int
i b :: Bit
b _ = BitVector n -> (Integer, Integer)
forall (n :: Nat). BitVector n -> (Integer, Integer)
splitBV (BitVector n -> Int -> Bit -> BitVector n
forall (n :: Nat).
KnownNat n =>
BitVector n -> Int -> Bit -> BitVector n
BitVector.replaceBit# BitVector n
bv Int
i Bit
b)
  "Clash.Sized.Internal.BitVector.setSlice#"
  -- :: BitVector (m + 1 + i) -> SNat m -> SNat n -> BitVector (m + 1 - n) -> BitVector (m + 1 + i)
    | mTy :: Type
mTy : _ : nTy :: Type
nTy : _ <- [Type]
tys
    , Right m :: Integer
m <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
mTy)
    , Right n :: Integer
n <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
nTy)
    , [i :: (Integer, Integer)
i,j :: (Integer, Integer)
j] <- [Value] -> [(Integer, Integer)]
bitVectorLiterals' [Value]
args
    -> let BV msk :: Integer
msk val :: Integer
val = BitVector ((Any + 1) + Any)
-> SNat Any
-> SNat Any
-> BitVector ((Any + 1) - Any)
-> BitVector ((Any + 1) + Any)
forall (m :: Nat) (i :: Nat) (n :: Nat).
BitVector ((m + 1) + i)
-> SNat m
-> SNat n
-> BitVector ((m + 1) - n)
-> BitVector ((m + 1) + i)
BitVector.setSlice# ((Integer, Integer) -> BitVector ((Any + 1) + Any)
forall (n :: Nat). (Integer, Integer) -> BitVector n
toBV (Integer, Integer)
i) (Integer -> SNat Any
forall (k :: Nat). Integer -> SNat k
unsafeSNat Integer
m) (Integer -> SNat Any
forall (k :: Nat). Integer -> SNat k
unsafeSNat Integer
n) ((Integer, Integer) -> BitVector ((Any + 1) - Any)
forall (n :: Nat). (Integer, Integer) -> BitVector n
toBV (Integer, Integer)
j)
           resTyInfo :: (Type, Type, Integer)
resTyInfo = TyConMap -> Type -> [Type] -> (Type, Type, Integer)
extractTySizeInfo TyConMap
tcm Type
ty [Type]
tys
       in  Term -> Maybe (Heap, Stack, Term)
reduce ((Type, Type, Integer) -> Integer -> Integer -> Term
mkBitVectorLit' (Type, Type, Integer)
resTyInfo Integer
msk Integer
val)
  "Clash.Sized.Internal.BitVector.slice#"
  -- :: BitVector (m + 1 + i) -> SNat m -> SNat n -> BitVector (m + 1 - n)
    | mTy :: Type
mTy : _ : nTy :: Type
nTy : _ <- [Type]
tys
    , Right m :: Integer
m <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
mTy)
    , Right n :: Integer
n <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
nTy)
    , [i :: (Integer, Integer)
i] <- [Value] -> [(Integer, Integer)]
bitVectorLiterals' [Value]
args
    -> let BV msk :: Integer
msk val :: Integer
val = BitVector ((Any + 1) + Any)
-> SNat Any -> SNat Any -> BitVector ((Any + 1) - Any)
forall (m :: Nat) (i :: Nat) (n :: Nat).
BitVector ((m + 1) + i)
-> SNat m -> SNat n -> BitVector ((m + 1) - n)
BitVector.slice# ((Integer, Integer) -> BitVector ((Any + 1) + Any)
forall (n :: Nat). (Integer, Integer) -> BitVector n
toBV (Integer, Integer)
i) (Integer -> SNat Any
forall (k :: Nat). Integer -> SNat k
unsafeSNat Integer
m) (Integer -> SNat Any
forall (k :: Nat). Integer -> SNat k
unsafeSNat Integer
n)
           resTyInfo :: (Type, Type, Integer)
resTyInfo = TyConMap -> Type -> [Type] -> (Type, Type, Integer)
extractTySizeInfo TyConMap
tcm Type
ty [Type]
tys
       in  Term -> Maybe (Heap, Stack, Term)
reduce ((Type, Type, Integer) -> Integer -> Integer -> Term
mkBitVectorLit' (Type, Type, Integer)
resTyInfo Integer
msk Integer
val)
  "Clash.Sized.Internal.BitVector.split#" -- :: forall n m. KnownNat n => BitVector (m + n) -> (BitVector m, BitVector n)
    | nTy :: Type
nTy : mTy :: Type
mTy : _ <- [Type]
tys
    , Right n :: Integer
n <-  Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
nTy)
    , Right m :: Integer
m <-  Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
mTy)
    , [(mski :: Integer
mski,i :: Integer
i)] <- [Value] -> [(Integer, Integer)]
bitVectorLiterals' [Value]
args
    -> let ty' :: Type
ty' = TyConMap -> Type -> [Type] -> Type
piResultTys TyConMap
tcm Type
ty [Type]
tys
           (_,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
           bvTy :: Type
bvTy : _ = [Type]
tyArgs
           valM :: Integer
valM = Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n
           mskM :: Integer
mskM = Integer
mski Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n
           valN :: Integer
valN = Integer
i Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
mask
           mskN :: Integer
mskN = Integer
mski Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
mask
           mask :: Integer
mask = Int -> Integer
forall a. Bits a => Int -> a
bit (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 1
    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 (Type -> Type -> Integer -> Integer -> Integer -> Term
mkBitVectorLit Type
bvTy Type
mTy Integer
m Integer
mskM Integer
valM)
                , Term -> Either Term Type
forall a b. a -> Either a b
Left (Type -> Type -> Integer -> Integer -> Integer -> Term
mkBitVectorLit Type
bvTy Type
nTy Integer
n Integer
mskN Integer
valN)])

  "Clash.Sized.Internal.BitVector.msb#" -- :: forall n. KnownNat n => BitVector n -> Bit
    | [i :: (Integer, Integer)
i] <- [Value] -> [(Integer, Integer)]
bitVectorLiterals' [Value]
args
    , Just (_, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    -> let resTy :: Type
resTy = TyConMap -> Type -> [Type] -> Type
getResultTy TyConMap
tcm Type
ty [Type]
tys
           (msk :: Integer
msk,val :: Integer
val) = Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> (Integer, Integer))
-> (Integer, Integer)
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn (BitVector n -> Proxy n -> (Integer, Integer)
forall (n :: Nat).
KnownNat n =>
BitVector n -> Proxy n -> (Integer, Integer)
op ((Integer, Integer) -> BitVector n
forall (n :: Nat). (Integer, Integer) -> BitVector n
toBV (Integer, Integer)
i))
       in Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Integer -> Integer -> Term
mkBitLit Type
resTy Integer
msk Integer
val)
    where
      op :: KnownNat n => BitVector n -> Proxy n -> (Integer,Integer)
      op :: BitVector n -> Proxy n -> (Integer, Integer)
op u :: BitVector n
u _ = (Bit -> Integer
unsafeMask# Bit
res, Bit -> Integer
BitVector.unsafeToInteger# Bit
res)
        where
          res :: Bit
res = BitVector n -> Bit
forall (n :: Nat). KnownNat n => BitVector n -> Bit
BitVector.msb# BitVector n
u
  "Clash.Sized.Internal.BitVector.lsb#" -- :: BitVector n -> Bit
    | [i :: (Integer, Integer)
i] <- [Value] -> [(Integer, Integer)]
bitVectorLiterals' [Value]
args
    -> let resTy :: Type
resTy = TyConMap -> Type -> [Type] -> Type
getResultTy TyConMap
tcm Type
ty [Type]
tys
           Bit msk :: Integer
msk val :: Integer
val = BitVector Any -> Bit
forall (n :: Nat). BitVector n -> Bit
BitVector.lsb# ((Integer, Integer) -> BitVector Any
forall (n :: Nat). (Integer, Integer) -> BitVector n
toBV (Integer, Integer)
i)
    in Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Integer -> Integer -> Term
mkBitLit Type
resTy Integer
msk Integer
val)


-- Eq
  -- eq#, neq# :: KnownNat n => BitVector n -> BitVector n -> Bool
  "Clash.Sized.Internal.BitVector.eq#"
    | nTy :: Type
nTy : _ <- [Type]
tys
    , Right 0 <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> Term -> Maybe (Heap, Stack, Term)
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty Bool
True)
    | Just (_, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just val :: Term
val <- Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Maybe Term)
-> Maybe Term
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn ((BitVector n -> BitVector n -> Bool)
-> Type -> TyConMap -> [Value] -> Proxy n -> Maybe Term
forall (n :: Nat).
KnownNat n =>
(BitVector n -> BitVector n -> Bool)
-> Type -> TyConMap -> [Value] -> Proxy n -> Maybe Term
liftBitVector2Bool BitVector n -> BitVector n -> Bool
forall (n :: Nat). KnownNat n => BitVector n -> BitVector n -> Bool
BitVector.eq# Type
ty TyConMap
tcm [Value]
args)
    -> Term -> Maybe (Heap, Stack, Term)
reduce Term
val

  "Clash.Sized.Internal.BitVector.neq#"
    | nTy :: Type
nTy : _ <- [Type]
tys
    , Right 0 <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> Term -> Maybe (Heap, Stack, Term)
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty Bool
False)
    | Just (_, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just val :: Term
val <- Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Maybe Term)
-> Maybe Term
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn ((BitVector n -> BitVector n -> Bool)
-> Type -> TyConMap -> [Value] -> Proxy n -> Maybe Term
forall (n :: Nat).
KnownNat n =>
(BitVector n -> BitVector n -> Bool)
-> Type -> TyConMap -> [Value] -> Proxy n -> Maybe Term
liftBitVector2Bool BitVector n -> BitVector n -> Bool
forall (n :: Nat). KnownNat n => BitVector n -> BitVector n -> Bool
BitVector.neq# Type
ty TyConMap
tcm [Value]
args)
    -> Term -> Maybe (Heap, Stack, Term)
reduce Term
val

-- Ord
  -- lt#,ge#,gt#,le# :: KnownNat n => BitVector n -> BitVector n -> Bool
  "Clash.Sized.Internal.BitVector.lt#"
    | nTy :: Type
nTy : _ <- [Type]
tys
    , Right 0 <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> Term -> Maybe (Heap, Stack, Term)
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty Bool
False)
    | Just (_, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just val :: Term
val <- Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Maybe Term)
-> Maybe Term
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn ((BitVector n -> BitVector n -> Bool)
-> Type -> TyConMap -> [Value] -> Proxy n -> Maybe Term
forall (n :: Nat).
KnownNat n =>
(BitVector n -> BitVector n -> Bool)
-> Type -> TyConMap -> [Value] -> Proxy n -> Maybe Term
liftBitVector2Bool BitVector n -> BitVector n -> Bool
forall (n :: Nat). KnownNat n => BitVector n -> BitVector n -> Bool
BitVector.lt# Type
ty TyConMap
tcm [Value]
args)
    -> Term -> Maybe (Heap, Stack, Term)
reduce Term
val
  "Clash.Sized.Internal.BitVector.ge#"
    | nTy :: Type
nTy : _ <- [Type]
tys
    , Right 0 <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> Term -> Maybe (Heap, Stack, Term)
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty Bool
True)
    | Just (_, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just val :: Term
val <- Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Maybe Term)
-> Maybe Term
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn ((BitVector n -> BitVector n -> Bool)
-> Type -> TyConMap -> [Value] -> Proxy n -> Maybe Term
forall (n :: Nat).
KnownNat n =>
(BitVector n -> BitVector n -> Bool)
-> Type -> TyConMap -> [Value] -> Proxy n -> Maybe Term
liftBitVector2Bool BitVector n -> BitVector n -> Bool
forall (n :: Nat). KnownNat n => BitVector n -> BitVector n -> Bool
BitVector.ge# Type
ty TyConMap
tcm [Value]
args)
    -> Term -> Maybe (Heap, Stack, Term)
reduce Term
val
  "Clash.Sized.Internal.BitVector.gt#"
    | nTy :: Type
nTy : _ <- [Type]
tys
    , Right 0 <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> Term -> Maybe (Heap, Stack, Term)
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty Bool
False)
    | Just (_, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just val :: Term
val <- Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Maybe Term)
-> Maybe Term
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn ((BitVector n -> BitVector n -> Bool)
-> Type -> TyConMap -> [Value] -> Proxy n -> Maybe Term
forall (n :: Nat).
KnownNat n =>
(BitVector n -> BitVector n -> Bool)
-> Type -> TyConMap -> [Value] -> Proxy n -> Maybe Term
liftBitVector2Bool BitVector n -> BitVector n -> Bool
forall (n :: Nat). KnownNat n => BitVector n -> BitVector n -> Bool
BitVector.gt# Type
ty TyConMap
tcm [Value]
args)
    -> Term -> Maybe (Heap, Stack, Term)
reduce Term
val
  "Clash.Sized.Internal.BitVector.le#"
    | nTy :: Type
nTy : _ <- [Type]
tys
    , Right 0 <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> Term -> Maybe (Heap, Stack, Term)
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty Bool
True)
    | Just (_, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just val :: Term
val <- Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Maybe Term)
-> Maybe Term
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn ((BitVector n -> BitVector n -> Bool)
-> Type -> TyConMap -> [Value] -> Proxy n -> Maybe Term
forall (n :: Nat).
KnownNat n =>
(BitVector n -> BitVector n -> Bool)
-> Type -> TyConMap -> [Value] -> Proxy n -> Maybe Term
liftBitVector2Bool BitVector n -> BitVector n -> Bool
forall (n :: Nat). KnownNat n => BitVector n -> BitVector n -> Bool
BitVector.le# Type
ty TyConMap
tcm [Value]
args)
    -> Term -> Maybe (Heap, Stack, Term)
reduce Term
val

-- Bounded
  "Clash.Sized.Internal.BitVector.minBound#"
    | Just (nTy :: Type
nTy,len :: Integer
len) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Integer -> Term
mkBitVectorLit Type
ty Type
nTy Integer
len 0 0)
  "Clash.Sized.Internal.BitVector.maxBound#"
    | Just (litTy :: Type
litTy,mb :: Integer
mb) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    -> let maxB :: Integer
maxB = (2 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
mb) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 1
       in  Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Integer -> Term
mkBitVectorLit Type
ty Type
litTy Integer
mb 0 Integer
maxB)

-- Num
  "Clash.Sized.Internal.BitVector.+#"
    | Just (_, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just val :: Term
val <- Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Maybe Term)
-> Maybe Term
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn ((BitVector n -> BitVector n -> BitVector n)
-> Type -> TyConMap -> [Type] -> [Value] -> Proxy n -> Maybe Term
forall (n :: Nat).
KnownNat n =>
(BitVector n -> BitVector n -> BitVector n)
-> Type -> TyConMap -> [Type] -> [Value] -> Proxy n -> Maybe Term
liftBitVector2 BitVector n -> BitVector n -> BitVector n
forall (n :: Nat).
KnownNat n =>
BitVector n -> BitVector n -> BitVector n
(BitVector.+#) Type
ty TyConMap
tcm [Type]
tys [Value]
args)
    -> Term -> Maybe (Heap, Stack, Term)
reduce Term
val
  "Clash.Sized.Internal.BitVector.-#"
    | Just (_, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just val :: Term
val <- Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Maybe Term)
-> Maybe Term
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn ((BitVector n -> BitVector n -> BitVector n)
-> Type -> TyConMap -> [Type] -> [Value] -> Proxy n -> Maybe Term
forall (n :: Nat).
KnownNat n =>
(BitVector n -> BitVector n -> BitVector n)
-> Type -> TyConMap -> [Type] -> [Value] -> Proxy n -> Maybe Term
liftBitVector2 BitVector n -> BitVector n -> BitVector n
forall (n :: Nat).
KnownNat n =>
BitVector n -> BitVector n -> BitVector n
(BitVector.-#) Type
ty TyConMap
tcm [Type]
tys [Value]
args)
    -> Term -> Maybe (Heap, Stack, Term)
reduce Term
val
  "Clash.Sized.Internal.BitVector.*#"
    | Just (_, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just val :: Term
val <- Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Maybe Term)
-> Maybe Term
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn ((BitVector n -> BitVector n -> BitVector n)
-> Type -> TyConMap -> [Type] -> [Value] -> Proxy n -> Maybe Term
forall (n :: Nat).
KnownNat n =>
(BitVector n -> BitVector n -> BitVector n)
-> Type -> TyConMap -> [Type] -> [Value] -> Proxy n -> Maybe Term
liftBitVector2 BitVector n -> BitVector n -> BitVector n
forall (n :: Nat).
KnownNat n =>
BitVector n -> BitVector n -> BitVector n
(BitVector.*#) Type
ty TyConMap
tcm [Type]
tys [Value]
args)
    -> Term -> Maybe (Heap, Stack, Term)
reduce Term
val
  "Clash.Sized.Internal.BitVector.negate#"
    | Just (nTy :: Type
nTy, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , [i :: (Integer, Integer)
i] <- [Value] -> [(Integer, Integer)]
bitVectorLiterals' [Value]
args
    -> let (msk :: Integer
msk,val :: Integer
val) = Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> (Integer, Integer))
-> (Integer, Integer)
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn (BitVector n -> Proxy n -> (Integer, Integer)
forall (n :: Nat).
KnownNat n =>
BitVector n -> Proxy n -> (Integer, Integer)
op ((Integer, Integer) -> BitVector n
forall (n :: Nat). (Integer, Integer) -> BitVector n
toBV (Integer, Integer)
i))
    in Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Integer -> Term
mkBitVectorLit Type
ty Type
nTy Integer
kn Integer
msk Integer
val)
    where
      op :: KnownNat n => BitVector n -> Proxy n -> (Integer,Integer)
      op :: BitVector n -> Proxy n -> (Integer, Integer)
op u :: BitVector n
u _ = BitVector n -> (Integer, Integer)
forall (n :: Nat). BitVector n -> (Integer, Integer)
splitBV (BitVector n -> BitVector n
forall (n :: Nat). KnownNat n => BitVector n -> BitVector n
BitVector.negate# BitVector n
u)

-- ExtendingNum
  "Clash.Sized.Internal.BitVector.plus#" -- :: (KnownNat n, KnownNat m) => BitVector m -> BitVector n -> BitVector (Max m n + 1)
    | [(0,i :: Integer
i),(0,j :: Integer
j)] <- [Value] -> [(Integer, Integer)]
bitVectorLiterals' [Value]
args
    -> let ty' :: Type
ty' = TyConMap -> Type -> [Type] -> Type
piResultTys TyConMap
tcm Type
ty [Type]
tys
           (_,resTy :: Type
resTy) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty'
           (TyConApp _ [resSizeTy :: Type
resSizeTy]) = Type -> TypeView
tyView Type
resTy
           Right resSizeInt :: Integer
resSizeInt = Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
resSizeTy)
       in  Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Integer -> Term
mkBitVectorLit Type
resTy Type
resSizeTy Integer
resSizeInt 0 (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
j))

  "Clash.Sized.Internal.BitVector.minus#"
    | [(0,i :: Integer
i),(0,j :: Integer
j)] <- [Value] -> [(Integer, Integer)]
bitVectorLiterals' [Value]
args
    -> let ty' :: Type
ty' = TyConMap -> Type -> [Type] -> Type
piResultTys TyConMap
tcm Type
ty [Type]
tys
           (_,resTy :: Type
resTy) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty'
           (TyConApp _ [resSizeTy :: Type
resSizeTy]) = Type -> TypeView
tyView Type
resTy
           Right resSizeInt :: Integer
resSizeInt = Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
resSizeTy)
           val :: Integer
val = Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Integer) -> Integer
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
resSizeInt ((BitVector n -> BitVector n -> BitVector n)
-> Integer -> Integer -> Proxy n -> Integer
forall (n :: Nat) (sized :: Nat -> *).
(KnownNat n, Integral (sized n)) =>
(sized n -> sized n -> sized n)
-> Integer -> Integer -> Proxy n -> Integer
runSizedF BitVector n -> BitVector n -> BitVector n
forall (n :: Nat).
KnownNat n =>
BitVector n -> BitVector n -> BitVector n
(BitVector.-#) Integer
i Integer
j)
      in  Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Integer -> Term
mkBitVectorLit Type
resTy Type
resSizeTy Integer
resSizeInt 0 Integer
val)

  "Clash.Sized.Internal.BitVector.times#"
    | [(0,i :: Integer
i),(0,j :: Integer
j)] <- [Value] -> [(Integer, Integer)]
bitVectorLiterals' [Value]
args
    -> let ty' :: Type
ty' = TyConMap -> Type -> [Type] -> Type
piResultTys TyConMap
tcm Type
ty [Type]
tys
           (_,resTy :: Type
resTy) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty'
           (TyConApp _ [resSizeTy :: Type
resSizeTy]) = Type -> TypeView
tyView Type
resTy
           Right resSizeInt :: Integer
resSizeInt = Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
resSizeTy)
       in  Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Integer -> Term
mkBitVectorLit Type
resTy Type
resSizeTy Integer
resSizeInt 0 (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
j))

-- Integral
  "Clash.Sized.Internal.BitVector.quot#"
    | Just (_, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just val :: Term
val <- Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Maybe Term)
-> Maybe Term
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn ((BitVector n -> BitVector n -> BitVector n)
-> Type -> TyConMap -> [Type] -> [Value] -> Proxy n -> Maybe Term
forall (n :: Nat).
KnownNat n =>
(BitVector n -> BitVector n -> BitVector n)
-> Type -> TyConMap -> [Type] -> [Value] -> Proxy n -> Maybe Term
liftBitVector2 (BitVector n -> BitVector n -> BitVector n
forall (n :: Nat).
KnownNat n =>
BitVector n -> BitVector n -> BitVector n
BitVector.quot#) Type
ty TyConMap
tcm [Type]
tys [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 Term
val
  "Clash.Sized.Internal.BitVector.rem#"
    | Just (_, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just val :: Term
val <- Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Maybe Term)
-> Maybe Term
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn ((BitVector n -> BitVector n -> BitVector n)
-> Type -> TyConMap -> [Type] -> [Value] -> Proxy n -> Maybe Term
forall (n :: Nat).
KnownNat n =>
(BitVector n -> BitVector n -> BitVector n)
-> Type -> TyConMap -> [Type] -> [Value] -> Proxy n -> Maybe Term
liftBitVector2 (BitVector n -> BitVector n -> BitVector n
forall (n :: Nat).
KnownNat n =>
BitVector n -> BitVector n -> BitVector n
BitVector.rem#) Type
ty TyConMap
tcm [Type]
tys [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 Term
val
  "Clash.Sized.Internal.BitVector.toInteger#"
    | Just (_, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , [i :: (Integer, Integer)
i] <- [Value] -> [(Integer, Integer)]
bitVectorLiterals' [Value]
args
    -> let val :: Integer
val = Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Integer) -> Integer
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn (BitVector n -> Proxy n -> Integer
forall (n :: Nat). KnownNat n => BitVector n -> Proxy n -> Integer
op ((Integer, Integer) -> BitVector n
forall (n :: Nat). (Integer, Integer) -> BitVector n
toBV (Integer, Integer)
i))
    in Term -> Maybe (Heap, Stack, Term)
reduce (Integer -> Term
integerToIntegerLiteral Integer
val)
    where
      op :: KnownNat n => BitVector n -> Proxy n -> Integer
      op :: BitVector n -> Proxy n -> Integer
op u :: BitVector n
u _ = BitVector n -> Integer
forall (n :: Nat). KnownNat n => BitVector n -> Integer
BitVector.toInteger# BitVector n
u

-- Bits
  "Clash.Sized.Internal.BitVector.and#"
    | Just (i :: (Integer, Integer)
i,j :: (Integer, Integer)
j) <- [Value] -> Maybe ((Integer, Integer), (Integer, Integer))
bitVectorLiterals [Value]
args
    , Just (nTy :: Type
nTy, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    -> let BV msk :: Integer
msk val :: Integer
val = BitVector Any -> BitVector Any -> BitVector Any
forall (n :: Nat). BitVector n -> BitVector n -> BitVector n
BitVector.and# ((Integer, Integer) -> BitVector Any
forall (n :: Nat). (Integer, Integer) -> BitVector n
toBV (Integer, Integer)
i) ((Integer, Integer) -> BitVector Any
forall (n :: Nat). (Integer, Integer) -> BitVector n
toBV (Integer, Integer)
j)
    in Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Integer -> Term
mkBitVectorLit Type
ty Type
nTy Integer
kn Integer
msk Integer
val)
  "Clash.Sized.Internal.BitVector.or#"
    | Just (i :: (Integer, Integer)
i,j :: (Integer, Integer)
j) <- [Value] -> Maybe ((Integer, Integer), (Integer, Integer))
bitVectorLiterals [Value]
args
    , Just (nTy :: Type
nTy, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    -> let BV msk :: Integer
msk val :: Integer
val = BitVector Any -> BitVector Any -> BitVector Any
forall (n :: Nat). BitVector n -> BitVector n -> BitVector n
BitVector.or# ((Integer, Integer) -> BitVector Any
forall (n :: Nat). (Integer, Integer) -> BitVector n
toBV (Integer, Integer)
i) ((Integer, Integer) -> BitVector Any
forall (n :: Nat). (Integer, Integer) -> BitVector n
toBV (Integer, Integer)
j)
    in Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Integer -> Term
mkBitVectorLit Type
ty Type
nTy Integer
kn Integer
msk Integer
val)
  "Clash.Sized.Internal.BitVector.xor#"
    | Just (i :: (Integer, Integer)
i,j :: (Integer, Integer)
j) <- [Value] -> Maybe ((Integer, Integer), (Integer, Integer))
bitVectorLiterals [Value]
args
    , Just (nTy :: Type
nTy, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    -> let BV msk :: Integer
msk val :: Integer
val = BitVector Any -> BitVector Any -> BitVector Any
forall (n :: Nat). BitVector n -> BitVector n -> BitVector n
BitVector.xor# ((Integer, Integer) -> BitVector Any
forall (n :: Nat). (Integer, Integer) -> BitVector n
toBV (Integer, Integer)
i) ((Integer, Integer) -> BitVector Any
forall (n :: Nat). (Integer, Integer) -> BitVector n
toBV (Integer, Integer)
j)
    in Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Integer -> Term
mkBitVectorLit Type
ty Type
nTy Integer
kn Integer
msk Integer
val)

  "Clash.Sized.Internal.BitVector.complement#"
    | [i :: (Integer, Integer)
i] <- [Value] -> [(Integer, Integer)]
bitVectorLiterals' [Value]
args
    , Just (nTy :: Type
nTy, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    -> let (msk :: Integer
msk,val :: Integer
val) = Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> (Integer, Integer))
-> (Integer, Integer)
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn (BitVector n -> Proxy n -> (Integer, Integer)
forall (n :: Nat).
KnownNat n =>
BitVector n -> Proxy n -> (Integer, Integer)
op ((Integer, Integer) -> BitVector n
forall (n :: Nat). (Integer, Integer) -> BitVector n
toBV (Integer, Integer)
i))
    in Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Integer -> Term
mkBitVectorLit Type
ty Type
nTy Integer
kn Integer
msk Integer
val)
    where
      op :: KnownNat n => BitVector n -> Proxy n -> (Integer,Integer)
      op :: BitVector n -> Proxy n -> (Integer, Integer)
op u :: BitVector n
u _ = BitVector n -> (Integer, Integer)
forall (n :: Nat). BitVector n -> (Integer, Integer)
splitBV (BitVector n -> (Integer, Integer))
-> BitVector n -> (Integer, Integer)
forall a b. (a -> b) -> a -> b
$ BitVector n -> BitVector n
forall (n :: Nat). KnownNat n => BitVector n -> BitVector n
BitVector.complement# BitVector n
u

  "Clash.Sized.Internal.BitVector.shiftL#"
    | Just (nTy :: Type
nTy,kn :: Integer
kn,i :: (Integer, Integer)
i,j :: Integer
j) <- TyConMap
-> [Type]
-> [Value]
-> Maybe (Type, Integer, (Integer, Integer), Integer)
bitVectorLitIntLit TyConMap
tcm [Type]
tys [Value]
args
      -> let (msk :: Integer
msk,val :: Integer
val) = Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> (Integer, Integer))
-> (Integer, Integer)
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn (BitVector n -> Int -> Proxy n -> (Integer, Integer)
forall (n :: Nat).
KnownNat n =>
BitVector n -> Int -> Proxy n -> (Integer, Integer)
op ((Integer, Integer) -> BitVector n
forall (n :: Nat). (Integer, Integer) -> BitVector n
toBV (Integer, Integer)
i) (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
j))
      in Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Integer -> Term
mkBitVectorLit Type
ty Type
nTy Integer
kn Integer
msk Integer
val)
      where
        op :: KnownNat n => BitVector n -> Int -> Proxy n -> (Integer,Integer)
        op :: BitVector n -> Int -> Proxy n -> (Integer, Integer)
op u :: BitVector n
u i :: Int
i _ = BitVector n -> (Integer, Integer)
forall (n :: Nat). BitVector n -> (Integer, Integer)
splitBV (BitVector n -> Int -> BitVector n
forall (n :: Nat). KnownNat n => BitVector n -> Int -> BitVector n
BitVector.shiftL# BitVector n
u Int
i)
  "Clash.Sized.Internal.BitVector.shiftR#"
    | Just (nTy :: Type
nTy,kn :: Integer
kn,i :: (Integer, Integer)
i,j :: Integer
j) <- TyConMap
-> [Type]
-> [Value]
-> Maybe (Type, Integer, (Integer, Integer), Integer)
bitVectorLitIntLit TyConMap
tcm [Type]
tys [Value]
args
      -> let (msk :: Integer
msk,val :: Integer
val) = Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> (Integer, Integer))
-> (Integer, Integer)
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn (BitVector n -> Int -> Proxy n -> (Integer, Integer)
forall (n :: Nat).
KnownNat n =>
BitVector n -> Int -> Proxy n -> (Integer, Integer)
op ((Integer, Integer) -> BitVector n
forall (n :: Nat). (Integer, Integer) -> BitVector n
toBV (Integer, Integer)
i) (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
j))
      in Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Integer -> Term
mkBitVectorLit Type
ty Type
nTy Integer
kn Integer
msk Integer
val)
      where
        op :: KnownNat n => BitVector n -> Int -> Proxy n -> (Integer,Integer)
        op :: BitVector n -> Int -> Proxy n -> (Integer, Integer)
op u :: BitVector n
u i :: Int
i _ = BitVector n -> (Integer, Integer)
forall (n :: Nat). BitVector n -> (Integer, Integer)
splitBV (BitVector n -> Int -> BitVector n
forall (n :: Nat). KnownNat n => BitVector n -> Int -> BitVector n
BitVector.shiftR# BitVector n
u Int
i)
  "Clash.Sized.Internal.BitVector.rotateL#"
    | Just (nTy :: Type
nTy,kn :: Integer
kn,i :: (Integer, Integer)
i,j :: Integer
j) <- TyConMap
-> [Type]
-> [Value]
-> Maybe (Type, Integer, (Integer, Integer), Integer)
bitVectorLitIntLit TyConMap
tcm [Type]
tys [Value]
args
      -> let (msk :: Integer
msk,val :: Integer
val) = Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> (Integer, Integer))
-> (Integer, Integer)
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn (BitVector n -> Int -> Proxy n -> (Integer, Integer)
forall (n :: Nat).
KnownNat n =>
BitVector n -> Int -> Proxy n -> (Integer, Integer)
op ((Integer, Integer) -> BitVector n
forall (n :: Nat). (Integer, Integer) -> BitVector n
toBV (Integer, Integer)
i) (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
j))
      in Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Integer -> Term
mkBitVectorLit Type
ty Type
nTy Integer
kn Integer
msk Integer
val)
      where
        op :: KnownNat n => BitVector n -> Int -> Proxy n -> (Integer,Integer)
        op :: BitVector n -> Int -> Proxy n -> (Integer, Integer)
op u :: BitVector n
u i :: Int
i _ = BitVector n -> (Integer, Integer)
forall (n :: Nat). BitVector n -> (Integer, Integer)
splitBV (BitVector n -> Int -> BitVector n
forall (n :: Nat). KnownNat n => BitVector n -> Int -> BitVector n
BitVector.rotateL# BitVector n
u Int
i)
  "Clash.Sized.Internal.BitVector.rotateR#"
    | Just (nTy :: Type
nTy,kn :: Integer
kn,i :: (Integer, Integer)
i,j :: Integer
j) <- TyConMap
-> [Type]
-> [Value]
-> Maybe (Type, Integer, (Integer, Integer), Integer)
bitVectorLitIntLit TyConMap
tcm [Type]
tys [Value]
args
      -> let (msk :: Integer
msk,val :: Integer
val) = Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> (Integer, Integer))
-> (Integer, Integer)
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn (BitVector n -> Int -> Proxy n -> (Integer, Integer)
forall (n :: Nat).
KnownNat n =>
BitVector n -> Int -> Proxy n -> (Integer, Integer)
op ((Integer, Integer) -> BitVector n
forall (n :: Nat). (Integer, Integer) -> BitVector n
toBV (Integer, Integer)
i) (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
j))
      in Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Integer -> Term
mkBitVectorLit Type
ty Type
nTy Integer
kn Integer
msk Integer
val)
      where
        op :: KnownNat n => BitVector n -> Int -> Proxy n -> (Integer,Integer)
        op :: BitVector n -> Int -> Proxy n -> (Integer, Integer)
op u :: BitVector n
u i :: Int
i _ = BitVector n -> (Integer, Integer)
forall (n :: Nat). BitVector n -> (Integer, Integer)
splitBV (BitVector n -> Int -> BitVector n
forall (n :: Nat). KnownNat n => BitVector n -> Int -> BitVector n
BitVector.rotateR# BitVector n
u Int
i)

-- truncateB
  "Clash.Sized.Internal.BitVector.truncateB#" -- forall a b . KnownNat a => BitVector (a + b) -> BitVector a
    | aTy :: Type
aTy  : _ <- [Type]
tys
    , Right ka :: Integer
ka <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
aTy)
    , [(mski :: Integer
mski,i :: Integer
i)] <- [Value] -> [(Integer, Integer)]
bitVectorLiterals' [Value]
args
    -> let bitsKeep :: Integer
bitsKeep = (Int -> Integer
forall a. Bits a => Int -> a
bit (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
ka)) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 1
           val :: Integer
val = Integer
i Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
bitsKeep
           msk :: Integer
msk = Integer
mski Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
bitsKeep
    in Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Integer -> Term
mkBitVectorLit Type
ty Type
aTy Integer
ka Integer
msk Integer
val)

--------
-- Index
--------
-- BitPack
  "Clash.Sized.Internal.Index.pack#"
    | nTy :: Type
nTy : _ <- [Type]
tys
    , Right _ <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
nTy)
    , [i :: Integer
i] <- [Value] -> [Integer]
indexLiterals' [Value]
args
    -> let resTyInfo :: (Type, Type, Integer)
resTyInfo = TyConMap -> Type -> [Type] -> (Type, Type, Integer)
extractTySizeInfo TyConMap
tcm Type
ty [Type]
tys
       in  Term -> Maybe (Heap, Stack, Term)
reduce ((Type, Type, Integer) -> Integer -> Integer -> Term
mkBitVectorLit' (Type, Type, Integer)
resTyInfo 0 Integer
i)
  "Clash.Sized.Internal.Index.unpack#"
    | Just (nTy :: Type
nTy,kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , [(0,i :: Integer
i)] <- [Value] -> [(Integer, Integer)]
bitVectorLiterals' [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkIndexLit Type
ty Type
nTy Integer
kn Integer
i)

-- Eq
  "Clash.Sized.Internal.Index.eq#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
indexLiterals [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))
  "Clash.Sized.Internal.Index.neq#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
indexLiterals [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))

-- Ord
  "Clash.Sized.Internal.Index.lt#"
    | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
indexLiterals [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))
  "Clash.Sized.Internal.Index.ge#"
    | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
indexLiterals [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))
  "Clash.Sized.Internal.Index.gt#"
    | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
indexLiterals [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))
  "Clash.Sized.Internal.Index.le#"
    | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
indexLiterals [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))

-- Bounded
  "Clash.Sized.Internal.Index.maxBound#"
    | Just (nTy :: Type
nTy,mb :: Integer
mb) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkIndexLit Type
ty Type
nTy Integer
mb (Integer
mb Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 1))

-- Num
  "Clash.Sized.Internal.Index.+#"
    | Just (nTy :: Type
nTy,kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , [i :: Integer
i,j :: Integer
j] <- [Value] -> [Integer]
indexLiterals' [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkIndexLit Type
ty Type
nTy Integer
kn (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
j))
  "Clash.Sized.Internal.Index.-#"
    | Just (nTy :: Type
nTy,kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , [i :: Integer
i,j :: Integer
j] <- [Value] -> [Integer]
indexLiterals' [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkIndexLit Type
ty Type
nTy Integer
kn (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
j))
  "Clash.Sized.Internal.Index.*#"
    | Just (nTy :: Type
nTy,kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , [i :: Integer
i,j :: Integer
j] <- [Value] -> [Integer]
indexLiterals' [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkIndexLit Type
ty Type
nTy Integer
kn (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
j))

-- ExtendingNum
  "Clash.Sized.Internal.Index.plus#"
    | mTy :: Type
mTy : nTy :: Type
nTy : _ <- [Type]
tys
    , Right _ <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
mTy)
    , Right _ <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
nTy)
    , Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
indexLiterals [Value]
args
    -> let resTyInfo :: (Type, Type, Integer)
resTyInfo = TyConMap -> Type -> [Type] -> (Type, Type, Integer)
extractTySizeInfo TyConMap
tcm Type
ty [Type]
tys
       in  Term -> Maybe (Heap, Stack, Term)
reduce ((Type, Type, Integer) -> Integer -> Term
mkIndexLit' (Type, Type, Integer)
resTyInfo (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
j))
  "Clash.Sized.Internal.Index.minus#"
    | mTy :: Type
mTy : nTy :: Type
nTy : _ <- [Type]
tys
    , Right _ <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
mTy)
    , Right _ <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
nTy)
    , Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
indexLiterals [Value]
args
    -> let resTyInfo :: (Type, Type, Integer)
resTyInfo = TyConMap -> Type -> [Type] -> (Type, Type, Integer)
extractTySizeInfo TyConMap
tcm Type
ty [Type]
tys
       in  Term -> Maybe (Heap, Stack, Term)
reduce ((Type, Type, Integer) -> Integer -> Term
mkIndexLit' (Type, Type, Integer)
resTyInfo (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
j))
  "Clash.Sized.Internal.Index.times#"
    | mTy :: Type
mTy : nTy :: Type
nTy : _ <- [Type]
tys
    , Right _ <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
mTy)
    , Right _ <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
nTy)
    , Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
indexLiterals [Value]
args
    -> let resTyInfo :: (Type, Type, Integer)
resTyInfo = TyConMap -> Type -> [Type] -> (Type, Type, Integer)
extractTySizeInfo TyConMap
tcm Type
ty [Type]
tys
       in  Term -> Maybe (Heap, Stack, Term)
reduce ((Type, Type, Integer) -> Integer -> Term
mkIndexLit' (Type, Type, Integer)
resTyInfo (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
j))

-- Integral
  "Clash.Sized.Internal.Index.quot#"
    | Just (nTy :: Type
nTy,kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
indexLiterals [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 (Type -> Type -> Integer -> Integer -> Term
mkIndexLit Type
ty Type
nTy Integer
kn (Integer
i Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
j))
  "Clash.Sized.Internal.Index.rem#"
    | Just (nTy :: Type
nTy,kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
indexLiterals [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 (Type -> Type -> Integer -> Integer -> Term
mkIndexLit Type
ty Type
nTy Integer
kn (Integer
i Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`rem` Integer
j))
  "Clash.Sized.Internal.Index.toInteger#"
    | [PrimVal nm' :: Text
nm' _ _ [_, Lit (IntegerLiteral i :: Integer
i)]] <- [Value]
args
    , Text
nm' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "Clash.Sized.Internal.Index.fromInteger#"
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Integer -> Term
integerToIntegerLiteral Integer
i)

-- Resize
  "Clash.Sized.Internal.Index.resize#"
    | Just (mTy :: Type
mTy,m :: Integer
m) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , [i :: Integer
i] <- [Value] -> [Integer]
indexLiterals' [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkIndexLit Type
ty Type
mTy Integer
m Integer
i)

---------
-- Signed
---------
  "Clash.Sized.Internal.Signed.size#"
    | Just (_, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    -> 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
           [intCon :: DataCon
intCon] = TyCon -> [DataCon]
tyConDataCons TyCon
intTc
       in  Term -> Maybe (Heap, Stack, Term)
reduce (Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
intCon) [Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
IntLiteral Integer
kn))])

-- BitPack
  "Clash.Sized.Internal.Signed.pack#"
    | Just (nTy :: Type
nTy, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , [i :: Integer
i] <- [Value] -> [Integer]
signedLiterals' [Value]
args
    -> let val :: Integer
val = Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Integer) -> Integer
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn (Signed n -> Proxy n -> Integer
forall (n :: Nat). KnownNat n => Signed n -> Proxy n -> Integer
op (Integer -> Signed n
forall a. Num a => Integer -> a
fromInteger Integer
i))
       in Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Integer -> Term
mkBitVectorLit Type
ty Type
nTy Integer
kn 0 Integer
val)
    where
        op :: KnownNat n => Signed n -> Proxy n -> Integer
        op :: Signed n -> Proxy n -> Integer
op s :: Signed n
s _ = BitVector n -> Integer
forall a. Integral a => a -> Integer
toInteger (Signed n -> BitVector n
forall (n :: Nat). KnownNat n => Signed n -> BitVector n
Signed.pack# Signed n
s)
  "Clash.Sized.Internal.Signed.unpack#"
    | Just (nTy :: Type
nTy, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , [(0,i :: Integer
i)] <- [Value] -> [(Integer, Integer)]
bitVectorLiterals' [Value]
args
    -> let val :: Integer
val = Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Integer) -> Integer
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn (BitVector n -> Proxy n -> Integer
forall (n :: Nat). KnownNat n => BitVector n -> Proxy n -> Integer
op (Integer -> BitVector n
forall a. Num a => Integer -> a
fromInteger Integer
i))
       in Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkSignedLit Type
ty Type
nTy Integer
kn Integer
val)
    where
        op :: KnownNat n => BitVector n -> Proxy n -> Integer
        op :: BitVector n -> Proxy n -> Integer
op s :: BitVector n
s _ = Signed n -> Integer
forall a. Integral a => a -> Integer
toInteger (BitVector n -> Signed n
forall (n :: Nat). KnownNat n => BitVector n -> Signed n
Signed.unpack# BitVector n
s)

-- Eq
  "Clash.Sized.Internal.Signed.eq#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
signedLiterals [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))
  "Clash.Sized.Internal.Signed.neq#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
signedLiterals [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))

-- Ord
  "Clash.Sized.Internal.Signed.lt#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
signedLiterals [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))
  "Clash.Sized.Internal.Signed.ge#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
signedLiterals [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))
  "Clash.Sized.Internal.Signed.gt#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
signedLiterals [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))
  "Clash.Sized.Internal.Signed.le#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
signedLiterals [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))

-- Bounded
  "Clash.Sized.Internal.Signed.minBound#"
    | Just (litTy :: Type
litTy,mb :: Integer
mb) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    -> let minB :: Integer
minB = Integer -> Integer
forall a. Num a => a -> a
negate (2 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
mb Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 1))
       in  Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkSignedLit Type
ty Type
litTy Integer
mb Integer
minB)
  "Clash.Sized.Internal.Signed.maxBound#"
    | Just (litTy :: Type
litTy,mb :: Integer
mb) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    -> let maxB :: Integer
maxB = (2 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
mb Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 1)) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 1
       in Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkSignedLit Type
ty Type
litTy Integer
mb Integer
maxB)

-- Num
  "Clash.Sized.Internal.Signed.+#"
    | Just (_, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just val :: Term
val <- Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Maybe Term)
-> Maybe Term
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn ((Signed n -> Signed n -> Signed n)
-> Type -> TyConMap -> [Type] -> [Value] -> Proxy n -> Maybe Term
forall (n :: Nat).
KnownNat n =>
(Signed n -> Signed n -> Signed n)
-> Type -> TyConMap -> [Type] -> [Value] -> Proxy n -> Maybe Term
liftSigned2 Signed n -> Signed n -> Signed n
forall (n :: Nat). KnownNat n => Signed n -> Signed n -> Signed n
(Signed.+#) Type
ty TyConMap
tcm [Type]
tys [Value]
args)
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Term
val)
  "Clash.Sized.Internal.Signed.-#"
    | Just (_, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just val :: Term
val <- Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Maybe Term)
-> Maybe Term
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn ((Signed n -> Signed n -> Signed n)
-> Type -> TyConMap -> [Type] -> [Value] -> Proxy n -> Maybe Term
forall (n :: Nat).
KnownNat n =>
(Signed n -> Signed n -> Signed n)
-> Type -> TyConMap -> [Type] -> [Value] -> Proxy n -> Maybe Term
liftSigned2 Signed n -> Signed n -> Signed n
forall (n :: Nat). KnownNat n => Signed n -> Signed n -> Signed n
(Signed.-#) Type
ty TyConMap
tcm [Type]
tys [Value]
args)
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Term
val)
  "Clash.Sized.Internal.Signed.*#"
    | Just (_, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just val :: Term
val <- Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Maybe Term)
-> Maybe Term
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn ((Signed n -> Signed n -> Signed n)
-> Type -> TyConMap -> [Type] -> [Value] -> Proxy n -> Maybe Term
forall (n :: Nat).
KnownNat n =>
(Signed n -> Signed n -> Signed n)
-> Type -> TyConMap -> [Type] -> [Value] -> Proxy n -> Maybe Term
liftSigned2 Signed n -> Signed n -> Signed n
forall (n :: Nat). KnownNat n => Signed n -> Signed n -> Signed n
(Signed.*#) Type
ty TyConMap
tcm [Type]
tys [Value]
args)
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Term
val)
  "Clash.Sized.Internal.Signed.negate#"
    | Just (nTy :: Type
nTy, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , [i :: Integer
i] <- [Value] -> [Integer]
signedLiterals' [Value]
args
    -> let val :: Integer
val = Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Integer) -> Integer
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn (Signed n -> Proxy n -> Integer
forall (n :: Nat). KnownNat n => Signed n -> Proxy n -> Integer
op (Integer -> Signed n
forall a. Num a => Integer -> a
fromInteger Integer
i))
    in Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkSignedLit Type
ty Type
nTy Integer
kn Integer
val)
    where
      op :: KnownNat n => Signed n -> Proxy n -> Integer
      op :: Signed n -> Proxy n -> Integer
op s :: Signed n
s _ = Signed n -> Integer
forall a. Integral a => a -> Integer
toInteger (Signed n -> Signed n
forall (n :: Nat). KnownNat n => Signed n -> Signed n
Signed.negate# Signed n
s)
  "Clash.Sized.Internal.Signed.abs#"
    | Just (nTy :: Type
nTy, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , [i :: Integer
i] <- [Value] -> [Integer]
signedLiterals' [Value]
args
    -> let val :: Integer
val = Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Integer) -> Integer
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn (Signed n -> Proxy n -> Integer
forall (n :: Nat). KnownNat n => Signed n -> Proxy n -> Integer
op (Integer -> Signed n
forall a. Num a => Integer -> a
fromInteger Integer
i))
    in Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkSignedLit Type
ty Type
nTy Integer
kn Integer
val)
    where
      op :: KnownNat n => Signed n -> Proxy n -> Integer
      op :: Signed n -> Proxy n -> Integer
op s :: Signed n
s _ = Signed n -> Integer
forall a. Integral a => a -> Integer
toInteger (Signed n -> Signed n
forall (n :: Nat). KnownNat n => Signed n -> Signed n
Signed.abs# Signed n
s)

-- ExtendingNum
  "Clash.Sized.Internal.Signed.plus#"
    | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
signedLiterals [Value]
args
    -> let ty' :: Type
ty' = TyConMap -> Type -> [Type] -> Type
piResultTys TyConMap
tcm Type
ty [Type]
tys
           (_,resTy :: Type
resTy) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty'
           (TyConApp _ [resSizeTy :: Type
resSizeTy]) = Type -> TypeView
tyView Type
resTy
           Right resSizeInt :: Integer
resSizeInt = Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
resSizeTy)
       in  Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkSignedLit Type
resTy Type
resSizeTy Integer
resSizeInt (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
j))

  "Clash.Sized.Internal.Signed.minus#"
    | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
signedLiterals [Value]
args
    -> let ty' :: Type
ty' = TyConMap -> Type -> [Type] -> Type
piResultTys TyConMap
tcm Type
ty [Type]
tys
           (_,resTy :: Type
resTy) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty'
           (TyConApp _ [resSizeTy :: Type
resSizeTy]) = Type -> TypeView
tyView Type
resTy
           Right resSizeInt :: Integer
resSizeInt = Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
resSizeTy)
       in  Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkSignedLit Type
resTy Type
resSizeTy Integer
resSizeInt (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
j))

  "Clash.Sized.Internal.Signed.times#"
    | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
signedLiterals [Value]
args
    -> let ty' :: Type
ty' = TyConMap -> Type -> [Type] -> Type
piResultTys TyConMap
tcm Type
ty [Type]
tys
           (_,resTy :: Type
resTy) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty'
           (TyConApp _ [resSizeTy :: Type
resSizeTy]) = Type -> TypeView
tyView Type
resTy
           Right resSizeInt :: Integer
resSizeInt = Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
resSizeTy)
       in  Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkSignedLit Type
resTy Type
resSizeTy Integer
resSizeInt (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
j))

-- Integral
  "Clash.Sized.Internal.Signed.quot#"
    | Just (_, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just val :: Term
val <- Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Maybe Term)
-> Maybe Term
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn ((Signed n -> Signed n -> Signed n)
-> Type -> TyConMap -> [Type] -> [Value] -> Proxy n -> Maybe Term
forall (n :: Nat).
KnownNat n =>
(Signed n -> Signed n -> Signed n)
-> Type -> TyConMap -> [Type] -> [Value] -> Proxy n -> Maybe Term
liftSigned2 (Signed n -> Signed n -> Signed n
forall (n :: Nat). Signed n -> Signed n -> Signed n
Signed.quot#) Type
ty TyConMap
tcm [Type]
tys [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 Term
val
  "Clash.Sized.Internal.Signed.rem#"
    | Just (_, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just val :: Term
val <- Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Maybe Term)
-> Maybe Term
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn ((Signed n -> Signed n -> Signed n)
-> Type -> TyConMap -> [Type] -> [Value] -> Proxy n -> Maybe Term
forall (n :: Nat).
KnownNat n =>
(Signed n -> Signed n -> Signed n)
-> Type -> TyConMap -> [Type] -> [Value] -> Proxy n -> Maybe Term
liftSigned2 (Signed n -> Signed n -> Signed n
forall (n :: Nat). Signed n -> Signed n -> Signed n
Signed.rem#) Type
ty TyConMap
tcm [Type]
tys [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 Term
val
  "Clash.Sized.Internal.Signed.div#"
    | Just (_, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just val :: Term
val <- Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Maybe Term)
-> Maybe Term
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn ((Signed n -> Signed n -> Signed n)
-> Type -> TyConMap -> [Type] -> [Value] -> Proxy n -> Maybe Term
forall (n :: Nat).
KnownNat n =>
(Signed n -> Signed n -> Signed n)
-> Type -> TyConMap -> [Type] -> [Value] -> Proxy n -> Maybe Term
liftSigned2 (Signed n -> Signed n -> Signed n
forall (n :: Nat). Signed n -> Signed n -> Signed n
Signed.div#) Type
ty TyConMap
tcm [Type]
tys [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 Term
val
  "Clash.Sized.Internal.Signed.mod#"
    | Just (_, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just val :: Term
val <- Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Maybe Term)
-> Maybe Term
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn ((Signed n -> Signed n -> Signed n)
-> Type -> TyConMap -> [Type] -> [Value] -> Proxy n -> Maybe Term
forall (n :: Nat).
KnownNat n =>
(Signed n -> Signed n -> Signed n)
-> Type -> TyConMap -> [Type] -> [Value] -> Proxy n -> Maybe Term
liftSigned2 (Signed n -> Signed n -> Signed n
forall (n :: Nat). Signed n -> Signed n -> Signed n
Signed.mod#) Type
ty TyConMap
tcm [Type]
tys [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 Term
val
  "Clash.Sized.Internal.Signed.toInteger#"
    | [PrimVal nm' :: Text
nm' _ _ [_, Lit (IntegerLiteral i :: Integer
i)]] <- [Value]
args
    , Text
nm' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "Clash.Sized.Internal.Signed.fromInteger#"
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Integer -> Term
integerToIntegerLiteral Integer
i)

-- Bits
  "Clash.Sized.Internal.Signed.and#"
    | [i :: Integer
i,j :: Integer
j] <- [Value] -> [Integer]
signedLiterals' [Value]
args
    , Just (nTy :: Type
nTy, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkSignedLit Type
ty Type
nTy Integer
kn (Integer
i Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
j))
  "Clash.Sized.Internal.Signed.or#"
    | [i :: Integer
i,j :: Integer
j] <- [Value] -> [Integer]
signedLiterals' [Value]
args
    , Just (nTy :: Type
nTy, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkSignedLit Type
ty Type
nTy Integer
kn (Integer
i Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer
j))
  "Clash.Sized.Internal.Signed.xor#"
    | [i :: Integer
i,j :: Integer
j] <- [Value] -> [Integer]
signedLiterals' [Value]
args
    , Just (nTy :: Type
nTy, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkSignedLit Type
ty Type
nTy Integer
kn (Integer
i Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
`xor` Integer
j))

  "Clash.Sized.Internal.Signed.complement#"
    | [i :: Integer
i] <- [Value] -> [Integer]
signedLiterals' [Value]
args
    , Just (nTy :: Type
nTy, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    -> let val :: Integer
val = Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Integer) -> Integer
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn (Signed n -> Proxy n -> Integer
forall (n :: Nat). KnownNat n => Signed n -> Proxy n -> Integer
op (Integer -> Signed n
forall a. Num a => Integer -> a
fromInteger Integer
i))
    in Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkSignedLit Type
ty Type
nTy Integer
kn Integer
val)
    where
      op :: KnownNat n => Signed n -> Proxy n -> Integer
      op :: Signed n -> Proxy n -> Integer
op u :: Signed n
u _ = Signed n -> Integer
forall a. Integral a => a -> Integer
toInteger (Signed n -> Signed n
forall (n :: Nat). KnownNat n => Signed n -> Signed n
Signed.complement# Signed n
u)

  "Clash.Sized.Internal.Signed.shiftL#"
    | Just (nTy :: Type
nTy,kn :: Integer
kn,i :: Integer
i,j :: Integer
j) <- TyConMap
-> [Type] -> [Value] -> Maybe (Type, Integer, Integer, Integer)
signedLitIntLit TyConMap
tcm [Type]
tys [Value]
args
      -> let val :: Integer
val = Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Integer) -> Integer
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn (Signed n -> Int -> Proxy n -> Integer
forall (n :: Nat).
KnownNat n =>
Signed n -> Int -> Proxy n -> Integer
op (Integer -> Signed n
forall a. Num a => Integer -> a
fromInteger Integer
i) (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
j))
      in Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkSignedLit Type
ty Type
nTy Integer
kn Integer
val)
      where
        op :: KnownNat n => Signed n -> Int -> Proxy n -> Integer
        op :: Signed n -> Int -> Proxy n -> Integer
op u :: Signed n
u i :: Int
i _ = Signed n -> Integer
forall a. Integral a => a -> Integer
toInteger (Signed n -> Int -> Signed n
forall (n :: Nat). KnownNat n => Signed n -> Int -> Signed n
Signed.shiftL# Signed n
u Int
i)
  "Clash.Sized.Internal.Signed.shiftR#"
    | Just (nTy :: Type
nTy,kn :: Integer
kn,i :: Integer
i,j :: Integer
j) <- TyConMap
-> [Type] -> [Value] -> Maybe (Type, Integer, Integer, Integer)
signedLitIntLit TyConMap
tcm [Type]
tys [Value]
args
      -> let val :: Integer
val = Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Integer) -> Integer
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn (Signed n -> Int -> Proxy n -> Integer
forall (n :: Nat).
KnownNat n =>
Signed n -> Int -> Proxy n -> Integer
op (Integer -> Signed n
forall a. Num a => Integer -> a
fromInteger Integer
i) (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
j))
      in Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkSignedLit Type
ty Type
nTy Integer
kn Integer
val)
      where
        op :: KnownNat n => Signed n -> Int -> Proxy n -> Integer
        op :: Signed n -> Int -> Proxy n -> Integer
op u :: Signed n
u i :: Int
i _ = Signed n -> Integer
forall a. Integral a => a -> Integer
toInteger (Signed n -> Int -> Signed n
forall (n :: Nat). KnownNat n => Signed n -> Int -> Signed n
Signed.shiftR# Signed n
u Int
i)
  "Clash.Sized.Internal.Signed.rotateL#"
    | Just (nTy :: Type
nTy,kn :: Integer
kn,i :: Integer
i,j :: Integer
j) <- TyConMap
-> [Type] -> [Value] -> Maybe (Type, Integer, Integer, Integer)
signedLitIntLit TyConMap
tcm [Type]
tys [Value]
args
      -> let val :: Integer
val = Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Integer) -> Integer
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn (Signed n -> Int -> Proxy n -> Integer
forall (n :: Nat).
KnownNat n =>
Signed n -> Int -> Proxy n -> Integer
op (Integer -> Signed n
forall a. Num a => Integer -> a
fromInteger Integer
i) (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
j))
      in Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkSignedLit Type
ty Type
nTy Integer
kn Integer
val)
      where
        op :: KnownNat n => Signed n -> Int -> Proxy n -> Integer
        op :: Signed n -> Int -> Proxy n -> Integer
op u :: Signed n
u i :: Int
i _ = Signed n -> Integer
forall a. Integral a => a -> Integer
toInteger (Signed n -> Int -> Signed n
forall (n :: Nat). KnownNat n => Signed n -> Int -> Signed n
Signed.rotateL# Signed n
u Int
i)
  "Clash.Sized.Internal.Signed.rotateR#"
    | Just (nTy :: Type
nTy,kn :: Integer
kn,i :: Integer
i,j :: Integer
j) <- TyConMap
-> [Type] -> [Value] -> Maybe (Type, Integer, Integer, Integer)
signedLitIntLit TyConMap
tcm [Type]
tys [Value]
args
      -> let val :: Integer
val = Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Integer) -> Integer
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn (Signed n -> Int -> Proxy n -> Integer
forall (n :: Nat).
KnownNat n =>
Signed n -> Int -> Proxy n -> Integer
op (Integer -> Signed n
forall a. Num a => Integer -> a
fromInteger Integer
i) (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
j))
      in Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkSignedLit Type
ty Type
nTy Integer
kn Integer
val)
      where
        op :: KnownNat n => Signed n -> Int -> Proxy n -> Integer
        op :: Signed n -> Int -> Proxy n -> Integer
op u :: Signed n
u i :: Int
i _ = Signed n -> Integer
forall a. Integral a => a -> Integer
toInteger (Signed n -> Int -> Signed n
forall (n :: Nat). KnownNat n => Signed n -> Int -> Signed n
Signed.rotateR# Signed n
u Int
i)

-- Resize
  "Clash.Sized.Internal.Signed.resize#" -- forall m n. (KnownNat n, KnownNat m) => Signed n -> Signed m
    | mTy :: Type
mTy : nTy :: Type
nTy : _ <- [Type]
tys
    , Right mInt :: Integer
mInt <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
mTy)
    , Right nInt :: Integer
nInt <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
nTy)
    , [i :: Integer
i] <- [Value] -> [Integer]
signedLiterals' [Value]
args
    -> let val :: Integer
val | Integer
nInt Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
mInt = Integer
extended
               | Bool
otherwise    = Integer
truncated
           extended :: Integer
extended  = Integer
i
           mask :: Integer
mask      = 1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer
mInt Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 1)
           i' :: Integer
i'        = Integer
i Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
mask
           truncated :: Integer
truncated = if Integer -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Integer
i (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
nInt Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
                          then (Integer
i' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
mask)
                          else Integer
i'
       in Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkSignedLit Type
ty Type
mTy Integer
mInt Integer
val)
  "Clash.Sized.Internal.Signed.truncateB#" -- KnownNat m => Signed (m + n) -> Signed m
    | Just (mTy :: Type
mTy, km :: Integer
km) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , [i :: Integer
i] <- [Value] -> [Integer]
signedLiterals' [Value]
args
    -> let bitsKeep :: Integer
bitsKeep = (Int -> Integer
forall a. Bits a => Int -> a
bit (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
km)) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 1
           val :: Integer
val = Integer
i Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
bitsKeep
    in Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkSignedLit Type
ty Type
mTy Integer
km Integer
val)

-- SaturatingNum
-- No need to manually evaluate Clash.Sized.Internal.Signed.minBoundSym#
-- It is just implemented in terms of other primitives.


-----------
-- Unsigned
-----------
  "Clash.Sized.Internal.Unsigned.size#"
    | Just (_, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    -> let (_,ty' :: Type
ty') = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (TyConApp intTcNm :: TyConName
intTcNm _) = Type -> TypeView
tyView 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
           [intCon :: DataCon
intCon] = TyCon -> [DataCon]
tyConDataCons TyCon
intTc
       in  Term -> Maybe (Heap, Stack, Term)
reduce (Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
intCon) [Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
IntLiteral Integer
kn))])

-- BitPack
  "Clash.Sized.Internal.Unsigned.pack#"
    | Just (nTy :: Type
nTy, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , [i :: Integer
i] <- [Value] -> [Integer]
unsignedLiterals' [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Integer -> Term
mkBitVectorLit Type
ty Type
nTy Integer
kn 0 Integer
i)
  "Clash.Sized.Internal.Unsigned.unpack#"
    | Just (nTy :: Type
nTy, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , [i :: (Integer, Integer)
i] <- [Value] -> [(Integer, Integer)]
bitVectorLiterals' [Value]
args
    -> let val :: Integer
val = Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Integer) -> Integer
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn (BitVector n -> Proxy n -> Integer
forall (n :: Nat). KnownNat n => BitVector n -> Proxy n -> Integer
op ((Integer, Integer) -> BitVector n
forall (n :: Nat). (Integer, Integer) -> BitVector n
toBV (Integer, Integer)
i))
    in Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkUnsignedLit Type
ty Type
nTy Integer
kn Integer
val)
    where
      op :: KnownNat n => BitVector n -> Proxy n -> Integer
      op :: BitVector n -> Proxy n -> Integer
op u :: BitVector n
u _ = Unsigned n -> Integer
forall a. Integral a => a -> Integer
toInteger (BitVector n -> Unsigned n
forall (n :: Nat). KnownNat n => BitVector n -> Unsigned n
Unsigned.unpack# BitVector n
u)

-- Eq
  "Clash.Sized.Internal.Unsigned.eq#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
unsignedLiterals [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))
  "Clash.Sized.Internal.Unsigned.neq#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
unsignedLiterals [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))

-- Ord
  "Clash.Sized.Internal.Unsigned.lt#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
unsignedLiterals [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))
  "Clash.Sized.Internal.Unsigned.ge#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
unsignedLiterals [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))
  "Clash.Sized.Internal.Unsigned.gt#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
unsignedLiterals [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))
  "Clash.Sized.Internal.Unsigned.le#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
unsignedLiterals [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))

-- Bounded
  "Clash.Sized.Internal.Unsigned.minBound#"
    | Just (nTy :: Type
nTy,len :: Integer
len) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkUnsignedLit Type
ty Type
nTy Integer
len 0)
  "Clash.Sized.Internal.Unsigned.maxBound#"
    | Just (litTy :: Type
litTy,mb :: Integer
mb) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    -> let maxB :: Integer
maxB = (2 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
mb) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 1
       in  Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkUnsignedLit Type
ty Type
litTy Integer
mb Integer
maxB)

-- Num
  "Clash.Sized.Internal.Unsigned.+#"
    | Just (_, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just val :: Term
val <- Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Maybe Term)
-> Maybe Term
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn ((Unsigned n -> Unsigned n -> Unsigned n)
-> Type -> TyConMap -> [Type] -> [Value] -> Proxy n -> Maybe Term
forall (n :: Nat).
KnownNat n =>
(Unsigned n -> Unsigned n -> Unsigned n)
-> Type -> TyConMap -> [Type] -> [Value] -> Proxy n -> Maybe Term
liftUnsigned2 Unsigned n -> Unsigned n -> Unsigned n
forall (n :: Nat).
KnownNat n =>
Unsigned n -> Unsigned n -> Unsigned n
(Unsigned.+#) Type
ty TyConMap
tcm [Type]
tys [Value]
args)
    -> Term -> Maybe (Heap, Stack, Term)
reduce Term
val
  "Clash.Sized.Internal.Unsigned.-#"
    | Just (_, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just val :: Term
val <- Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Maybe Term)
-> Maybe Term
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn ((Unsigned n -> Unsigned n -> Unsigned n)
-> Type -> TyConMap -> [Type] -> [Value] -> Proxy n -> Maybe Term
forall (n :: Nat).
KnownNat n =>
(Unsigned n -> Unsigned n -> Unsigned n)
-> Type -> TyConMap -> [Type] -> [Value] -> Proxy n -> Maybe Term
liftUnsigned2 Unsigned n -> Unsigned n -> Unsigned n
forall (n :: Nat).
KnownNat n =>
Unsigned n -> Unsigned n -> Unsigned n
(Unsigned.-#) Type
ty TyConMap
tcm [Type]
tys [Value]
args)
    -> Term -> Maybe (Heap, Stack, Term)
reduce Term
val
  "Clash.Sized.Internal.Unsigned.*#"
    | Just (_, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just val :: Term
val <- Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Maybe Term)
-> Maybe Term
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn ((Unsigned n -> Unsigned n -> Unsigned n)
-> Type -> TyConMap -> [Type] -> [Value] -> Proxy n -> Maybe Term
forall (n :: Nat).
KnownNat n =>
(Unsigned n -> Unsigned n -> Unsigned n)
-> Type -> TyConMap -> [Type] -> [Value] -> Proxy n -> Maybe Term
liftUnsigned2 Unsigned n -> Unsigned n -> Unsigned n
forall (n :: Nat).
KnownNat n =>
Unsigned n -> Unsigned n -> Unsigned n
(Unsigned.*#) Type
ty TyConMap
tcm [Type]
tys [Value]
args)
    -> Term -> Maybe (Heap, Stack, Term)
reduce Term
val
  "Clash.Sized.Internal.Unsigned.negate#"
    | Just (nTy :: Type
nTy, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , [i :: Integer
i] <- [Value] -> [Integer]
unsignedLiterals' [Value]
args
    -> let val :: Integer
val = Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Integer) -> Integer
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn (Unsigned n -> Proxy n -> Integer
forall (n :: Nat). KnownNat n => Unsigned n -> Proxy n -> Integer
op (Integer -> Unsigned n
forall a. Num a => Integer -> a
fromInteger Integer
i))
    in Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkUnsignedLit Type
ty Type
nTy Integer
kn Integer
val)
    where
      op :: KnownNat n => Unsigned n -> Proxy n -> Integer
      op :: Unsigned n -> Proxy n -> Integer
op u :: Unsigned n
u _ = Unsigned n -> Integer
forall a. Integral a => a -> Integer
toInteger (Unsigned n -> Unsigned n
forall (n :: Nat). KnownNat n => Unsigned n -> Unsigned n
Unsigned.negate# Unsigned n
u)

-- ExtendingNum
  "Clash.Sized.Internal.Unsigned.plus#" -- :: Unsigned m -> Unsigned n -> Unsigned (Max m n + 1)
    | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
unsignedLiterals [Value]
args
    -> let ty' :: Type
ty' = TyConMap -> Type -> [Type] -> Type
piResultTys TyConMap
tcm Type
ty [Type]
tys
           (_,resTy :: Type
resTy) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty'
           (TyConApp _ [resSizeTy :: Type
resSizeTy]) = Type -> TypeView
tyView Type
resTy
           Right resSizeInt :: Integer
resSizeInt = Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
resSizeTy)
       in  Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkUnsignedLit Type
resTy Type
resSizeTy Integer
resSizeInt (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
j))

  "Clash.Sized.Internal.Unsigned.minus#"
    | [i :: Integer
i,j :: Integer
j] <- [Value] -> [Integer]
unsignedLiterals' [Value]
args
    -> let ty' :: Type
ty' = TyConMap -> Type -> [Type] -> Type
piResultTys TyConMap
tcm Type
ty [Type]
tys
           (_,resTy :: Type
resTy) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty'
           (TyConApp _ [resSizeTy :: Type
resSizeTy]) = Type -> TypeView
tyView Type
resTy
           Right resSizeInt :: Integer
resSizeInt = Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
resSizeTy)
           val :: Integer
val = Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Integer) -> Integer
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
resSizeInt ((Unsigned n -> Unsigned n -> Unsigned n)
-> Integer -> Integer -> Proxy n -> Integer
forall (n :: Nat) (sized :: Nat -> *).
(KnownNat n, Integral (sized n)) =>
(sized n -> sized n -> sized n)
-> Integer -> Integer -> Proxy n -> Integer
runSizedF Unsigned n -> Unsigned n -> Unsigned n
forall (n :: Nat).
KnownNat n =>
Unsigned n -> Unsigned n -> Unsigned n
(Unsigned.-#) Integer
i Integer
j)
      in   Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkUnsignedLit Type
resTy Type
resSizeTy Integer
resSizeInt Integer
val)

  "Clash.Sized.Internal.Unsigned.times#"
    | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
unsignedLiterals [Value]
args
    -> let ty' :: Type
ty' = TyConMap -> Type -> [Type] -> Type
piResultTys TyConMap
tcm Type
ty [Type]
tys
           (_,resTy :: Type
resTy) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty'
           (TyConApp _ [resSizeTy :: Type
resSizeTy]) = Type -> TypeView
tyView Type
resTy
           Right resSizeInt :: Integer
resSizeInt = Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
resSizeTy)
       in  Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkUnsignedLit Type
resTy Type
resSizeTy Integer
resSizeInt (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
j))

-- Integral
  "Clash.Sized.Internal.Unsigned.quot#"
    | Just (_, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just val :: Term
val <- Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Maybe Term)
-> Maybe Term
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn ((Unsigned n -> Unsigned n -> Unsigned n)
-> Type -> TyConMap -> [Type] -> [Value] -> Proxy n -> Maybe Term
forall (n :: Nat).
KnownNat n =>
(Unsigned n -> Unsigned n -> Unsigned n)
-> Type -> TyConMap -> [Type] -> [Value] -> Proxy n -> Maybe Term
liftUnsigned2 (Unsigned n -> Unsigned n -> Unsigned n
forall (n :: Nat). Unsigned n -> Unsigned n -> Unsigned n
Unsigned.quot#) Type
ty TyConMap
tcm [Type]
tys [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 Term
val
  "Clash.Sized.Internal.Unsigned.rem#"
    | Just (_, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just val :: Term
val <- Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Maybe Term)
-> Maybe Term
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn ((Unsigned n -> Unsigned n -> Unsigned n)
-> Type -> TyConMap -> [Type] -> [Value] -> Proxy n -> Maybe Term
forall (n :: Nat).
KnownNat n =>
(Unsigned n -> Unsigned n -> Unsigned n)
-> Type -> TyConMap -> [Type] -> [Value] -> Proxy n -> Maybe Term
liftUnsigned2 (Unsigned n -> Unsigned n -> Unsigned n
forall (n :: Nat). Unsigned n -> Unsigned n -> Unsigned n
Unsigned.rem#) Type
ty TyConMap
tcm [Type]
tys [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 Term
val
  "Clash.Sized.Internal.Unsigned.toInteger#"
    | [PrimVal nm' :: Text
nm' _ _ [_, Lit (IntegerLiteral i :: Integer
i)]] <- [Value]
args
    , Text
nm' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "Clash.Sized.Internal.Unsigned.fromInteger#"
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Integer -> Term
integerToIntegerLiteral Integer
i)

-- Bits
  "Clash.Sized.Internal.Unsigned.and#"
    | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
unsignedLiterals [Value]
args
    , Just (nTy :: Type
nTy, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkUnsignedLit Type
ty Type
nTy Integer
kn (Integer
i Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
j))
  "Clash.Sized.Internal.Unsigned.or#"
    | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
unsignedLiterals [Value]
args
    , Just (nTy :: Type
nTy, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkUnsignedLit Type
ty Type
nTy Integer
kn (Integer
i Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer
j))
  "Clash.Sized.Internal.Unsigned.xor#"
    | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
unsignedLiterals [Value]
args
    , Just (nTy :: Type
nTy, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    -> Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkUnsignedLit Type
ty Type
nTy Integer
kn (Integer
i Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
`xor` Integer
j))

  "Clash.Sized.Internal.Unsigned.complement#"
    | [i :: Integer
i] <- [Value] -> [Integer]
unsignedLiterals' [Value]
args
    , Just (nTy :: Type
nTy, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    -> let val :: Integer
val = Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Integer) -> Integer
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn (Unsigned n -> Proxy n -> Integer
forall (n :: Nat). KnownNat n => Unsigned n -> Proxy n -> Integer
op (Integer -> Unsigned n
forall a. Num a => Integer -> a
fromInteger Integer
i))
    in Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkUnsignedLit Type
ty Type
nTy Integer
kn Integer
val)
    where
      op :: KnownNat n => Unsigned n -> Proxy n -> Integer
      op :: Unsigned n -> Proxy n -> Integer
op u :: Unsigned n
u _ = Unsigned n -> Integer
forall a. Integral a => a -> Integer
toInteger (Unsigned n -> Unsigned n
forall (n :: Nat). KnownNat n => Unsigned n -> Unsigned n
Unsigned.complement# Unsigned n
u)

  "Clash.Sized.Internal.Unsigned.shiftL#" -- :: forall n. KnownNat n => Unsigned n -> Int -> Unsigned n
    | Just (nTy :: Type
nTy,kn :: Integer
kn,i :: Integer
i,j :: Integer
j) <- TyConMap
-> [Type] -> [Value] -> Maybe (Type, Integer, Integer, Integer)
unsignedLitIntLit TyConMap
tcm [Type]
tys [Value]
args
      -> let val :: Integer
val = Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Integer) -> Integer
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn (Unsigned n -> Int -> Proxy n -> Integer
forall (n :: Nat).
KnownNat n =>
Unsigned n -> Int -> Proxy n -> Integer
op (Integer -> Unsigned n
forall a. Num a => Integer -> a
fromInteger Integer
i) (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
j))
      in Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkUnsignedLit Type
ty Type
nTy Integer
kn Integer
val)
      where
        op :: KnownNat n => Unsigned n -> Int -> Proxy n -> Integer
        op :: Unsigned n -> Int -> Proxy n -> Integer
op u :: Unsigned n
u i :: Int
i _ = Unsigned n -> Integer
forall a. Integral a => a -> Integer
toInteger (Unsigned n -> Int -> Unsigned n
forall (n :: Nat). KnownNat n => Unsigned n -> Int -> Unsigned n
Unsigned.shiftL# Unsigned n
u Int
i)
  "Clash.Sized.Internal.Unsigned.shiftR#" -- :: forall n. KnownNat n => Unsigned n -> Int -> Unsigned n
    | Just (nTy :: Type
nTy,kn :: Integer
kn,i :: Integer
i,j :: Integer
j) <- TyConMap
-> [Type] -> [Value] -> Maybe (Type, Integer, Integer, Integer)
unsignedLitIntLit TyConMap
tcm [Type]
tys [Value]
args
      -> let val :: Integer
val = Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Integer) -> Integer
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn (Unsigned n -> Int -> Proxy n -> Integer
forall (n :: Nat).
KnownNat n =>
Unsigned n -> Int -> Proxy n -> Integer
op (Integer -> Unsigned n
forall a. Num a => Integer -> a
fromInteger Integer
i) (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
j))
      in Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkUnsignedLit Type
ty Type
nTy Integer
kn Integer
val)
      where
        op :: KnownNat n => Unsigned n -> Int -> Proxy n -> Integer
        op :: Unsigned n -> Int -> Proxy n -> Integer
op u :: Unsigned n
u i :: Int
i _ = Unsigned n -> Integer
forall a. Integral a => a -> Integer
toInteger (Unsigned n -> Int -> Unsigned n
forall (n :: Nat). KnownNat n => Unsigned n -> Int -> Unsigned n
Unsigned.shiftR# Unsigned n
u Int
i)
  "Clash.Sized.Internal.Unsigned.rotateL#" -- :: forall n. KnownNat n => Unsigned n -> Int -> Unsigned n
    | Just (nTy :: Type
nTy,kn :: Integer
kn,i :: Integer
i,j :: Integer
j) <- TyConMap
-> [Type] -> [Value] -> Maybe (Type, Integer, Integer, Integer)
unsignedLitIntLit TyConMap
tcm [Type]
tys [Value]
args
      -> let val :: Integer
val = Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Integer) -> Integer
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn (Unsigned n -> Int -> Proxy n -> Integer
forall (n :: Nat).
KnownNat n =>
Unsigned n -> Int -> Proxy n -> Integer
op (Integer -> Unsigned n
forall a. Num a => Integer -> a
fromInteger Integer
i) (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
j))
      in Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkUnsignedLit Type
ty Type
nTy Integer
kn Integer
val)
      where
        op :: KnownNat n => Unsigned n -> Int -> Proxy n -> Integer
        op :: Unsigned n -> Int -> Proxy n -> Integer
op u :: Unsigned n
u i :: Int
i _ = Unsigned n -> Integer
forall a. Integral a => a -> Integer
toInteger (Unsigned n -> Int -> Unsigned n
forall (n :: Nat). KnownNat n => Unsigned n -> Int -> Unsigned n
Unsigned.rotateL# Unsigned n
u Int
i)
  "Clash.Sized.Internal.Unsigned.rotateR#" -- :: forall n. KnownNat n => Unsigned n -> Int -> Unsigned n
    | Just (nTy :: Type
nTy,kn :: Integer
kn,i :: Integer
i,j :: Integer
j) <- TyConMap
-> [Type] -> [Value] -> Maybe (Type, Integer, Integer, Integer)
unsignedLitIntLit TyConMap
tcm [Type]
tys [Value]
args
      -> let val :: Integer
val = Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> Integer) -> Integer
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn (Unsigned n -> Int -> Proxy n -> Integer
forall (n :: Nat).
KnownNat n =>
Unsigned n -> Int -> Proxy n -> Integer
op (Integer -> Unsigned n
forall a. Num a => Integer -> a
fromInteger Integer
i) (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
j))
      in Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkUnsignedLit Type
ty Type
nTy Integer
kn Integer
val)
      where
        op :: KnownNat n => Unsigned n -> Int -> Proxy n -> Integer
        op :: Unsigned n -> Int -> Proxy n -> Integer
op u :: Unsigned n
u i :: Int
i _ = Unsigned n -> Integer
forall a. Integral a => a -> Integer
toInteger (Unsigned n -> Int -> Unsigned n
forall (n :: Nat). KnownNat n => Unsigned n -> Int -> Unsigned n
Unsigned.rotateR# Unsigned n
u Int
i)

-- Resize
  "Clash.Sized.Internal.Unsigned.resize#" -- forall n m . KnownNat m => Unsigned n -> Unsigned m
    | _ : mTy :: Type
mTy : _ <- [Type]
tys
    , Right km :: Integer
km <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
mTy)
    , [i :: Integer
i] <- [Value] -> [Integer]
unsignedLiterals' [Value]
args
    -> let bitsKeep :: Integer
bitsKeep = (Int -> Integer
forall a. Bits a => Int -> a
bit (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
km)) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 1
           val :: Integer
val = Integer
i Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
bitsKeep
    in Term -> Maybe (Heap, Stack, Term)
reduce (Type -> Type -> Integer -> Integer -> Term
mkUnsignedLit Type
ty Type
mTy Integer
km Integer
val)

  "Clash.Annotations.BitRepresentation.Deriving.dontApplyInHDL"
    | Bool
isSubj
    , f :: Value
f : a :: Value
a : _ <- [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduceWHNF (Term -> [Either Term Type] -> Term
mkApps (Value -> Term
valToTerm Value
f) [Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
a)])

--------
-- RTree
--------
  "Clash.Sized.RTree.textract"
    | Bool
isSubj
    , [DC _ tArgs :: [Either Term Type]
tArgs] <- [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduceWHNF ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
tArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 1)

  "Clash.Sized.RTree.tsplit"
    | Bool
isSubj
    , dTy :: Type
dTy : aTy :: Type
aTy : _ <- [Type]
tys
    , [DC _ tArgs :: [Either Term Type]
tArgs] <- [Value]
args
    , (tyArgs :: [Either TyVar Type]
tyArgs,Type -> TypeView
tyView -> TyConApp tupTcNm :: TyConName
tupTcNm _) <- Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
    , TyConApp treeTcNm :: TyConName
treeTcNm _ <- Type -> TypeView
tyView ([Either TyVar Type] -> [Type]
forall a b. [Either a b] -> [b]
Either.rights [Either TyVar Type]
tyArgs [Type] -> Int -> Type
forall a. [a] -> Int -> a
!! 0)
    -> let (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
       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
forall a b. b -> Either a b
Right (TyConName -> [Type] -> Type
mkTyConApp TyConName
treeTcNm [Type
dTy,Type
aTy])
                  ,Type -> Either Term Type
forall a b. b -> Either a b
Right (TyConName -> [Type] -> Type
mkTyConApp TyConName
treeTcNm [Type
dTy,Type
aTy])
                  ,Term -> Either Term Type
forall a b. a -> Either a b
Left ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
tArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 1)
                  ,Term -> Either Term Type
forall a b. a -> Either a b
Left ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
tArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 2)
                  ]

  "Clash.Sized.RTree.tdfold"
    | Bool
isSubj
    , pTy :: Type
pTy : kTy :: Type
kTy : aTy :: Type
aTy : _ <- [Type]
tys
    , _ : p :: Value
p : f :: Value
f : g :: Value
g : ts :: Value
ts : _ <- [Value]
args
    , DC _ tArgs :: [Either Term Type]
tArgs <- Value
ts
    , Right k' :: Integer
k' <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
kTy)
    -> case Integer
k' of
         0 -> Term -> Maybe (Heap, Stack, Term)
reduceWHNF (Term -> [Either Term Type] -> Term
mkApps (Value -> Term
valToTerm Value
f) [Term -> Either Term Type
forall a b. a -> Either a b
Left ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
tArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 1)])
         _ -> let k'ty :: Type
k'ty = LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
k'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1))
                  (tyArgs :: [Either TyVar Type]
tyArgs,_)  = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
                  (tyArgs' :: [Either TyVar Type]
tyArgs',_) = Type -> ([Either TyVar Type], Type)
splitFunForallTy ([Either TyVar Type] -> [Type]
forall a b. [Either a b] -> [b]
Either.rights [Either TyVar Type]
tyArgs [Type] -> Int -> Type
forall a. [a] -> Int -> a
!! 3)
                  TyConApp snatTcNm :: TyConName
snatTcNm _ = Type -> TypeView
tyView ([Either TyVar Type] -> [Type]
forall a b. [Either a b] -> [b]
Either.rights [Either TyVar Type]
tyArgs' [Type] -> Int -> Type
forall a. [a] -> Int -> a
!! 0)
                  Just snatTc :: TyCon
snatTc = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
snatTcNm TyConMap
tcm
                  [snatDc :: DataCon
snatDc]    = TyCon -> [DataCon]
tyConDataCons TyCon
snatTc
              in  Term -> Maybe (Heap, Stack, Term)
reduceWHNF (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$
                  Term -> [Either Term Type] -> Term
mkApps (Value -> Term
valToTerm Value
g)
                         [Type -> Either Term Type
forall a b. b -> Either a b
Right Type
k'ty
                         ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
snatDc)
                                       [Type -> Either Term Type
forall a b. b -> Either a b
Right Type
k'ty
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
NaturalLiteral (Integer
k'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))])
                         ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> [Either Term Type] -> Term
mkApps (Text -> PrimInfo -> Term
Prim Text
nm PrimInfo
pInfo)
                                       [Type -> Either Term Type
forall a b. b -> Either a b
Right Type
pTy
                                       ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
k'ty
                                       ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
NaturalLiteral (Integer
k'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
p)
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
f)
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
g)
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
tArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 1)
                                       ])
                         ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> [Either Term Type] -> Term
mkApps (Text -> PrimInfo -> Term
Prim Text
nm PrimInfo
pInfo)
                                       [Type -> Either Term Type
forall a b. b -> Either a b
Right Type
pTy
                                       ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
k'ty
                                       ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
NaturalLiteral (Integer
k'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
p)
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
f)
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
g)
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
tArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 2)
                                       ])
                         ]

  "Clash.Sized.RTree.treplicate"
    | Bool
isSubj
    , let ty' :: Type
ty' = TyConMap -> Type -> [Type] -> Type
piResultTys TyConMap
tcm Type
ty [Type]
tys
    , (_,Type -> TypeView
tyView -> TyConApp treeTcNm :: TyConName
treeTcNm [lenTy :: Type
lenTy,argTy :: Type
argTy]) <- Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty'
    , Right len :: Integer
len <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
lenTy)
    -> let (Just treeTc :: TyCon
treeTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
treeTcNm TyConMap
tcm
           [lrCon :: DataCon
lrCon,brCon :: DataCon
brCon] = TyCon -> [DataCon]
tyConDataCons TyCon
treeTc
       in  Term -> Maybe (Heap, Stack, Term)
reduce (DataCon -> DataCon -> Type -> Integer -> [Term] -> Term
mkRTree DataCon
lrCon DataCon
brCon Type
argTy Integer
len (Int -> Term -> [Term]
forall a. Int -> a -> [a]
replicate (2Int -> Integer -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
len) (Value -> Term
valToTerm ([Value] -> Value
forall a. [a] -> a
last [Value]
args))))

---------
-- Vector
---------
  "Clash.Sized.Vector.length" -- :: KnownNat n => Vec n a -> Int
    | Bool
isSubj
    , [nTy :: Type
nTy, _] <- [Type]
tys
    , Right n :: Integer
n <-Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> 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
           [intCon :: DataCon
intCon] = TyCon -> [DataCon]
tyConDataCons TyCon
intTc
       in  Term -> Maybe (Heap, Stack, Term)
reduce (Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
intCon) [Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
IntLiteral (Integer -> Integer
forall a. Integral a => a -> Integer
toInteger Integer
n)))])

  "Clash.Sized.Vector.maxIndex"
    | Bool
isSubj
    , [nTy :: Type
nTy, _] <- [Type]
tys
    , Right n :: Integer
n <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> 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
           [intCon :: DataCon
intCon] = TyCon -> [DataCon]
tyConDataCons TyCon
intTc
       in  Term -> Maybe (Heap, Stack, Term)
reduce (Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
intCon) [Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
IntLiteral (Integer -> Integer
forall a. Integral a => a -> Integer
toInteger (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 1))))])

-- Indexing
  "Clash.Sized.Vector.index_int" -- :: KnownNat n => Vec n a -> Int
    | nTy :: Type
nTy : aTy :: Type
aTy : _  <- [Type]
tys
    , _ : xs :: Value
xs : i :: Value
i : _ <- [Value]
args
    , DC intDc :: DataCon
intDc [Left (Literal (IntLiteral i' :: Integer
i'))] <- Value
i
    -> if Integer
i' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 0
          then Maybe (Heap, Stack, Term)
forall a. Maybe a
Nothing
          else case Value
xs of
                 DC _ vArgs :: [Either Term Type]
vArgs  -> case Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
nTy) of
                    Right 0  -> Maybe (Heap, Stack, Term)
forall a. Maybe a
Nothing
                    Right n' :: Integer
n' ->
                      if Integer
i' Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 0
                         then Term -> Maybe (Heap, Stack, Term)
reduceWHNF ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 1)
                         else Term -> Maybe (Heap, Stack, Term)
reduceWHNF (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$
                              Term -> [Either Term Type] -> Term
mkApps (Text -> PrimInfo -> Term
Prim Text
nm PrimInfo
pInfo)
                                     [Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
n'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                                     ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
                                     ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
NaturalLiteral (Integer
n'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                                     ,Term -> Either Term Type
forall a b. a -> Either a b
Left ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 2)
                                     ,Term -> Either Term Type
forall a b. a -> Either a b
Left (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'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))])
                                     ]
                    _ -> Maybe (Heap, Stack, Term)
forall a. Maybe a
Nothing
                 _ -> Maybe (Heap, Stack, Term)
forall a. Maybe a
Nothing
  "Clash.Sized.Vector.head" -- :: Vec (n+1) a -> a
    | Bool
isSubj
    , [DC _ vArgs :: [Either Term Type]
vArgs] <- [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduceWHNF ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 1)
  "Clash.Sized.Vector.last" -- :: Vec (n+1) a -> a
    | Bool
isSubj
    , [DC _ vArgs :: [Either Term Type]
vArgs] <- [Value]
args
    , (Right _ : Right aTy :: Type
aTy : Right nTy :: Type
nTy : _) <- [Either Term Type]
vArgs
    , Right n :: Integer
n <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> if Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 0
          then Term -> Maybe (Heap, Stack, Term)
reduceWHNF ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 1)
          else Term -> Maybe (Heap, Stack, Term)
reduceWHNF
                (Term -> [Either Term Type] -> Term
mkApps (Text -> PrimInfo -> Term
Prim Text
nm PrimInfo
pInfo)
                                     [Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                                     ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
                                     ,Term -> Either Term Type
forall a b. a -> Either a b
Left ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 2)
                                     ])
-- - Sub-vectors
  "Clash.Sized.Vector.tail" -- :: Vec (n+1) a -> Vec n a
    | Bool
isSubj
    , [DC _ vArgs :: [Either Term Type]
vArgs] <- [Value]
args
    -> Term -> Maybe (Heap, Stack, Term)
reduceWHNF ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 2)
  "Clash.Sized.Vector.init" -- :: Vec (n+1) a -> Vec n a
    | Bool
isSubj
    , [DC consCon :: DataCon
consCon vArgs :: [Either Term Type]
vArgs] <- [Value]
args
    , (Right _ : Right aTy :: Type
aTy : Right nTy :: Type
nTy : _) <- [Either Term Type]
vArgs
    , Right n :: Integer
n <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> if Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 0
          then Term -> Maybe (Heap, Stack, Term)
reduceWHNF ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 2)
          else Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$
               DataCon -> Type -> Integer -> Term -> Term -> Term
mkVecCons DataCon
consCon Type
aTy Integer
n
                  ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 1)
                  (Term -> [Either Term Type] -> Term
mkApps (Text -> PrimInfo -> Term
Prim Text
nm PrimInfo
pInfo)
                                       [Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                                       ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 2)])
  "Clash.Sized.Vector.select" -- :: (CmpNat (i+s) (s*n) ~ GT) => SNat f -> SNat s -> SNat n -> Vec (f + i) a -> Vec n a
    | Bool
isSubj
    , iTy :: Type
iTy : sTy :: Type
sTy : nTy :: Type
nTy : fTy :: Type
fTy : aTy :: Type
aTy : _ <- [Type]
tys
    , eq :: Value
eq : f :: Value
f : s :: Value
s : n :: Value
n : xs :: Value
xs : _ <- [Value]
args
    , Right n' :: Integer
n' <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
nTy)
    , Right f' :: Integer
f' <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
fTy)
    , Right i' :: Integer
i' <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
iTy)
    , Right s' :: Integer
s' <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
sTy)
    , DC _ vArgs :: [Either Term Type]
vArgs <- Value
xs
    -> case Integer
n' of
         0 -> Term -> Maybe (Heap, Stack, Term)
reduce (DataCon -> Type -> Term
mkVecNil DataCon
nilCon Type
aTy)
         _ -> case Integer
f' of
          0 -> let splitAtCall :: Term
splitAtCall =
                    Term -> [Either Term Type] -> Term
mkApps (TyConName -> TyConName -> Term
splitAtPrim TyConName
snatTcNm TyConName
vecTcNm)
                           [Type -> Either Term Type
forall a b. b -> Either a b
Right Type
sTy
                           ,Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
i'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
s')))
                           ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
                           ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
s)
                           ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
xs)
                           ]
                   fVecTy :: Type
fVecTy = TyConName -> [Type] -> Type
mkTyConApp TyConName
vecTcNm [Type
sTy,Type
aTy]
                   iVecTy :: Type
iVecTy = TyConName -> [Type] -> Type
mkTyConApp TyConName
vecTcNm [LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
i'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
s')),Type
aTy]
                   -- Guaranteed no capture, so okay to use unsafe name generation
                   fNm :: Name a
fNm    = Text -> Int -> Name a
forall a. Text -> Int -> Name a
mkUnsafeSystemName "fxs" 0
                   iNm :: Name a
iNm    = Text -> Int -> Name a
forall a. Text -> Int -> Name a
mkUnsafeSystemName "ixs" 1
                   fId :: Id
fId    = Type -> TmName -> Id
mkLocalId Type
fVecTy TmName
forall a. Name a
fNm
                   iId :: Id
iId    = Type -> TmName -> Id
mkLocalId Type
iVecTy TmName
forall a. Name a
iNm
                   tupPat :: Pat
tupPat = DataCon -> [TyVar] -> [Id] -> Pat
DataPat DataCon
tupDc [] [Id
fId,Id
iId]
                   iAlt :: (Pat, Term)
iAlt   = (Pat
tupPat, (Id -> Term
Var Id
iId))
               in  Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$
                   DataCon -> Type -> Integer -> Term -> Term -> Term
mkVecCons DataCon
consCon Type
aTy Integer
n' ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 1) (Term -> Term) -> Term -> Term
forall a b. (a -> b) -> a -> b
$
                   Term -> [Either Term Type] -> Term
mkApps (Text -> PrimInfo -> Term
Prim Text
nm PrimInfo
pInfo)
                          [Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
i'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
s')))
                          ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
sTy
                          ,Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
n'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                          ,Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy 0))
                          ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
                          ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
eq)
                          ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
NaturalLiteral 0))
                          ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
s)
                          ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
NaturalLiteral (Integer
n'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                          ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> Type -> [(Pat, Term)] -> Term
Case Term
splitAtCall Type
iVecTy [(Pat, Term)
iAlt])
                          ]
          _ -> let splitAtCall :: Term
splitAtCall =
                    Term -> [Either Term Type] -> Term
mkApps (TyConName -> TyConName -> Term
splitAtPrim TyConName
snatTcNm TyConName
vecTcNm)
                           [Type -> Either Term Type
forall a b. b -> Either a b
Right Type
fTy
                           ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
iTy
                           ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
                           ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
f)
                           ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
xs)
                           ]
                   fVecTy :: Type
fVecTy = TyConName -> [Type] -> Type
mkTyConApp TyConName
vecTcNm [Type
fTy,Type
aTy]
                   iVecTy :: Type
iVecTy = TyConName -> [Type] -> Type
mkTyConApp TyConName
vecTcNm [Type
iTy,Type
aTy]
                   -- Guaranteed no capture, so okay to use unsafe name generation
                   fNm :: Name a
fNm    = Text -> Int -> Name a
forall a. Text -> Int -> Name a
mkUnsafeSystemName "fxs" 0
                   iNm :: Name a
iNm    = Text -> Int -> Name a
forall a. Text -> Int -> Name a
mkUnsafeSystemName "ixs" 1
                   fId :: Id
fId    = Type -> TmName -> Id
mkLocalId Type
fVecTy TmName
forall a. Name a
fNm
                   iId :: Id
iId    = Type -> TmName -> Id
mkLocalId Type
iVecTy TmName
forall a. Name a
iNm
                   tupPat :: Pat
tupPat = DataCon -> [TyVar] -> [Id] -> Pat
DataPat DataCon
tupDc [] [Id
fId,Id
iId]
                   iAlt :: (Pat, Term)
iAlt   = (Pat
tupPat, (Id -> Term
Var Id
iId))
               in  Term -> Maybe (Heap, Stack, Term)
reduceWHNF (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$
                   Term -> [Either Term Type] -> Term
mkApps (Text -> PrimInfo -> Term
Prim Text
nm PrimInfo
pInfo)
                     [Type -> Either Term Type
forall a b. b -> Either a b
Right Type
iTy
                     ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
sTy
                     ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
nTy
                     ,Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy 0))
                     ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
                     ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
eq)
                     ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
NaturalLiteral 0))
                     ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
s)
                     ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
n)
                     ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> Type -> [(Pat, Term)] -> Term
Case Term
splitAtCall Type
iVecTy [(Pat, Term)
iAlt])
                     ]
    where
      (tyArgs :: [Either TyVar Type]
tyArgs,Type -> TypeView
tyView -> TyConApp vecTcNm :: TyConName
vecTcNm _) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
      Just vecTc :: TyCon
vecTc          = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
vecTcNm TyConMap
tcm
      [nilCon :: DataCon
nilCon,consCon :: DataCon
consCon]    = TyCon -> [DataCon]
tyConDataCons TyCon
vecTc
      TyConApp snatTcNm :: TyConName
snatTcNm _ = Type -> TypeView
tyView ([Either TyVar Type] -> [Type]
forall a b. [Either a b] -> [b]
Either.rights [Either TyVar Type]
tyArgs [Type] -> Int -> Type
forall a. [a] -> Int -> a
!! 1)
      tupTcNm :: TyConName
tupTcNm            = TyCon -> TyConName
ghcTyconToTyConName (Boxity -> Int -> TyCon
tupleTyCon Boxity
Boxed 2)
      (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
-- - Splitting
  "Clash.Sized.Vector.splitAt" -- :: SNat m -> Vec (m + n) a -> (Vec m a, Vec n a)
    | Bool
isSubj
    , DC snatDc :: DataCon
snatDc (Right mTy :: Type
mTy:_) <- [Value] -> Value
forall a. [a] -> a
head [Value]
args
    , Right m :: Integer
m <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
mTy)
    -> let _:nTy :: Type
nTy:aTy :: Type
aTy:_ = [Type]
tys
           -- Get the tuple data-constructor
           ty1 :: Type
ty1 = TyConMap -> Type -> [Type] -> Type
piResultTys TyConMap
tcm Type
ty [Type]
tys
           (_,Type -> TypeView
tyView -> TyConApp tupTcNm :: TyConName
tupTcNm tyArgs :: [Type]
tyArgs) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty1
           (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
           -- Get the vector data-constructors
           TyConApp vecTcNm :: TyConName
vecTcNm _ = Type -> TypeView
tyView ([Type] -> Type
forall a. [a] -> a
head [Type]
tyArgs)
           Just vecTc :: TyCon
vecTc         = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
vecTcNm TyConMap
tcm
           [nilCon :: DataCon
nilCon,consCon :: DataCon
consCon]   = TyCon -> [DataCon]
tyConDataCons TyCon
vecTc
           -- Recursive call to @splitAt@
           splitAtRec :: Term -> Term
splitAtRec v :: Term
v =
            Term -> [Either Term Type] -> Term
mkApps (Text -> PrimInfo -> Term
Prim Text
nm PrimInfo
pInfo)
                   [Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
mInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                   ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
nTy
                   ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
                   ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
snatDc)
                                 [ Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
mInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                                 , Term -> Either Term Type
forall a b. a -> Either a b
Left  (Literal -> Term
Literal (Integer -> Literal
NaturalLiteral (Integer
mInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))])
                   ,Term -> Either Term Type
forall a b. a -> Either a b
Left Term
v
                   ]
           -- Projection either the first or second field of the recursive
           -- call to @splitAt@
           splitAtSelR :: Term -> Type -> [(Pat, Term)] -> Term
splitAtSelR v :: Term
v = Term -> Type -> [(Pat, Term)] -> Term
Case (Term -> Term
splitAtRec Term
v)
           m1VecTy :: Type
m1VecTy = TyConName -> [Type] -> Type
mkTyConApp TyConName
vecTcNm [LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
mInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)),Type
aTy]
           nVecTy :: Type
nVecTy  = TyConName -> [Type] -> Type
mkTyConApp TyConName
vecTcNm [Type
nTy,Type
aTy]
           -- Guaranteed no capture, so okay to use unsafe name generation
           lNm :: Name a
lNm     = Text -> Int -> Name a
forall a. Text -> Int -> Name a
mkUnsafeSystemName "l" 0
           rNm :: Name a
rNm     = Text -> Int -> Name a
forall a. Text -> Int -> Name a
mkUnsafeSystemName "r" 1
           lId :: Id
lId     = Type -> TmName -> Id
mkLocalId Type
m1VecTy TmName
forall a. Name a
lNm
           rId :: Id
rId     = Type -> TmName -> Id
mkLocalId Type
nVecTy TmName
forall a. Name a
rNm
           tupPat :: Pat
tupPat  = DataCon -> [TyVar] -> [Id] -> Pat
DataPat DataCon
tupDc [] [Id
lId,Id
rId]
           lAlt :: (Pat, Term)
lAlt    = (Pat
tupPat, (Id -> Term
Var Id
lId))
           rAlt :: (Pat, Term)
rAlt    = (Pat
tupPat, (Id -> Term
Var Id
rId))

       in case Integer
m of
         -- (Nil,v)
         0 -> 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) ([Either Term Type] -> Term) -> [Either Term Type] -> Term
forall a b. (a -> b) -> a -> b
$ ((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 (DataCon -> Type -> Term
mkVecNil DataCon
nilCon Type
aTy)
                , Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm ([Value] -> Value
forall a. [a] -> a
last [Value]
args))
                ]
         -- (x:xs) <- v
         m' :: Integer
m' | DC _ vArgs :: [Either Term Type]
vArgs <- [Value] -> Value
forall a. [a] -> a
last [Value]
args
            -- (x:fst (splitAt (m-1) xs),snd (splitAt (m-1) xs))
            -> 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) ([Either Term Type] -> Term) -> [Either Term Type] -> Term
forall a b. (a -> b) -> a -> b
$ ((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 (DataCon -> Type -> Integer -> Term -> Term -> Term
mkVecCons DataCon
consCon Type
aTy Integer
m' ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 1)
                           (Term -> Type -> [(Pat, Term)] -> Term
splitAtSelR ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 2) Type
m1VecTy [(Pat, Term)
lAlt]))
                 , Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> Type -> [(Pat, Term)] -> Term
splitAtSelR ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 2) Type
nVecTy [(Pat, Term)
rAlt])
                 ]
         -- v doesn't reduce to a data-constructor
         _  -> Maybe (Heap, Stack, Term)
forall a. Maybe a
Nothing

  "Clash.Sized.Vector.unconcat" -- :: KnownNat n => SNamt m -> Vec (n * m) a -> Vec n (Vec m a)
    | Bool
isSubj
    , kn :: Value
kn : snat :: Value
snat : v :: Value
v : _  <- [Value]
args
    , nTy :: Type
nTy : mTy :: Type
mTy : aTy :: Type
aTy :_ <- [Type]
tys
    , Lit (NaturalLiteral n :: Integer
n) <- Value
kn
    -> let ( [Either TyVar Type] -> [Type]
forall a b. [Either a b] -> [b]
Either.rights -> [Type]
argTys, Type -> TypeView
tyView -> TyConApp vecTcNm :: TyConName
vecTcNm _) =
              Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           Just vecTc :: TyCon
vecTc = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
vecTcNm TyConMap
tcm
           [nilCon :: DataCon
nilCon,consCon :: DataCon
consCon]   = TyCon -> [DataCon]
tyConDataCons TyCon
vecTc
           tupTcNm :: TyConName
tupTcNm            = TyCon -> TyConName
ghcTyconToTyConName (Boxity -> Int -> TyCon
tupleTyCon Boxity
Boxed 2)
           (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
           TyConApp snatTcNm :: TyConName
snatTcNm _ = Type -> TypeView
tyView ([Type]
argTys [Type] -> Int -> Type
forall a. [a] -> Int -> a
!! 1)
           n1mTy :: Type
n1mTy  = TyConName -> [Type] -> Type
mkTyConApp TyConName
typeNatMul
                        [TyConName -> [Type] -> Type
mkTyConApp TyConName
typeNatSub [Type
nTy,LitTy -> Type
LitTy (Integer -> LitTy
NumTy 1)]
                        ,Type
mTy]
           splitAtCall :: Term
splitAtCall =
            Term -> [Either Term Type] -> Term
mkApps (TyConName -> TyConName -> Term
splitAtPrim TyConName
snatTcNm TyConName
vecTcNm)
                   [Type -> Either Term Type
forall a b. b -> Either a b
Right Type
mTy
                   ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
n1mTy
                   ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
                   ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
snat)
                   ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
v)
                   ]
           mVecTy :: Type
mVecTy   = TyConName -> [Type] -> Type
mkTyConApp TyConName
vecTcNm [Type
mTy,Type
aTy]
           n1mVecTy :: Type
n1mVecTy = TyConName -> [Type] -> Type
mkTyConApp TyConName
vecTcNm [Type
n1mTy,Type
aTy]
           -- Guaranteed no capture, so okay to use unsafe name generation
           asNm :: Name a
asNm     = Text -> Int -> Name a
forall a. Text -> Int -> Name a
mkUnsafeSystemName "as" 0
           bsNm :: Name a
bsNm     = Text -> Int -> Name a
forall a. Text -> Int -> Name a
mkUnsafeSystemName "bs" 1
           asId :: Id
asId     = Type -> TmName -> Id
mkLocalId Type
mVecTy TmName
forall a. Name a
asNm
           bsId :: Id
bsId     = Type -> TmName -> Id
mkLocalId Type
n1mVecTy TmName
forall a. Name a
bsNm
           tupPat :: Pat
tupPat   = DataCon -> [TyVar] -> [Id] -> Pat
DataPat DataCon
tupDc [] [Id
asId,Id
bsId]
           asAlt :: (Pat, Term)
asAlt    = (Pat
tupPat, (Id -> Term
Var Id
asId))
           bsAlt :: (Pat, Term)
bsAlt    = (Pat
tupPat, (Id -> Term
Var Id
bsId))

       in  case Integer
n of
         0 -> Term -> Maybe (Heap, Stack, Term)
reduce (DataCon -> Type -> Term
mkVecNil DataCon
nilCon Type
mVecTy)
         _ -> Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$
              DataCon -> Type -> Integer -> Term -> Term -> Term
mkVecCons DataCon
consCon Type
mVecTy Integer
n
                (Term -> Type -> [(Pat, Term)] -> Term
Case Term
splitAtCall Type
mVecTy [(Pat, Term)
asAlt])
                (Term -> [Either Term Type] -> Term
mkApps (Text -> PrimInfo -> Term
Prim Text
nm PrimInfo
pInfo)
                    [Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                    ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
mTy
                    ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
                    ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
NaturalLiteral (Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                    ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
snat)
                    ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> Type -> [(Pat, Term)] -> Term
Case Term
splitAtCall Type
n1mVecTy [(Pat, Term)
bsAlt])])
-- Construction
-- - initialisation
  "Clash.Sized.Vector.replicate" -- :: SNat n -> a -> Vec n a
    | Bool
isSubj
    , let ty' :: Type
ty' = TyConMap -> Type -> [Type] -> Type
piResultTys TyConMap
tcm Type
ty [Type]
tys
    , let (_,resTy :: Type
resTy) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty'
    , (TyConApp vecTcNm :: TyConName
vecTcNm [lenTy :: Type
lenTy,argTy :: Type
argTy]) <- Type -> TypeView
tyView Type
resTy
    , Right len :: Integer
len <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
lenTy)
    -> let (Just vecTc :: TyCon
vecTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
vecTcNm TyConMap
tcm
           [nilCon :: DataCon
nilCon,consCon :: DataCon
consCon] = TyCon -> [DataCon]
tyConDataCons TyCon
vecTc
       in  Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$
           DataCon -> DataCon -> Type -> Integer -> [Term] -> Term
mkVec DataCon
nilCon DataCon
consCon Type
argTy Integer
len
                 (Int -> Term -> [Term]
forall a. Int -> a -> [a]
replicate (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
len) (Value -> Term
valToTerm ([Value] -> Value
forall a. [a] -> a
last [Value]
args)))
-- - Concatenation
  "Clash.Sized.Vector.++" -- :: Vec n a -> Vec m a -> Vec (n + m) a
    | Bool
isSubj
    , DC dc :: DataCon
dc vArgs :: [Either Term Type]
vArgs <- [Value] -> Value
forall a. [a] -> a
head [Value]
args
    , Right nTy :: Type
nTy : Right aTy :: Type
aTy : _ <- [Either Term Type]
vArgs
    , Right n :: Integer
n <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> case Integer
n of
         0  -> Term -> Maybe (Heap, Stack, Term)
reduce (Value -> Term
valToTerm ([Value] -> Value
forall a. [a] -> a
last [Value]
args))
         n' :: Integer
n' | (_ : _ : mTy :: Type
mTy : _) <- [Type]
tys
            , Right m :: Integer
m <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
mTy)
            -> -- x : (xs ++ ys)
               Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$
               DataCon -> Type -> Integer -> Term -> Term -> Term
mkVecCons DataCon
dc Type
aTy (Integer
n' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
m) ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 1)
                 (Term -> [Either Term Type] -> Term
mkApps (Text -> PrimInfo -> Term
Prim Text
nm PrimInfo
pInfo)
                                      [Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
n'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                                      ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
                                      ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
mTy
                                      ,Term -> Either Term Type
forall a b. a -> Either a b
Left ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 2)
                                      ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm ([Value] -> Value
forall a. [a] -> a
last [Value]
args))
                                      ])
         _ -> Maybe (Heap, Stack, Term)
forall a. Maybe a
Nothing
  "Clash.Sized.Vector.concat" -- :: Vec n (Vec m a) -> Vec (n * m) a
    | Bool
isSubj
    , (nTy :: Type
nTy : mTy :: Type
mTy : aTy :: Type
aTy : _)  <- [Type]
tys
    , (xs :: Value
xs : _)               <- [Value]
args
    , DC dc :: DataCon
dc vArgs :: [Either Term Type]
vArgs <- Value
xs
    , Right n :: Integer
n <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> case Integer
n of
        0 -> Term -> Maybe (Heap, Stack, Term)
reduce (DataCon -> Type -> Term
mkVecNil DataCon
dc Type
aTy)
        _ | _ : h' :: Term
h' : t :: Term
t : _ <- [Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts  [Either Term Type]
vArgs
          , (_,Type -> TypeView
tyView -> TyConApp vecTcNm :: TyConName
vecTcNm _) <- Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
          -> Term -> Maybe (Heap, Stack, Term)
reduceWHNF (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$
             Term -> [Either Term Type] -> Term
mkApps (TyConName -> Term
vecAppendPrim TyConName
vecTcNm)
                    [Type -> Either Term Type
forall a b. b -> Either a b
Right Type
mTy
                    ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
                    ,Type -> Either Term Type
forall a b. b -> Either a b
Right (Type -> Either Term Type) -> Type -> Either Term Type
forall a b. (a -> b) -> a -> b
$ TyConName -> [Type] -> Type
mkTyConApp TyConName
typeNatMul
                      [TyConName -> [Type] -> Type
mkTyConApp TyConName
typeNatSub [Type
nTy,LitTy -> Type
LitTy (Integer -> LitTy
NumTy 1)], Type
mTy]
                    ,Term -> Either Term Type
forall a b. a -> Either a b
Left Term
h'
                    ,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 -> [Either Term Type] -> Term
mkApps (Text -> PrimInfo -> Term
Prim Text
nm PrimInfo
pInfo)
                      [ Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                      , Type -> Either Term Type
forall a b. b -> Either a b
Right Type
mTy
                      , Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
                      , Term -> Either Term Type
forall a b. a -> Either a b
Left Term
t
                      ]
                    ]
        _ -> Maybe (Heap, Stack, Term)
forall a. Maybe a
Nothing

-- Modifying vectors
  "Clash.Sized.Vector.replace_int" -- :: KnownNat n => Vec n a -> Int -> a -> Vec n a
    | nTy :: Type
nTy : aTy :: Type
aTy : _  <- [Type]
tys
    , _ : xs :: Value
xs : i :: Value
i : a :: Value
a : _ <- [Value]
args
    , DC intDc :: DataCon
intDc [Left (Literal (IntLiteral i' :: Integer
i'))] <- Value
i
    -> if Integer
i' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 0
          then Maybe (Heap, Stack, Term)
forall a. Maybe a
Nothing
          else case Value
xs of
                 DC vecTcNm :: DataCon
vecTcNm vArgs :: [Either Term Type]
vArgs -> case Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
nTy) of
                    Right 0  -> Maybe (Heap, Stack, Term)
forall a. Maybe a
Nothing
                    Right n' :: Integer
n' ->
                      if Integer
i' Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 0
                         then Term -> Maybe (Heap, Stack, Term)
reduce (DataCon -> Type -> Integer -> Term -> Term -> Term
mkVecCons DataCon
vecTcNm Type
aTy Integer
n' (Value -> Term
valToTerm Value
a) ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 2))
                         else Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$
                              DataCon -> Type -> Integer -> Term -> Term -> Term
mkVecCons DataCon
vecTcNm Type
aTy Integer
n' ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 1)
                                (Term -> [Either Term Type] -> Term
mkApps (Text -> PrimInfo -> Term
Prim Text
nm PrimInfo
pInfo)
                                        [Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
n'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                                        ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
                                        ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
NaturalLiteral (Integer
n'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                                        ,Term -> Either Term Type
forall a b. a -> Either a b
Left ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 2)
                                        ,Term -> Either Term Type
forall a b. a -> Either a b
Left (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'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))])
                                        ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
a)
                                        ])
                    _ -> Maybe (Heap, Stack, Term)
forall a. Maybe a
Nothing
                 _ -> Maybe (Heap, Stack, Term)
forall a. Maybe a
Nothing

  "Clash.Transformations.eqInt"
    | [ DC _ [Left (Literal (IntLiteral i :: Integer
i))]
      , DC _ [Left (Literal (IntLiteral j :: Integer
j))]
      ] <- [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))

-- - specialized permutations
  "Clash.Sized.Vector.reverse" -- :: Vec n a -> Vec n a
    | Bool
isSubj
    , nTy :: Type
nTy : aTy :: Type
aTy : _  <- [Type]
tys
    , [DC vecDc :: DataCon
vecDc vArgs :: [Either Term Type]
vArgs] <- [Value]
args
    -> case Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
nTy) of
         Right 0 -> Term -> Maybe (Heap, Stack, Term)
reduce (DataCon -> Type -> Term
mkVecNil DataCon
vecDc Type
aTy)
         Right n :: Integer
n
           | (_,Type -> TypeView
tyView -> TyConApp vecTcNm :: TyConName
vecTcNm _) <- Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           , let (Just vecTc :: TyCon
vecTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
vecTcNm TyConMap
tcm
           , let [nilCon :: DataCon
nilCon,consCon :: DataCon
consCon] = TyCon -> [DataCon]
tyConDataCons TyCon
vecTc
           -> Term -> Maybe (Heap, Stack, Term)
reduceWHNF (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$
              Term -> [Either Term Type] -> Term
mkApps (TyConName -> Term
vecAppendPrim TyConName
vecTcNm)
                [Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
                ,Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy 1))
                ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> [Either Term Type] -> Term
mkApps (Text -> PrimInfo -> Term
Prim Text
nm PrimInfo
pInfo)
                              [Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                              ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
                              ,Term -> Either Term Type
forall a b. a -> Either a b
Left ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 2)
                              ])
                ,Term -> Either Term Type
forall a b. a -> Either a b
Left (DataCon -> DataCon -> Type -> Integer -> [Term] -> Term
mkVec DataCon
nilCon DataCon
consCon Type
aTy 1 [[Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 1])
                ]
         _ -> Maybe (Heap, Stack, Term)
forall a. Maybe a
Nothing
  "Clash.Sized.Vector.transpose" -- :: KnownNat n => Vec m (Vec n a) -> Vec n (Vec m a)
    | Bool
isSubj
    , nTy :: Type
nTy : mTy :: Type
mTy : aTy :: Type
aTy : _ <- [Type]
tys
    , kn :: Value
kn : xss :: Value
xss : _ <- [Value]
args
    , (_,Type -> TypeView
tyView -> TyConApp vecTcNm :: TyConName
vecTcNm _) <- Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
    , DC _ vArgs :: [Either Term Type]
vArgs <- Value
xss
    , Right n :: Integer
n <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
nTy)
    , Right m :: Integer
m <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
mTy)
    -> case Integer
m of
      0 -> let (Just vecTc :: TyCon
vecTc)     = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
vecTcNm TyConMap
tcm
               [nilCon :: DataCon
nilCon,consCon :: DataCon
consCon] = TyCon -> [DataCon]
tyConDataCons TyCon
vecTc
           in  Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$
               DataCon -> DataCon -> Type -> Integer -> [Term] -> Term
mkVec DataCon
nilCon DataCon
consCon (TyConName -> [Type] -> Type
mkTyConApp TyConName
vecTcNm [Type
mTy,Type
aTy]) Integer
n
                (Int -> Term -> [Term]
forall a. Int -> a -> [a]
replicate (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n) (DataCon -> DataCon -> Type -> Integer -> [Term] -> Term
mkVec DataCon
nilCon DataCon
consCon Type
aTy 0 []))
      m' :: Integer
m' -> let (Just vecTc :: TyCon
vecTc)     = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
vecTcNm TyConMap
tcm
                [_,consCon :: DataCon
consCon] = TyCon -> [DataCon]
tyConDataCons TyCon
vecTc
                Just (consCoTy :: Type
consCoTy : _) = DataCon -> [Type] -> Maybe [Type]
dataConInstArgTys DataCon
consCon
                                        [Type
mTy,Type
aTy,LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
m'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1))]
            in  Term -> Maybe (Heap, Stack, Term)
reduceWHNF (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$
                Term -> [Either Term Type] -> Term
mkApps (TyConName -> Term
vecZipWithPrim TyConName
vecTcNm)
                       [ Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
                       , Type -> Either Term Type
forall a b. b -> Either a b
Right (TyConName -> [Type] -> Type
mkTyConApp TyConName
vecTcNm [LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
m'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)),Type
aTy])
                       , Type -> Either Term Type
forall a b. b -> Either a b
Right (TyConName -> [Type] -> Type
mkTyConApp TyConName
vecTcNm [Type
mTy,Type
aTy])
                       , Type -> Either Term Type
forall a b. b -> Either a b
Right Type
nTy
                       , Term -> Either Term Type
forall a b. a -> Either a b
Left  (Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
consCon)
                                       [Type -> Either Term Type
forall a b. b -> Either a b
Right Type
mTy
                                       ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
                                       ,Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
m'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Type -> Term
primCo Type
consCoTy)
                                       ])
                       , Term -> Either Term Type
forall a b. a -> Either a b
Left  ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 1)
                       , Term -> Either Term Type
forall a b. a -> Either a b
Left  (Term -> [Either Term Type] -> Term
mkApps (Text -> PrimInfo -> Term
Prim Text
nm PrimInfo
pInfo)
                                       [ Type -> Either Term Type
forall a b. b -> Either a b
Right Type
nTy
                                       , Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
m'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                                       , Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
                                       , Term -> Either Term Type
forall a b. a -> Either a b
Left  (Value -> Term
valToTerm Value
kn)
                                       , Term -> Either Term Type
forall a b. a -> Either a b
Left  ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 2)
                                       ])
                       ]
  "Clash.Sized.Vector.rotateLeftS" -- :: KnownNat n => Vec n a -> SNat d -> Vec n a
    | nTy :: Type
nTy : aTy :: Type
aTy : _ : _ <- [Type]
tys
    , kn :: Value
kn : xs :: Value
xs : d :: Value
d : _ <- [Value]
args
    , DC dc :: DataCon
dc vArgs :: [Either Term Type]
vArgs <- Value
xs
    , Right n :: Integer
n <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> case Integer
n of
         0  -> Term -> Maybe (Heap, Stack, Term)
reduce (DataCon -> Type -> Term
mkVecNil DataCon
dc Type
aTy)
         n' :: Integer
n' | DC snatDc :: DataCon
snatDc [_,Left d' :: Term
d'] <- Value
d
            , (h2 :: Heap
h2,[],Literal (NaturalLiteral d2 :: Integer
d2)) <- PrimEvaluator
-> TyConMap -> Bool -> (Heap, Stack, Term) -> (Heap, Stack, Term)
whnf PrimEvaluator
reduceConstant TyConMap
tcm Bool
isSubj (Heap
h,[],Term
d')
            -> case (Integer
d2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
n) of
                 0  -> Term -> Maybe (Heap, Stack, Term)
reduce (Value -> Term
valToTerm Value
xs)
                 d3 :: Integer
d3 -> let (_,Type -> TypeView
tyView -> TyConApp vecTcNm :: TyConName
vecTcNm _) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
                           (Just vecTc :: TyCon
vecTc)     = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
vecTcNm TyConMap
tcm
                           [nilCon :: DataCon
nilCon,consCon :: DataCon
consCon] = TyCon -> [DataCon]
tyConDataCons TyCon
vecTc
                       in  Heap -> Term -> Maybe (Heap, Stack, Term)
reduceWHNF' Heap
h2 (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$
                           Term -> [Either Term Type] -> Term
mkApps (Text -> PrimInfo -> Term
Prim Text
nm PrimInfo
pInfo)
                                  [Type -> Either Term Type
forall a b. b -> Either a b
Right Type
nTy
                                  ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
                                  ,Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
d3Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                                  ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
kn)
                                  ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> [Either Term Type] -> Term
mkApps (TyConName -> Term
vecAppendPrim TyConName
vecTcNm)
                                                [Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
n'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                                                ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
                                                ,Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy 1))
                                                ,Term -> Either Term Type
forall a b. a -> Either a b
Left  ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 2)
                                                ,Term -> Either Term Type
forall a b. a -> Either a b
Left  (DataCon -> DataCon -> Type -> Integer -> [Term] -> Term
mkVec DataCon
nilCon DataCon
consCon Type
aTy 1 [[Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 1])])
                                  ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
snatDc)
                                                [Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
d3Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                                                ,Term -> Either Term Type
forall a b. a -> Either a b
Left  (Literal -> Term
Literal (Integer -> Literal
NaturalLiteral (Integer
d3Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))])
                                  ]
         _  -> Maybe (Heap, Stack, Term)
forall a. Maybe a
Nothing
  "Clash.Sized.Vector.rotateRightS" -- :: KnownNat n => Vec n a -> SNat d -> Vec n a
    | Bool
isSubj
    , nTy :: Type
nTy : aTy :: Type
aTy : _ : _ <- [Type]
tys
    , kn :: Value
kn : xs :: Value
xs : d :: Value
d : _ <- [Value]
args
    , DC dc :: DataCon
dc _ <- Value
xs
    , Right n :: Integer
n <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> case Integer
n of
         0  -> Term -> Maybe (Heap, Stack, Term)
reduce (DataCon -> Type -> Term
mkVecNil DataCon
dc Type
aTy)
         n' :: Integer
n' | DC snatDc :: DataCon
snatDc [_,Left d' :: Term
d'] <- Value
d
            , (h2 :: Heap
h2,[],Literal (NaturalLiteral d2 :: Integer
d2)) <- PrimEvaluator
-> TyConMap -> Bool -> (Heap, Stack, Term) -> (Heap, Stack, Term)
whnf PrimEvaluator
reduceConstant TyConMap
tcm Bool
isSubj (Heap
h,[],Term
d')
            -> case (Integer
d2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
n) of
                 0  -> Term -> Maybe (Heap, Stack, Term)
reduce (Value -> Term
valToTerm Value
xs)
                 d3 :: Integer
d3 -> let (_,Type -> TypeView
tyView -> TyConApp vecTcNm :: TyConName
vecTcNm _) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
                       in  Heap -> Term -> Maybe (Heap, Stack, Term)
reduceWHNF' Heap
h2 (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$
                           Term -> [Either Term Type] -> Term
mkApps (Text -> PrimInfo -> Term
Prim Text
nm PrimInfo
pInfo)
                                  [Type -> Either Term Type
forall a b. b -> Either a b
Right Type
nTy
                                  ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
                                  ,Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
d3Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                                  ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
kn)
                                  ,Term -> Either Term Type
forall a b. a -> Either a b
Left (DataCon -> Type -> Integer -> Term -> Term -> Term
mkVecCons DataCon
dc Type
aTy Integer
n
                                          (Term -> [Either Term Type] -> Term
mkApps (TyConName -> Term
vecLastPrim TyConName
vecTcNm)
                                                  [Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
n'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                                                  ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
                                                  ,Term -> Either Term Type
forall a b. a -> Either a b
Left  (Value -> Term
valToTerm Value
xs)])
                                          (Term -> [Either Term Type] -> Term
mkApps (TyConName -> Term
vecInitPrim TyConName
vecTcNm)
                                                  [Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
n'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                                                  ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
                                                  ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
xs)]))
                                  ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
snatDc)
                                                [Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
d3Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                                                ,Term -> Either Term Type
forall a b. a -> Either a b
Left  (Literal -> Term
Literal (Integer -> Literal
NaturalLiteral (Integer
d3Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))])
                                  ]
         _  -> Maybe (Heap, Stack, Term)
forall a. Maybe a
Nothing
-- Element-wise operations
-- - mapping
  "Clash.Sized.Vector.map" -- :: (a -> b) -> Vec n a -> Vec n b
    | Bool
isSubj
    , DC dc :: DataCon
dc vArgs :: [Either Term Type]
vArgs <- [Value]
args [Value] -> Int -> Value
forall a. [a] -> Int -> a
!! 1
    , aTy :: Type
aTy : bTy :: Type
bTy : nTy :: Type
nTy : _ <- [Type]
tys
    , Right n :: Integer
n <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> case Integer
n of
         0  -> Term -> Maybe (Heap, Stack, Term)
reduce (DataCon -> Type -> Term
mkVecNil DataCon
dc Type
bTy)
         n' :: Integer
n' -> Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$
               DataCon -> Type -> Integer -> Term -> Term -> Term
mkVecCons DataCon
dc Type
bTy Integer
n'
                 (Term -> [Either Term Type] -> Term
mkApps (Value -> Term
valToTerm ([Value]
args [Value] -> Int -> Value
forall a. [a] -> Int -> a
!! 0)) [Term -> Either Term Type
forall a b. a -> Either a b
Left ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 1)])
                 (Term -> [Either Term Type] -> Term
mkApps (Text -> PrimInfo -> Term
Prim Text
nm PrimInfo
pInfo)
                                      [Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
                                      ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
bTy
                                      ,Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
n' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 1)))
                                      ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm ([Value]
args [Value] -> Int -> Value
forall a. [a] -> Int -> a
!! 0))
                                      ,Term -> Either Term Type
forall a b. a -> Either a b
Left ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 2)])
  "Clash.Sized.Vector.imap" -- :: forall n a b . KnownNat n => (Index n -> a -> b) -> Vec n a -> Vec n b
    | Bool
isSubj
    , nTy :: Type
nTy : aTy :: Type
aTy : bTy :: Type
bTy : _ <- [Type]
tys
    , (tyArgs :: [Either TyVar Type]
tyArgs,Type -> TypeView
tyView -> TyConApp vecTcNm :: TyConName
vecTcNm _) <- Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
    , let (tyArgs' :: [Either TyVar Type]
tyArgs',_) = Type -> ([Either TyVar Type], Type)
splitFunForallTy ([Either TyVar Type] -> [Type]
forall a b. [Either a b] -> [b]
Either.rights [Either TyVar Type]
tyArgs [Type] -> Int -> Type
forall a. [a] -> Int -> a
!! 1)
    , TyConApp indexTcNm :: TyConName
indexTcNm _ <- Type -> TypeView
tyView ([Either TyVar Type] -> [Type]
forall a b. [Either a b] -> [b]
Either.rights [Either TyVar Type]
tyArgs' [Type] -> Int -> Type
forall a. [a] -> Int -> a
!! 0)
    , Right n :: Integer
n <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
nTy)
    , let iLit :: Term
iLit = Type -> Type -> Integer -> Integer -> Term
mkIndexLit ([Either TyVar Type] -> [Type]
forall a b. [Either a b] -> [b]
Either.rights [Either TyVar Type]
tyArgs' [Type] -> Int -> Type
forall a. [a] -> Int -> a
!! 0) Type
nTy Integer
n 0
    -> Term -> Maybe (Heap, Stack, Term)
reduceWHNF (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$
       Term -> [Either Term Type] -> Term
mkApps (Text -> PrimInfo -> Term
Prim "Clash.Sized.Vector.imap_go"
                    (Type -> WorkInfo -> PrimInfo
PrimInfo (TyConName -> TyConName -> Type
vecImapGoTy TyConName
vecTcNm TyConName
indexTcNm) WorkInfo
WorkNever))
              [Type -> Either Term Type
forall a b. b -> Either a b
Right Type
nTy
              ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
nTy
              ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
              ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
bTy
              ,Term -> Either Term Type
forall a b. a -> Either a b
Left Term
iLit
              ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm ([Value]
args [Value] -> Int -> Value
forall a. [a] -> Int -> a
!! 1))
              ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm ([Value]
args [Value] -> Int -> Value
forall a. [a] -> Int -> a
!! 2))
              ]

  "Clash.Sized.Vector.imap_go"
    | Bool
isSubj
    , nTy :: Type
nTy : mTy :: Type
mTy : aTy :: Type
aTy : bTy :: Type
bTy : _ <- [Type]
tys
    , n :: Value
n : f :: Value
f : xs :: Value
xs : _ <- [Value]
args
    , DC dc :: DataCon
dc vArgs :: [Either Term Type]
vArgs <- Value
xs
    , Right n' :: Integer
n' <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
nTy)
    , Right m :: Integer
m <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
mTy)
    -> case Integer
m of
         0  -> Term -> Maybe (Heap, Stack, Term)
reduce (DataCon -> Type -> Term
mkVecNil DataCon
dc Type
bTy)
         m' :: Integer
m' -> let (tyArgs :: [Either TyVar Type]
tyArgs,_) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
                   TyConApp indexTcNm :: TyConName
indexTcNm _ = Type -> TypeView
tyView ([Either TyVar Type] -> [Type]
forall a b. [Either a b] -> [b]
Either.rights [Either TyVar Type]
tyArgs [Type] -> Int -> Type
forall a. [a] -> Int -> a
!! 0)
                   iLit :: Term
iLit = Type -> Type -> Integer -> Integer -> Term
mkIndexLit ([Either TyVar Type] -> [Type]
forall a b. [Either a b] -> [b]
Either.rights [Either TyVar Type]
tyArgs [Type] -> Int -> Type
forall a. [a] -> Int -> a
!! 0) Type
nTy Integer
n' 1
               in Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$ DataCon -> Type -> Integer -> Term -> Term -> Term
mkVecCons DataCon
dc Type
bTy Integer
m'
                 (Term -> [Either Term Type] -> Term
mkApps (Value -> Term
valToTerm Value
f) [Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
n),Term -> Either Term Type
forall a b. a -> Either a b
Left ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 1)])
                 (Term -> [Either Term Type] -> Term
mkApps (Text -> PrimInfo -> Term
Prim Text
nm PrimInfo
pInfo)
                         [Type -> Either Term Type
forall a b. b -> Either a b
Right Type
nTy
                         ,Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
m'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                         ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
                         ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
bTy
                         ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> [Either Term Type] -> Term
mkApps (Text -> PrimInfo -> Term
Prim "Clash.Sized.Internal.Index.+#"
                                             (Type -> WorkInfo -> PrimInfo
PrimInfo (TyConName -> Type
indexAddTy TyConName
indexTcNm) WorkInfo
WorkVariable))
                                       [Type -> Either Term Type
forall a b. b -> Either a b
Right Type
nTy
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
NaturalLiteral Integer
n'))
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
n)
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left Term
iLit
                                       ])
                         ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
f)
                         ,Term -> Either Term Type
forall a b. a -> Either a b
Left ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 2)
                         ])

-- - Zipping
  "Clash.Sized.Vector.zipWith" -- :: (a -> b -> c) -> Vec n a -> Vec n b -> Vec n c
    | Bool
isSubj
    , aTy :: Type
aTy : bTy :: Type
bTy : cTy :: Type
cTy : nTy :: Type
nTy : _ <- [Type]
tys
    , f :: Value
f : xs :: Value
xs : ys :: Value
ys : _   <- [Value]
args
    , DC dc :: DataCon
dc vArgs :: [Either Term Type]
vArgs <- Value
xs
    , (_,Type -> TypeView
tyView -> TyConApp vecTcNm :: TyConName
vecTcNm _) <- Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
    , Right n :: Integer
n <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> case Integer
n of
         0  -> Term -> Maybe (Heap, Stack, Term)
reduce (DataCon -> Type -> Term
mkVecNil DataCon
dc Type
cTy)
         n' :: Integer
n' -> Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$ DataCon -> Type -> Integer -> Term -> Term -> Term
mkVecCons DataCon
dc Type
cTy Integer
n'
                 (Term -> [Either Term Type] -> Term
mkApps (Value -> Term
valToTerm Value
f)
                            [Term -> Either Term Type
forall a b. a -> Either a b
Left ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 1)
                            ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> [Either Term Type] -> Term
mkApps (TyConName -> Term
vecHeadPrim TyConName
vecTcNm)
                                    [Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
n'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                                    ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
bTy
                                    ,Term -> Either Term Type
forall a b. a -> Either a b
Left  (Value -> Term
valToTerm Value
ys)
                                    ])
                            ])
                 (Term -> [Either Term Type] -> Term
mkApps (Text -> PrimInfo -> Term
Prim Text
nm PrimInfo
pInfo)
                                      [Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
                                      ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
bTy
                                      ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
cTy
                                      ,Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
n' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 1)))
                                      ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
f)
                                      ,Term -> Either Term Type
forall a b. a -> Either a b
Left ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 2)
                                      ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> [Either Term Type] -> Term
mkApps (TyConName -> Term
vecTailPrim TyConName
vecTcNm)
                                                    [Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
n'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                                                    ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
bTy
                                                    ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
ys)
                                                    ])])

-- Folding
  "Clash.Sized.Vector.foldr" -- :: (a -> b -> b) -> b -> Vec n a -> b
    | Bool
isSubj
    , aTy :: Type
aTy : bTy :: Type
bTy : nTy :: Type
nTy : _ <- [Type]
tys
    , f :: Value
f : z :: Value
z : xs :: Value
xs : _ <- [Value]
args
    , DC _ vArgs :: [Either Term Type]
vArgs <- Value
xs
    , Right n :: Integer
n <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> case Integer
n of
         0 -> Term -> Maybe (Heap, Stack, Term)
reduce (Value -> Term
valToTerm Value
z)
         _ -> Term -> Maybe (Heap, Stack, Term)
reduceWHNF (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$
              Term -> [Either Term Type] -> Term
mkApps (Value -> Term
valToTerm Value
f)
                     [Term -> Either Term Type
forall a b. a -> Either a b
Left ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 1)
                     ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> [Either Term Type] -> Term
mkApps (Text -> PrimInfo -> Term
Prim Text
nm PrimInfo
pInfo)
                                   [Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
                                   ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
bTy
                                   ,Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                                   ,Term -> Either Term Type
forall a b. a -> Either a b
Left  (Value -> Term
valToTerm Value
f)
                                   ,Term -> Either Term Type
forall a b. a -> Either a b
Left  (Value -> Term
valToTerm Value
z)
                                   ,Term -> Either Term Type
forall a b. a -> Either a b
Left  ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 2)
                                   ])
                     ]
  "Clash.Sized.Vector.fold" -- :: (a -> a -> a) -> Vec (n + 1) a -> a
    | Bool
isSubj
    , aTy :: Type
aTy : nTy :: Type
nTy : _ <- [Type]
tys
    , f :: Value
f : vs :: Value
vs : _ <- [Value]
args
    , DC _ vArgs :: [Either Term Type]
vArgs <- Value
vs
    , Right n :: Integer
n <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> case Integer
n of
         0 -> Term -> Maybe (Heap, Stack, Term)
reduceWHNF ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 1)
         _ -> let (tyArgs :: [Either TyVar Type]
tyArgs,_)         = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
                  TyConApp vecTcNm :: TyConName
vecTcNm _ = Type -> TypeView
tyView ([Either TyVar Type] -> [Type]
forall a b. [Either a b] -> [b]
Either.rights [Either TyVar Type]
tyArgs [Type] -> Int -> Type
forall a. [a] -> Int -> a
!! 1)
                  tupTcNm :: TyConName
tupTcNm      = TyCon -> TyConName
ghcTyconToTyConName (Boxity -> Int -> TyCon
tupleTyCon Boxity
Boxed 2)
                  (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
                  n' :: Integer
n'     = Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+1
                  m :: Integer
m      = Integer
n' Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` 2
                  n1 :: Integer
n1     = Integer
n' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
m
                  mTy :: Type
mTy    = LitTy -> Type
LitTy (Integer -> LitTy
NumTy Integer
m)
                  m'ty :: Type
m'ty   = LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
mInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-1))
                  n1mTy :: Type
n1mTy  = LitTy -> Type
LitTy (Integer -> LitTy
NumTy Integer
n1)
                  n1m'ty :: Type
n1m'ty = LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
n1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1))
                  splitAtCall :: Term
splitAtCall =
                   Term -> [Either Term Type] -> Term
mkApps (Text -> PrimInfo -> Term
Prim "Clash.Sized.Vector.fold_split"
                                (Type -> WorkInfo -> PrimInfo
PrimInfo (TyConName -> Type
foldSplitAtTy TyConName
vecTcNm) WorkInfo
WorkNever))
                          [Type -> Either Term Type
forall a b. b -> Either a b
Right Type
mTy
                          ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
n1mTy
                          ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
                          ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
NaturalLiteral Integer
m))
                          ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
vs)
                          ]
                  mVecTy :: Type
mVecTy   = TyConName -> [Type] -> Type
mkTyConApp TyConName
vecTcNm [Type
mTy,Type
aTy]
                  n1mVecTy :: Type
n1mVecTy = TyConName -> [Type] -> Type
mkTyConApp TyConName
vecTcNm [Type
n1mTy,Type
aTy]
                  -- Guaranteed no capture, so okay to use unsafe name generation
                  asNm :: Name a
asNm     = Text -> Int -> Name a
forall a. Text -> Int -> Name a
mkUnsafeSystemName "as" 0
                  bsNm :: Name a
bsNm     = Text -> Int -> Name a
forall a. Text -> Int -> Name a
mkUnsafeSystemName "bs" 1
                  asId :: Id
asId     = Type -> TmName -> Id
mkLocalId Type
mVecTy TmName
forall a. Name a
asNm
                  bsId :: Id
bsId     = Type -> TmName -> Id
mkLocalId Type
n1mVecTy TmName
forall a. Name a
bsNm
                  tupPat :: Pat
tupPat   = DataCon -> [TyVar] -> [Id] -> Pat
DataPat DataCon
tupDc [] [Id
asId,Id
bsId]
                  asAlt :: (Pat, Term)
asAlt    = (Pat
tupPat, (Id -> Term
Var Id
asId))
                  bsAlt :: (Pat, Term)
bsAlt    = (Pat
tupPat, (Id -> Term
Var Id
bsId))
              in  Term -> Maybe (Heap, Stack, Term)
reduceWHNF (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$
                  Term -> [Either Term Type] -> Term
mkApps (Value -> Term
valToTerm Value
f)
                         [Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> [Either Term Type] -> Term
mkApps (Text -> PrimInfo -> Term
Prim Text
nm PrimInfo
pInfo)
                                       [Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
                                       ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
m'ty
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
f)
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> Type -> [(Pat, Term)] -> Term
Case Term
splitAtCall Type
mVecTy [(Pat, Term)
asAlt])
                                       ])
                         ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> [Either Term Type] -> Term
mkApps (Text -> PrimInfo -> Term
Prim Text
nm PrimInfo
pInfo)
                                       [Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
                                       ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
n1m'ty
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left  (Value -> Term
valToTerm Value
f)
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left  (Term -> Type -> [(Pat, Term)] -> Term
Case Term
splitAtCall Type
n1mVecTy [(Pat, Term)
bsAlt])
                                       ])
                         ]


  "Clash.Sized.Vector.fold_split" -- :: Natural -> Vec (m + n) a -> (Vec m a, Vec n a)
    | Bool
isSubj
    , mTy :: Type
mTy : nTy :: Type
nTy : aTy :: Type
aTy : _ <- [Type]
tys
    , Right m :: Integer
m <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
mTy)
    -> let -- Get the tuple data-constructor
           ty1 :: Type
ty1 = TyConMap -> Type -> [Type] -> Type
piResultTys TyConMap
tcm Type
ty [Type]
tys
           (_,Type -> TypeView
tyView -> TyConApp tupTcNm :: TyConName
tupTcNm tyArgs :: [Type]
tyArgs) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty1
           (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
           -- Get the vector data-constructors
           TyConApp vecTcNm :: TyConName
vecTcNm _ = Type -> TypeView
tyView ([Type] -> Type
forall a. [a] -> a
head [Type]
tyArgs)
           Just vecTc :: TyCon
vecTc         = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
vecTcNm TyConMap
tcm
           [nilCon :: DataCon
nilCon,consCon :: DataCon
consCon]   = TyCon -> [DataCon]
tyConDataCons TyCon
vecTc
           -- Recursive call to @splitAt@
           splitAtRec :: Term -> Term
splitAtRec v :: Term
v =
            Term -> [Either Term Type] -> Term
mkApps (Text -> PrimInfo -> Term
Prim Text
nm PrimInfo
pInfo)
                   [Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
mInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                   ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
nTy
                   ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
                   ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
NaturalLiteral (Integer
mInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                   ,Term -> Either Term Type
forall a b. a -> Either a b
Left Term
v
                   ]
           -- Projection either the first or second field of the recursive
           -- call to @splitAt@
           splitAtSelR :: Term -> Type -> [(Pat, Term)] -> Term
splitAtSelR v :: Term
v = Term -> Type -> [(Pat, Term)] -> Term
Case (Term -> Term
splitAtRec Term
v)
           m1VecTy :: Type
m1VecTy = TyConName -> [Type] -> Type
mkTyConApp TyConName
vecTcNm [LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
mInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)),Type
aTy]
           nVecTy :: Type
nVecTy  = TyConName -> [Type] -> Type
mkTyConApp TyConName
vecTcNm [Type
nTy,Type
aTy]
           -- Guaranteed no capture, so okay to use unsafe name generation
           lNm :: Name a
lNm     = Text -> Int -> Name a
forall a. Text -> Int -> Name a
mkUnsafeSystemName "l" 0
           rNm :: Name a
rNm     = Text -> Int -> Name a
forall a. Text -> Int -> Name a
mkUnsafeSystemName "r" 1
           lId :: Id
lId     = Type -> TmName -> Id
mkLocalId Type
m1VecTy TmName
forall a. Name a
lNm
           rId :: Id
rId     = Type -> TmName -> Id
mkLocalId Type
nVecTy TmName
forall a. Name a
rNm
           tupPat :: Pat
tupPat  = DataCon -> [TyVar] -> [Id] -> Pat
DataPat DataCon
tupDc [] [Id
lId,Id
rId]
           lAlt :: (Pat, Term)
lAlt    = (Pat
tupPat, (Id -> Term
Var Id
lId))
           rAlt :: (Pat, Term)
rAlt    = (Pat
tupPat, (Id -> Term
Var Id
rId))
       in case Integer
m of
         -- (Nil,v)
         0 -> 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) ([Either Term Type] -> Term) -> [Either Term Type] -> Term
forall a b. (a -> b) -> a -> b
$ ((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 (DataCon -> Type -> Term
mkVecNil DataCon
nilCon Type
aTy)
                , Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm ([Value] -> Value
forall a. [a] -> a
last [Value]
args))
                ]
         -- (x:xs) <- v
         m' :: Integer
m' | DC _ vArgs :: [Either Term Type]
vArgs <- [Value] -> Value
forall a. [a] -> a
last [Value]
args
            -- (x:fst (splitAt (m-1) xs),snd (splitAt (m-1) xs))
            -> 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) ([Either Term Type] -> Term) -> [Either Term Type] -> Term
forall a b. (a -> b) -> a -> b
$ ((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 (DataCon -> Type -> Integer -> Term -> Term -> Term
mkVecCons DataCon
consCon Type
aTy Integer
m' ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 1)
                           (Term -> Type -> [(Pat, Term)] -> Term
splitAtSelR ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 2) Type
m1VecTy [(Pat, Term)
lAlt]))
                 , Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> Type -> [(Pat, Term)] -> Term
splitAtSelR ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 2) Type
nVecTy [(Pat, Term)
rAlt])
                 ]
         -- v doesn't reduce to a data-constructor
         _  -> Maybe (Heap, Stack, Term)
forall a. Maybe a
Nothing
-- - Specialised folds
  "Clash.Sized.Vector.dfold"
    | Bool
isSubj
    , pTy :: Type
pTy : kTy :: Type
kTy : aTy :: Type
aTy : _ <- [Type]
tys
    , _ : p :: Value
p : f :: Value
f : z :: Value
z : xs :: Value
xs : _ <- [Value]
args
    , DC _ vArgs :: [Either Term Type]
vArgs <- Value
xs
    , Right k' :: Integer
k' <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
kTy)
    -> case Integer
k'  of
         0 -> Term -> Maybe (Heap, Stack, Term)
reduce (Value -> Term
valToTerm Value
z)
         _ -> let (tyArgs :: [Either TyVar Type]
tyArgs,_)  = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
                  (tyArgs' :: [Either TyVar Type]
tyArgs',_) = Type -> ([Either TyVar Type], Type)
splitFunForallTy ([Either TyVar Type] -> [Type]
forall a b. [Either a b] -> [b]
Either.rights [Either TyVar Type]
tyArgs [Type] -> Int -> Type
forall a. [a] -> Int -> a
!! 2)
                  TyConApp snatTcNm :: TyConName
snatTcNm _ = Type -> TypeView
tyView ([Either TyVar Type] -> [Type]
forall a b. [Either a b] -> [b]
Either.rights [Either TyVar Type]
tyArgs' [Type] -> Int -> Type
forall a. [a] -> Int -> a
!! 0)
                  Just snatTc :: TyCon
snatTc = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
snatTcNm TyConMap
tcm
                  [snatDc :: DataCon
snatDc]    = TyCon -> [DataCon]
tyConDataCons TyCon
snatTc
                  k'ty :: Type
k'ty        = LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
k'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1))
              in  Term -> Maybe (Heap, Stack, Term)
reduceWHNF (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$
                  Term -> [Either Term Type] -> Term
mkApps (Value -> Term
valToTerm Value
f)
                         [Type -> Either Term Type
forall a b. b -> Either a b
Right Type
k'ty
                         ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
snatDc)
                                       [Type -> Either Term Type
forall a b. b -> Either a b
Right Type
k'ty
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
NaturalLiteral (Integer
k'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))])
                         ,Term -> Either Term Type
forall a b. a -> Either a b
Left ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 1)
                         ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> [Either Term Type] -> Term
mkApps (Text -> PrimInfo -> Term
Prim Text
nm PrimInfo
pInfo)
                                       [Type -> Either Term Type
forall a b. b -> Either a b
Right Type
pTy
                                       ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
k'ty
                                       ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
NaturalLiteral (Integer
k'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
p)
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
f)
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
z)
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 2)
                                       ])
                         ]
  "Clash.Sized.Vector.dtfold"
    | Bool
isSubj
    , pTy :: Type
pTy : kTy :: Type
kTy : aTy :: Type
aTy : _ <- [Type]
tys
    , _ : p :: Value
p : f :: Value
f : g :: Value
g : xs :: Value
xs : _ <- [Value]
args
    , DC _ vArgs :: [Either Term Type]
vArgs <- Value
xs
    , Right k' :: Integer
k' <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
kTy)
    -> case Integer
k' of
         0 -> Term -> Maybe (Heap, Stack, Term)
reduceWHNF (Term -> [Either Term Type] -> Term
mkApps (Value -> Term
valToTerm Value
f) [Term -> Either Term Type
forall a b. a -> Either a b
Left ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 1)])
         _ -> let (tyArgs :: [Either TyVar Type]
tyArgs,_)  = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
                  TyConApp vecTcNm :: TyConName
vecTcNm _ = Type -> TypeView
tyView ([Either TyVar Type] -> [Type]
forall a b. [Either a b] -> [b]
Either.rights [Either TyVar Type]
tyArgs [Type] -> Int -> Type
forall a. [a] -> Int -> a
!! 4)
                  (tyArgs' :: [Either TyVar Type]
tyArgs',_) = Type -> ([Either TyVar Type], Type)
splitFunForallTy ([Either TyVar Type] -> [Type]
forall a b. [Either a b] -> [b]
Either.rights [Either TyVar Type]
tyArgs [Type] -> Int -> Type
forall a. [a] -> Int -> a
!! 3)
                  TyConApp snatTcNm :: TyConName
snatTcNm _ = Type -> TypeView
tyView ([Either TyVar Type] -> [Type]
forall a b. [Either a b] -> [b]
Either.rights [Either TyVar Type]
tyArgs' [Type] -> Int -> Type
forall a. [a] -> Int -> a
!! 0)
                  Just snatTc :: TyCon
snatTc = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
snatTcNm TyConMap
tcm
                  [snatDc :: DataCon
snatDc]    = TyCon -> [DataCon]
tyConDataCons TyCon
snatTc
                  tupTcNm :: TyConName
tupTcNm     = TyCon -> TyConName
ghcTyconToTyConName (Boxity -> Int -> TyCon
tupleTyCon Boxity
Boxed 2)
                  (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
                  k'ty :: Type
k'ty        = LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
k'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1))
                  k2ty :: Type
k2ty        = LitTy -> Type
LitTy (Integer -> LitTy
NumTy (2Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(Integer
k'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                  splitAtCall :: Term
splitAtCall =
                   Term -> [Either Term Type] -> Term
mkApps (TyConName -> TyConName -> Term
splitAtPrim TyConName
snatTcNm TyConName
vecTcNm)
                          [Type -> Either Term Type
forall a b. b -> Either a b
Right Type
k2ty
                          ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
k2ty
                          ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
                          ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
snatDc)
                                        [Type -> Either Term Type
forall a b. b -> Either a b
Right Type
k2ty
                                        ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
NaturalLiteral (2Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(Integer
k'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1))))])
                          ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
xs)
                          ]
                  xsSVecTy :: Type
xsSVecTy = TyConName -> [Type] -> Type
mkTyConApp TyConName
vecTcNm [Type
k2ty,Type
aTy]
                  -- Guaranteed no capture, so okay to use unsafe name generation
                  xsLNm :: Name a
xsLNm    = Text -> Int -> Name a
forall a. Text -> Int -> Name a
mkUnsafeSystemName "xsL" 0
                  xsRNm :: Name a
xsRNm    = Text -> Int -> Name a
forall a. Text -> Int -> Name a
mkUnsafeSystemName "xsR" 1
                  xsLId :: Id
xsLId    = Type -> TmName -> Id
mkLocalId Type
k2ty TmName
forall a. Name a
xsLNm
                  xsRId :: Id
xsRId    = Type -> TmName -> Id
mkLocalId Type
k2ty TmName
forall a. Name a
xsRNm
                  tupPat :: Pat
tupPat   = DataCon -> [TyVar] -> [Id] -> Pat
DataPat DataCon
tupDc [] [Id
xsLId,Id
xsRId]
                  asAlt :: (Pat, Term)
asAlt    = (Pat
tupPat, (Id -> Term
Var Id
xsLId))
                  bsAlt :: (Pat, Term)
bsAlt    = (Pat
tupPat, (Id -> Term
Var Id
xsRId))
              in  Term -> Maybe (Heap, Stack, Term)
reduceWHNF (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$
                  Term -> [Either Term Type] -> Term
mkApps (Value -> Term
valToTerm Value
g)
                         [Type -> Either Term Type
forall a b. b -> Either a b
Right Type
k'ty
                         ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
snatDc)
                                       [Type -> Either Term Type
forall a b. b -> Either a b
Right Type
k'ty
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
NaturalLiteral (Integer
k'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))])
                         ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> [Either Term Type] -> Term
mkApps (Text -> PrimInfo -> Term
Prim Text
nm PrimInfo
pInfo)
                                       [Type -> Either Term Type
forall a b. b -> Either a b
Right Type
pTy
                                       ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
k'ty
                                       ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
NaturalLiteral (Integer
k'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
p)
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
f)
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
g)
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> Type -> [(Pat, Term)] -> Term
Case Term
splitAtCall Type
xsSVecTy [(Pat, Term)
asAlt])])
                         ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> [Either Term Type] -> Term
mkApps (Text -> PrimInfo -> Term
Prim Text
nm PrimInfo
pInfo)
                                       [Type -> Either Term Type
forall a b. b -> Either a b
Right Type
pTy
                                       ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
k'ty
                                       ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
NaturalLiteral (Integer
k'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
p)
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
f)
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
g)
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> Type -> [(Pat, Term)] -> Term
Case Term
splitAtCall Type
xsSVecTy [(Pat, Term)
bsAlt])])
                         ]
-- Misc
  "Clash.Sized.Vector.lazyV"
    | Bool
isSubj
    , nTy :: Type
nTy : aTy :: Type
aTy : _ <- [Type]
tys
    , _ : xs :: Value
xs : _ <- [Value]
args
    , (_,Type -> TypeView
tyView -> TyConApp vecTcNm :: TyConName
vecTcNm _) <- Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
    , Right n :: Integer
n <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> case Integer
n of
         0  -> let (Just vecTc :: TyCon
vecTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
vecTcNm TyConMap
tcm
                   [nilCon :: DataCon
nilCon,_]   = TyCon -> [DataCon]
tyConDataCons TyCon
vecTc
               in  Term -> Maybe (Heap, Stack, Term)
reduce (DataCon -> Type -> Term
mkVecNil DataCon
nilCon Type
aTy)
         n' :: Integer
n' -> let (Just vecTc :: TyCon
vecTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
vecTcNm TyConMap
tcm
                   [_,consCon :: DataCon
consCon]  = TyCon -> [DataCon]
tyConDataCons TyCon
vecTc
               in  Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$ DataCon -> Type -> Integer -> Term -> Term -> Term
mkVecCons DataCon
consCon Type
aTy Integer
n'
                     (Term -> [Either Term Type] -> Term
mkApps (TyConName -> Term
vecHeadPrim TyConName
vecTcNm)
                             [ Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
n' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 1)))
                             , Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
                             , Term -> Either Term Type
forall a b. a -> Either a b
Left  (Value -> Term
valToTerm Value
xs)
                             ])
                     (Term -> [Either Term Type] -> Term
mkApps (Text -> PrimInfo -> Term
Prim Text
nm PrimInfo
pInfo)
                             [ Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
n' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 1)))
                             , Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
                             , Term -> Either Term Type
forall a b. a -> Either a b
Left  (Literal -> Term
Literal (Integer -> Literal
NaturalLiteral (Integer
n'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                             , Term -> Either Term Type
forall a b. a -> Either a b
Left  (Term -> [Either Term Type] -> Term
mkApps (TyConName -> Term
vecTailPrim TyConName
vecTcNm)
                                             [ Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
n'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                                             , Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
                                             , Term -> Either Term Type
forall a b. a -> Either a b
Left  (Value -> Term
valToTerm Value
xs)
                                             ])
                             ])
-- Traversable
  "Clash.Sized.Vector.traverse#"
    | Bool
isSubj
    , aTy :: Type
aTy : fTy :: Type
fTy : bTy :: Type
bTy : nTy :: Type
nTy : _ <- [Type]
tys
    , apDict :: Value
apDict : f :: Value
f : xs :: Value
xs : _ <- [Value]
args
    , DC dc :: DataCon
dc vArgs :: [Either Term Type]
vArgs <- Value
xs
    , Right n :: Integer
n <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> case Integer
n of
         0 -> let (pureF :: Term
pureF,ids' :: Supply
ids') = PrimEvalMonad Term -> Supply -> (Term, Supply)
forall a. PrimEvalMonad a -> Supply -> (a, Supply)
runPEM ([Char]
-> InScopeSet
-> TyConMap
-> Term
-> Int
-> Int
-> PrimEvalMonad Term
forall (m :: * -> *).
(HasCallStack, Functor m, Monad m, MonadUnique m) =>
[Char] -> InScopeSet -> TyConMap -> Term -> Int -> Int -> m Term
mkSelectorCase $(curLoc) InScopeSet
is0 TyConMap
tcm (Value -> Term
valToTerm Value
apDict) 1 1) Supply
ids
              in  Heap -> Term -> Maybe (Heap, Stack, Term)
reduceWHNF' (GlobalHeap -> GPureHeap -> PureHeap -> Supply -> InScopeSet -> Heap
Heap GlobalHeap
gh GPureHeap
gbl PureHeap
h' Supply
ids' InScopeSet
is0) (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$
                  Term -> [Either Term Type] -> Term
mkApps Term
pureF
                         [Type -> Either Term Type
forall a b. b -> Either a b
Right (TyConName -> [Type] -> Type
mkTyConApp (TyConName
vecTcNm) [Type
nTy,Type
bTy])
                         ,Term -> Either Term Type
forall a b. a -> Either a b
Left  (DataCon -> Type -> Term
mkVecNil DataCon
dc Type
bTy)]
         _ -> let ((fmapF :: Term
fmapF,apF :: Term
apF),ids' :: Supply
ids') = (PrimEvalMonad (Term, Term) -> Supply -> ((Term, Term), Supply))
-> Supply -> PrimEvalMonad (Term, Term) -> ((Term, Term), Supply)
forall a b c. (a -> b -> c) -> b -> a -> c
flip PrimEvalMonad (Term, Term) -> Supply -> ((Term, Term), Supply)
forall a. PrimEvalMonad a -> Supply -> (a, Supply)
runPEM Supply
ids (PrimEvalMonad (Term, Term) -> ((Term, Term), Supply))
-> PrimEvalMonad (Term, Term) -> ((Term, Term), Supply)
forall a b. (a -> b) -> a -> b
$ do
                    Term
fDict  <- [Char]
-> InScopeSet
-> TyConMap
-> Term
-> Int
-> Int
-> PrimEvalMonad Term
forall (m :: * -> *).
(HasCallStack, Functor m, Monad m, MonadUnique m) =>
[Char] -> InScopeSet -> TyConMap -> Term -> Int -> Int -> m Term
mkSelectorCase $(curLoc) InScopeSet
is0 TyConMap
tcm (Value -> Term
valToTerm Value
apDict) 1 0
                    Term
fmapF' <- [Char]
-> InScopeSet
-> TyConMap
-> Term
-> Int
-> Int
-> PrimEvalMonad Term
forall (m :: * -> *).
(HasCallStack, Functor m, Monad m, MonadUnique m) =>
[Char] -> InScopeSet -> TyConMap -> Term -> Int -> Int -> m Term
mkSelectorCase $(curLoc) InScopeSet
is0 TyConMap
tcm Term
fDict 1 0
                    Term
apF'   <- [Char]
-> InScopeSet
-> TyConMap
-> Term
-> Int
-> Int
-> PrimEvalMonad Term
forall (m :: * -> *).
(HasCallStack, Functor m, Monad m, MonadUnique m) =>
[Char] -> InScopeSet -> TyConMap -> Term -> Int -> Int -> m Term
mkSelectorCase $(curLoc) InScopeSet
is0 TyConMap
tcm (Value -> Term
valToTerm Value
apDict) 1 2
                    (Term, Term) -> PrimEvalMonad (Term, Term)
forall (m :: * -> *) a. Monad m => a -> m a
return (Term
fmapF',Term
apF')
                  n'ty :: Type
n'ty = LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-1))
                  Just (consCoTy :: Type
consCoTy : _) = DataCon -> [Type] -> Maybe [Type]
dataConInstArgTys DataCon
dc [Type
nTy,Type
bTy,Type
n'ty]
              in  Heap -> Term -> Maybe (Heap, Stack, Term)
reduceWHNF' (GlobalHeap -> GPureHeap -> PureHeap -> Supply -> InScopeSet -> Heap
Heap GlobalHeap
gh GPureHeap
gbl PureHeap
h' Supply
ids' InScopeSet
is0) (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$
                  Term -> [Either Term Type] -> Term
mkApps Term
apF
                         [Type -> Either Term Type
forall a b. b -> Either a b
Right (TyConName -> [Type] -> Type
mkTyConApp TyConName
vecTcNm [Type
n'ty,Type
bTy])
                         ,Type -> Either Term Type
forall a b. b -> Either a b
Right (TyConName -> [Type] -> Type
mkTyConApp TyConName
vecTcNm [Type
nTy,Type
bTy])
                         ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> [Either Term Type] -> Term
mkApps Term
fmapF
                                       [Type -> Either Term Type
forall a b. b -> Either a b
Right Type
bTy
                                       ,Type -> Either Term Type
forall a b. b -> Either a b
Right (Type -> Type -> Type
mkFunTy (TyConName -> [Type] -> Type
mkTyConApp TyConName
vecTcNm [Type
n'ty,Type
bTy])
                                                       (TyConName -> [Type] -> Type
mkTyConApp TyConName
vecTcNm [Type
nTy,Type
bTy]))
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
dc)
                                                     [Type -> Either Term Type
forall a b. b -> Either a b
Right Type
nTy
                                                     ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
bTy
                                                     ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
n'ty
                                                     ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Type -> Term
primCo Type
consCoTy)])
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> [Either Term Type] -> Term
mkApps (Value -> Term
valToTerm Value
f)
                                                     [Term -> Either Term Type
forall a b. a -> Either a b
Left ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 1)])
                                       ])
                         ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> [Either Term Type] -> Term
mkApps (Text -> PrimInfo -> Term
Prim Text
nm PrimInfo
pInfo)
                                       [Type -> Either Term Type
forall a b. b -> Either a b
Right Type
aTy
                                       ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
fTy
                                       ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
bTy
                                       ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
n'ty
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
apDict)
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
f)
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 2)
                                       ])
                         ]
    where
      (tyArgs :: [Either TyVar Type]
tyArgs,_)         = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
      TyConApp vecTcNm :: TyConName
vecTcNm _ = Type -> TypeView
tyView ([Either TyVar Type] -> [Type]
forall a b. [Either a b] -> [b]
Either.rights [Either TyVar Type]
tyArgs [Type] -> Int -> Type
forall a. [a] -> Int -> a
!! 2)
      Heap gh :: GlobalHeap
gh gbl :: GPureHeap
gbl h' :: PureHeap
h' ids :: Supply
ids is0 :: InScopeSet
is0 = Heap
h

-- BitPack
  "Clash.Sized.Vector.concatBitVector#"
    | Bool
isSubj
    , nTy :: Type
nTy : mTy :: Type
mTy : _ <- [Type]
tys
    , _  : km :: Value
km  : v :: Value
v : _ <- [Value]
args
    , DC _ vArgs :: [Either Term Type]
vArgs <- Value
v
    , Right n :: Integer
n <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> case Integer
n of
         0  -> let resTyInfo :: (Type, Type, Integer)
resTyInfo = TyConMap -> Type -> [Type] -> (Type, Type, Integer)
extractTySizeInfo TyConMap
tcm Type
ty [Type]
tys
               in  Term -> Maybe (Heap, Stack, Term)
reduce ((Type, Type, Integer) -> Integer -> Integer -> Term
mkBitVectorLit' (Type, Type, Integer)
resTyInfo 0 0)
         n' :: Integer
n' | Right m :: Integer
m <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
mTy)
            , (_,Type -> TypeView
tyView -> TyConApp bvTcNm :: TyConName
bvTcNm _) <- Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
            -> Term -> Maybe (Heap, Stack, Term)
reduceWHNF (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$
               Term -> [Either Term Type] -> Term
mkApps (TyConName -> Term
bvAppendPrim TyConName
bvTcNm)
                 [ Type -> Either Term Type
forall a b. b -> Either a b
Right (TyConName -> [Type] -> Type
mkTyConApp TyConName
typeNatMul [LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
n'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)),Type
mTy])
                 , Type -> Either Term Type
forall a b. b -> Either a b
Right Type
mTy
                 , Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
NaturalLiteral ((Integer
n'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
m)))
                 , Term -> Either Term Type
forall a b. a -> Either a b
Left ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 1)
                 , Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> [Either Term Type] -> Term
mkApps (Text -> PrimInfo -> Term
Prim Text
nm PrimInfo
pInfo)
                                [ Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
n'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                                , Type -> Either Term Type
forall a b. b -> Either a b
Right Type
mTy
                                , Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
NaturalLiteral (Integer
n'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                                , Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
km)
                                , Term -> Either Term Type
forall a b. a -> Either a b
Left ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
vArgs [Term] -> Int -> Term
forall a. [a] -> Int -> a
!! 2)
                                ])
                 ]
         _ -> Maybe (Heap, Stack, Term)
forall a. Maybe a
Nothing
  "Clash.Sized.Vector.unconcatBitVector#"
    | Bool
isSubj
    , nTy :: Type
nTy : mTy :: Type
mTy : _  <- [Type]
tys
    , _  : km :: Value
km  : bv :: Value
bv : _ <- [Value]
args
    , (_,Type -> TypeView
tyView -> TyConApp vecTcNm :: TyConName
vecTcNm [_,bvMTy :: Type
bvMTy]) <- Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
    , TyConApp bvTcNm :: TyConName
bvTcNm _ <- Type -> TypeView
tyView Type
bvMTy
    , Right n :: Integer
n <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> case Integer
n of
         0 ->
          let (Just vecTc :: TyCon
vecTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
vecTcNm TyConMap
tcm
              [nilCon :: DataCon
nilCon,_] = TyCon -> [DataCon]
tyConDataCons TyCon
vecTc
          in  Term -> Maybe (Heap, Stack, Term)
reduce (DataCon -> Type -> Term
mkVecNil DataCon
nilCon (TyConName -> [Type] -> Type
mkTyConApp TyConName
bvTcNm [Type
mTy]))
         n' :: Integer
n' | Right m :: Integer
m <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
mTy) ->
          let Just vecTc :: TyCon
vecTc  = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
vecTcNm TyConMap
tcm
              [_,consCon :: DataCon
consCon] = TyCon -> [DataCon]
tyConDataCons TyCon
vecTc
              tupTcNm :: TyConName
tupTcNm     = TyCon -> TyConName
ghcTyconToTyConName (Boxity -> Int -> TyCon
tupleTyCon Boxity
Boxed 2)
              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
              splitCall :: Term
splitCall   =
                Term -> [Either Term Type] -> Term
mkApps (TyConName -> Term
bvSplitPrim TyConName
bvTcNm)
                       [ Type -> Either Term Type
forall a b. b -> Either a b
Right (TyConName -> [Type] -> Type
mkTyConApp TyConName
typeNatMul [LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
n'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)),Type
mTy])
                       , Type -> Either Term Type
forall a b. b -> Either a b
Right Type
mTy
                       , Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
NaturalLiteral ((Integer
n'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
m)))
                       , Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
bv)
                       ]
              mBVTy :: Type
mBVTy       = TyConName -> [Type] -> Type
mkTyConApp TyConName
bvTcNm [Type
mTy]
              n1BVTy :: Type
n1BVTy      = TyConName -> [Type] -> Type
mkTyConApp TyConName
bvTcNm
                              [TyConName -> [Type] -> Type
mkTyConApp TyConName
typeNatMul
                                [LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
n'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1))
                                ,Type
mTy]]
              -- Guaranteed no capture, so okay to use unsafe name generation
              xNm :: Name a
xNm         = Text -> Int -> Name a
forall a. Text -> Int -> Name a
mkUnsafeSystemName "x" 0
              bvNm :: Name a
bvNm        = Text -> Int -> Name a
forall a. Text -> Int -> Name a
mkUnsafeSystemName "bv'" 1
              xId :: Id
xId         = Type -> TmName -> Id
mkLocalId Type
mBVTy TmName
forall a. Name a
xNm
              bvId :: Id
bvId        = Type -> TmName -> Id
mkLocalId Type
n1BVTy TmName
forall a. Name a
bvNm
              tupPat :: Pat
tupPat      = DataCon -> [TyVar] -> [Id] -> Pat
DataPat DataCon
tupDc [] [Id
xId,Id
bvId]
              xAlt :: (Pat, Term)
xAlt        = (Pat
tupPat, (Id -> Term
Var Id
xId))
              bvAlt :: (Pat, Term)
bvAlt       = (Pat
tupPat, (Id -> Term
Var Id
bvId))

          in  Term -> Maybe (Heap, Stack, Term)
reduce (Term -> Maybe (Heap, Stack, Term))
-> Term -> Maybe (Heap, Stack, Term)
forall a b. (a -> b) -> a -> b
$ DataCon -> Type -> Integer -> Term -> Term -> Term
mkVecCons DataCon
consCon (TyConName -> [Type] -> Type
mkTyConApp TyConName
bvTcNm [Type
mTy]) Integer
n'
                (Term -> Type -> [(Pat, Term)] -> Term
Case Term
splitCall Type
mBVTy [(Pat, Term)
xAlt])
                (Term -> [Either Term Type] -> Term
mkApps (Text -> PrimInfo -> Term
Prim Text
nm PrimInfo
pInfo)
                        [ Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
n'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                        , Type -> Either Term Type
forall a b. b -> Either a b
Right Type
mTy
                        , Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
NaturalLiteral (Integer
n'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                        , Term -> Either Term Type
forall a b. a -> Either a b
Left (Value -> Term
valToTerm Value
km)
                        , Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> Type -> [(Pat, Term)] -> Term
Case Term
splitCall Type
n1BVTy [(Pat, Term)
bvAlt])
                        ])
         _ -> Maybe (Heap, Stack, Term)
forall a. Maybe a
Nothing
  _ -> Maybe (Heap, Stack, Term)
forall a. Maybe a
Nothing
  where
    ty :: Type
ty = PrimInfo -> Type
primType PrimInfo
pInfo

    checkNaturalRange1 :: Type -> Integer -> (Natural -> Natural) -> Term
checkNaturalRange1 nTy :: Type
nTy i :: Integer
i f :: Natural -> Natural
f =
      Type -> [Integer] -> ([Natural] -> Term) -> Term
checkNaturalRange Type
nTy [Integer
i]
        (\[i' :: Natural
i'] -> Natural -> Term
naturalToNaturalLiteral (Natural -> Natural
f Natural
i'))

    checkNaturalRange2 :: Type
-> Integer -> Integer -> (Natural -> Natural -> Natural) -> Term
checkNaturalRange2 nTy :: Type
nTy i :: Integer
i j :: Integer
j f :: Natural -> Natural -> Natural
f =
      Type -> [Integer] -> ([Natural] -> Term) -> Term
checkNaturalRange Type
nTy [Integer
i, Integer
j]
        (\[i' :: Natural
i', j' :: Natural
j'] -> Natural -> Term
naturalToNaturalLiteral (Natural -> Natural -> Natural
f Natural
i' Natural
j'))

    -- Check given integer's range. If any of them are less than zero, give up
    -- and return an undefined type.
    checkNaturalRange
      :: Type
      -- Type of GHC.Natural.Natural ^
      -> [Integer]
      -> ([Natural] -> Term)
      -> Term
    checkNaturalRange :: Type -> [Integer] -> ([Natural] -> Term) -> Term
checkNaturalRange nTy :: Type
nTy natsAsInts :: [Integer]
natsAsInts f :: [Natural] -> Term
f =
      if (Integer -> Bool) -> [Integer] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<0) [Integer]
natsAsInts then
        Type -> Term
undefinedTm Type
nTy
      else
        [Natural] -> Term
f ((Integer -> Natural) -> [Integer] -> [Natural]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Natural
forall a. Num a => Integer -> a
fromInteger [Integer]
natsAsInts)

    reduce :: Term -> Maybe (Heap, Stack, Term)
    reduce :: Term -> Maybe (Heap, Stack, Term)
reduce e :: Term
e = case Term -> Either [Char] Term
forall a. a -> Either [Char] a
isX Term
e of
      Left msg :: [Char]
msg -> [Char] -> Maybe (Heap, Stack, Term) -> Maybe (Heap, Stack, Term)
forall a. [Char] -> a -> a
trace ([[Char]] -> [Char]
unlines ["Warning: Not evaluating constant expression:", Text -> [Char]
forall a. Show a => a -> [Char]
show Text
nm, "Because doing so generates an XException:", [Char]
msg]) Maybe (Heap, Stack, Term)
forall a. Maybe a
Nothing
      Right e' :: Term
e' -> (Heap, Stack, Term) -> Maybe (Heap, Stack, Term)
forall a. a -> Maybe a
Just (Heap
h,Stack
k,Term
e')
    reduceWHNF :: Term -> Maybe (Heap, Stack, Term)
reduceWHNF e :: Term
e = let (h2 :: Heap
h2,[],e' :: Term
e') = PrimEvaluator
-> TyConMap -> Bool -> (Heap, Stack, Term) -> (Heap, Stack, Term)
whnf PrimEvaluator
reduceConstant TyConMap
tcm Bool
isSubj (Heap
h,[],Term
e)
                   in  (Heap, Stack, Term) -> Maybe (Heap, Stack, Term)
forall a. a -> Maybe a
Just (Heap
h2,Stack
k,Term
e')
    reduceWHNF' :: Heap -> Term -> Maybe (Heap, Stack, Term)
reduceWHNF' h' :: Heap
h' e :: Term
e = let (h2 :: Heap
h2,[],e' :: Term
e') = PrimEvaluator
-> TyConMap -> Bool -> (Heap, Stack, Term) -> (Heap, Stack, Term)
whnf PrimEvaluator
reduceConstant TyConMap
tcm Bool
isSubj (Heap
h',[],Term
e)
                       in  (Heap, Stack, Term) -> Maybe (Heap, Stack, Term)
forall a. a -> Maybe a
Just (Heap
h2,Stack
k,Term
e')

    makeUndefinedIf :: Exception e => (e -> Bool) -> Term -> Term
    makeUndefinedIf :: (e -> Bool) -> Term -> Term
makeUndefinedIf wantToHandle :: e -> Bool
wantToHandle tm :: Term
tm =
      case IO (Either e Term) -> Either e Term
forall a. IO a -> a
unsafeDupablePerformIO (IO (Either e Term) -> Either e Term)
-> IO (Either e Term) -> Either e Term
forall a b. (a -> b) -> a -> b
$ (e -> Maybe e) -> IO Term -> IO (Either e Term)
forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> IO (Either b a)
tryJust e -> Maybe e
selectException (Term -> IO Term
forall a. a -> IO a
evaluate (Term -> IO Term) -> Term -> IO Term
forall a b. (a -> b) -> a -> b
$ Term -> Term
forall a. NFData a => a -> a
force Term
tm) of
        Right b :: Term
b -> Term
b
        Left e :: e
e -> [Char] -> Term -> Term
forall a. [Char] -> a -> a
trace (e -> [Char]
forall a. Show a => a -> [Char]
msg e
e) (Type -> Term
undefinedTm Type
resTy)
      where
        resTy :: Type
resTy = TyConMap -> Type -> [Type] -> Type
getResultTy TyConMap
tcm Type
ty [Type]
tys
        selectException :: e -> Maybe e
selectException e :: e
e | e -> Bool
wantToHandle e
e = e -> Maybe e
forall a. a -> Maybe a
Just e
e
                          | Bool
otherwise = Maybe e
forall a. Maybe a
Nothing
        msg :: a -> [Char]
msg e :: a
e = [[Char]] -> [Char]
unlines ["Warning: caught exception: \"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
e [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "\" while trying to evaluate: "
                        , Term -> [Char]
forall p. PrettyPrec p => p -> [Char]
showPpr (Term -> [Either Term Type] -> Term
mkApps (Text -> PrimInfo -> Term
Prim Text
nm PrimInfo
pInfo) ((Value -> Either Term Type) -> [Value] -> [Either Term Type]
forall a b. (a -> b) -> [a] -> [b]
map (Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> Either Term Type)
-> (Value -> Term) -> Value -> Either Term Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Term
valToTerm) [Value]
args))
                        ]

    catchDivByZero :: Term -> Term
catchDivByZero = (ArithException -> Bool) -> Term -> Term
forall e. Exception e => (e -> Bool) -> Term -> Term
makeUndefinedIf (ArithException -> ArithException -> Bool
forall a. Eq a => a -> a -> Bool
==ArithException
DivideByZero)

typedLiterals' :: (Value -> Maybe a) -> [Value] -> [a]
typedLiterals' :: (Value -> Maybe a) -> [Value] -> [a]
typedLiterals' typedLiteral :: Value -> Maybe a
typedLiteral = (Value -> Maybe a) -> [Value] -> [a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Value -> Maybe a
typedLiteral

doubleLiterals' :: [Value] -> [Rational]
doubleLiterals' :: [Value] -> [Rational]
doubleLiterals' = (Value -> Maybe Rational) -> [Value] -> [Rational]
forall a. (Value -> Maybe a) -> [Value] -> [a]
typedLiterals' Value -> Maybe Rational
doubleLiteral
  where
    doubleLiteral :: Value -> Maybe Rational
doubleLiteral x :: Value
x = case Value
x of
      Lit (DoubleLiteral i :: Rational
i) -> Rational -> Maybe Rational
forall a. a -> Maybe a
Just Rational
i
      _ -> Maybe Rational
forall a. Maybe a
Nothing

floatLiterals' :: [Value] -> [Rational]
floatLiterals' :: [Value] -> [Rational]
floatLiterals' = (Value -> Maybe Rational) -> [Value] -> [Rational]
forall a. (Value -> Maybe a) -> [Value] -> [a]
typedLiterals' Value -> Maybe Rational
floatLiteral
  where
    floatLiteral :: Value -> Maybe Rational
floatLiteral x :: Value
x = case Value
x of
      Lit (FloatLiteral i :: Rational
i) -> Rational -> Maybe Rational
forall a. a -> Maybe a
Just Rational
i
      _ -> Maybe Rational
forall a. Maybe a
Nothing

integerLiterals :: [Value] -> Maybe (Integer, Integer)
integerLiterals :: [Value] -> Maybe (Integer, Integer)
integerLiterals args :: [Value]
args = case [Value] -> [Integer]
integerLiterals' [Value]
args of
  [i :: Integer
i,j :: Integer
j] -> (Integer, Integer) -> Maybe (Integer, Integer)
forall a. a -> Maybe a
Just (Integer
i,Integer
j)
  _ -> Maybe (Integer, Integer)
forall a. Maybe a
Nothing

naturalLiterals :: [Value] -> Maybe (Integer, Integer)
naturalLiterals :: [Value] -> Maybe (Integer, Integer)
naturalLiterals args :: [Value]
args = case [Value] -> [Integer]
naturalLiterals' [Value]
args of
  [i :: Integer
i,j :: Integer
j] -> (Integer, Integer) -> Maybe (Integer, Integer)
forall a. a -> Maybe a
Just (Integer
i, Integer
j)
  _ -> Maybe (Integer, Integer)
forall a. Maybe a
Nothing

integerLiterals' :: [Value] -> [Integer]
integerLiterals' :: [Value] -> [Integer]
integerLiterals' = (Value -> Maybe Integer) -> [Value] -> [Integer]
forall a. (Value -> Maybe a) -> [Value] -> [a]
typedLiterals' Value -> Maybe Integer
integerLiteral

naturalLiterals' :: [Value] -> [Integer]
naturalLiterals' :: [Value] -> [Integer]
naturalLiterals' = (Value -> Maybe Integer) -> [Value] -> [Integer]
forall a. (Value -> Maybe a) -> [Value] -> [a]
typedLiterals' Value -> Maybe Integer
naturalLiteral

intLiterals :: [Value] -> Maybe (Integer,Integer)
intLiterals :: [Value] -> Maybe (Integer, Integer)
intLiterals args :: [Value]
args = case [Value]
args of
  [Lit (IntLiteral i :: Integer
i), Lit (IntLiteral j :: Integer
j)] -> (Integer, Integer) -> Maybe (Integer, Integer)
forall a. a -> Maybe a
Just (Integer
i,Integer
j)
  _ -> Maybe (Integer, Integer)
forall a. Maybe a
Nothing

intLiterals' :: [Value] -> [Integer]
intLiterals' :: [Value] -> [Integer]
intLiterals' = (Value -> Maybe Integer) -> [Value] -> [Integer]
forall a. (Value -> Maybe a) -> [Value] -> [a]
typedLiterals' Value -> Maybe Integer
intLiteral
  where
    intLiteral :: Value -> Maybe Integer
intLiteral x :: Value
x = case Value
x of
      Lit (IntLiteral i :: Integer
i) -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i
      _ -> Maybe Integer
forall a. Maybe a
Nothing

intCLiteral :: Value -> Maybe Integer
intCLiteral :: Value -> Maybe Integer
intCLiteral (DC _ [Left (Literal (IntLiteral i :: Integer
i))]) = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i
intCLiteral _                                      = Maybe Integer
forall a. Maybe a
Nothing

intCLiterals :: [Value] -> Maybe (Integer, Integer)
intCLiterals :: [Value] -> Maybe (Integer, Integer)
intCLiterals (a1 :: Value
a1:a2 :: Value
a2:_) = (Integer -> Integer -> (Integer, Integer))
-> Maybe Integer -> Maybe Integer -> Maybe (Integer, Integer)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (Value -> Maybe Integer
intCLiteral Value
a1) (Value -> Maybe Integer
intCLiteral Value
a2)
intCLiterals _         = Maybe (Integer, Integer)
forall a. Maybe a
Nothing

intCLiterals' :: [Value] -> [Integer]
intCLiterals' :: [Value] -> [Integer]
intCLiterals' = [Maybe Integer] -> [Integer]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Integer] -> [Integer])
-> ([Value] -> [Maybe Integer]) -> [Value] -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Maybe Integer) -> [Value] -> [Maybe Integer]
forall a b. (a -> b) -> [a] -> [b]
map Value -> Maybe Integer
intCLiteral

mkIntCLiteral
  :: HasCallStack
  => Value
  -- ^ Some existing intC literal. To construct a new intC literal, this
  -- function needs the dataconstructor.
  -> Integer
  -- ^ New value of intC literal
  -> Term
mkIntCLiteral :: Value -> Integer -> Term
mkIntCLiteral (DC dc :: DataCon
dc [Left (Literal (IntLiteral _))]) i :: Integer
i =
  Term -> Term -> Term
App (DataCon -> Term
Data DataCon
dc) (Literal -> Term
Literal (Integer -> Literal
IntLiteral Integer
i))
mkIntCLiteral v :: Value
v _i :: Integer
_i =
  [Char] -> Term
forall a. HasCallStack => [Char] -> a
error ([Char] -> Term) -> [Char] -> Term
forall a b. (a -> b) -> a -> b
$ "Report as bug: mkIntCLiteral was called with wrong value: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Value -> [Char]
forall a. Show a => a -> [Char]
show Value
v

wordLiterals :: [Value] -> Maybe (Integer,Integer)
wordLiterals :: [Value] -> Maybe (Integer, Integer)
wordLiterals args :: [Value]
args = case [Value]
args of
  [Lit (WordLiteral i :: Integer
i), Lit (WordLiteral j :: Integer
j)] -> (Integer, Integer) -> Maybe (Integer, Integer)
forall a. a -> Maybe a
Just (Integer
i,Integer
j)
  _ -> Maybe (Integer, Integer)
forall a. Maybe a
Nothing
wordLiterals' :: [Value] -> [Integer]
wordLiterals' :: [Value] -> [Integer]
wordLiterals' = (Value -> Maybe Integer) -> [Value] -> [Integer]
forall a. (Value -> Maybe a) -> [Value] -> [a]
typedLiterals' Value -> Maybe Integer
wordLiteral
  where
    wordLiteral :: Value -> Maybe Integer
wordLiteral x :: Value
x = case Value
x of
      Lit (WordLiteral i :: Integer
i) -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i
      _ -> Maybe Integer
forall a. Maybe a
Nothing

charLiterals :: [Value] -> Maybe (Char,Char)
charLiterals :: [Value] -> Maybe (Char, Char)
charLiterals args :: [Value]
args = case [Value]
args of
  [Lit (CharLiteral i :: Char
i), Lit (CharLiteral j :: Char
j)] -> (Char, Char) -> Maybe (Char, Char)
forall a. a -> Maybe a
Just (Char
i,Char
j)
  _ -> Maybe (Char, Char)
forall a. Maybe a
Nothing

charLiterals' :: [Value] -> [Char]
charLiterals' :: [Value] -> [Char]
charLiterals' = (Value -> Maybe Char) -> [Value] -> [Char]
forall a. (Value -> Maybe a) -> [Value] -> [a]
typedLiterals' Value -> Maybe Char
charLiteral
  where
    charLiteral :: Value -> Maybe Char
charLiteral x :: Value
x = case Value
x of
      Lit (CharLiteral c :: Char
c) -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c
      _ -> Maybe Char
forall a. Maybe a
Nothing

sizedLiterals :: Text -> [Value] -> Maybe (Integer,Integer)
sizedLiterals :: Text -> [Value] -> Maybe (Integer, Integer)
sizedLiterals szCon :: Text
szCon args :: [Value]
args
  = case [Value]
args of
      ([ PrimVal nm :: Text
nm  _ _ [_, Lit (IntegerLiteral i :: Integer
i)]
       , PrimVal nm' :: Text
nm' _ _ [_, Lit (IntegerLiteral j :: Integer
j)]])
        | Text
nm  Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
szCon
        , Text
nm' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
szCon -> (Integer, Integer) -> Maybe (Integer, Integer)
forall a. a -> Maybe a
Just (Integer
i,Integer
j)
      _ -> Maybe (Integer, Integer)
forall a. Maybe a
Nothing

sizedLiterals' :: Text -> [Value] -> [Integer]
sizedLiterals' :: Text -> [Value] -> [Integer]
sizedLiterals' szCon :: Text
szCon = (Value -> Maybe Integer) -> [Value] -> [Integer]
forall a. (Value -> Maybe a) -> [Value] -> [a]
typedLiterals' (Text -> Value -> Maybe Integer
sizedLiteral Text
szCon)

sizedLiteral :: Text -> Value -> Maybe Integer
sizedLiteral :: Text -> Value -> Maybe Integer
sizedLiteral szCon :: Text
szCon val :: Value
val = case Value
val of
  PrimVal nm :: Text
nm  _ _ [_, Lit (IntegerLiteral i :: Integer
i)] | Text
nm Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
szCon -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i
  _ -> Maybe Integer
forall a. Maybe a
Nothing

bitLiterals
  :: [Value]
  -> [(Integer,Integer)]
bitLiterals :: [Value] -> [(Integer, Integer)]
bitLiterals = ((Integer, Integer) -> (Integer, Integer))
-> [(Integer, Integer)] -> [(Integer, Integer)]
forall a b. (a -> b) -> [a] -> [b]
map (Integer, Integer) -> (Integer, Integer)
forall a b. (Bits a, Bits b, Num a, Num b) => (a, b) -> (a, b)
normalizeBit ([(Integer, Integer)] -> [(Integer, Integer)])
-> ([Value] -> [(Integer, Integer)])
-> [Value]
-> [(Integer, Integer)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Maybe (Integer, Integer))
-> [Value] -> [(Integer, Integer)]
forall a. (Value -> Maybe a) -> [Value] -> [a]
typedLiterals' Value -> Maybe (Integer, Integer)
go
 where
  normalizeBit :: (a, b) -> (a, b)
normalizeBit (msk :: a
msk,v :: b
v) = (a
msk a -> a -> a
forall a. Bits a => a -> a -> a
.&. 1, b
v b -> b -> b
forall a. Bits a => a -> a -> a
.&. 1)
  go :: Value -> Maybe (Integer, Integer)
go val :: Value
val = case Value
val of
    PrimVal nm :: Text
nm _ _ [Lit (IntegerLiteral m :: Integer
m), Lit (IntegerLiteral i :: Integer
i)]
      | Text
nm Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "Clash.Sized.Internal.BitVector.fromInteger##"
      -> (Integer, Integer) -> Maybe (Integer, Integer)
forall a. a -> Maybe a
Just (Integer
m,Integer
i)
    _ -> Maybe (Integer, Integer)
forall a. Maybe a
Nothing

indexLiterals, signedLiterals, unsignedLiterals
  :: [Value] -> Maybe (Integer,Integer)
indexLiterals :: [Value] -> Maybe (Integer, Integer)
indexLiterals     = Text -> [Value] -> Maybe (Integer, Integer)
sizedLiterals "Clash.Sized.Internal.Index.fromInteger#"
signedLiterals :: [Value] -> Maybe (Integer, Integer)
signedLiterals    = Text -> [Value] -> Maybe (Integer, Integer)
sizedLiterals "Clash.Sized.Internal.Signed.fromInteger#"
unsignedLiterals :: [Value] -> Maybe (Integer, Integer)
unsignedLiterals  = Text -> [Value] -> Maybe (Integer, Integer)
sizedLiterals "Clash.Sized.Internal.Unsigned.fromInteger#"

bitVectorLiterals
  :: [Value] -> Maybe ((Integer,Integer),(Integer,Integer))
bitVectorLiterals :: [Value] -> Maybe ((Integer, Integer), (Integer, Integer))
bitVectorLiterals args :: [Value]
args
  = case [Value]
args of
      ([ PrimVal nm :: Text
nm  _ _ [_, Lit (IntegerLiteral mi :: Integer
mi), Lit (IntegerLiteral i :: Integer
i)]
       , PrimVal nm' :: Text
nm' _ _ [_, Lit (IntegerLiteral mj :: Integer
mj), Lit (IntegerLiteral j :: Integer
j)]])
        | Text
nm  Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "Clash.Sized.Internal.BitVector.fromInteger#"
        , Text
nm' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "Clash.Sized.Internal.BitVector.fromInteger#" -> ((Integer, Integer), (Integer, Integer))
-> Maybe ((Integer, Integer), (Integer, Integer))
forall a. a -> Maybe a
Just ((Integer
mi,Integer
i),(Integer
mj,Integer
j))
      _ -> Maybe ((Integer, Integer), (Integer, Integer))
forall a. Maybe a
Nothing

indexLiterals', signedLiterals', unsignedLiterals'
  :: [Value] -> [Integer]
indexLiterals' :: [Value] -> [Integer]
indexLiterals'     = Text -> [Value] -> [Integer]
sizedLiterals' "Clash.Sized.Internal.Index.fromInteger#"
signedLiterals' :: [Value] -> [Integer]
signedLiterals'    = Text -> [Value] -> [Integer]
sizedLiterals' "Clash.Sized.Internal.Signed.fromInteger#"
unsignedLiterals' :: [Value] -> [Integer]
unsignedLiterals'  = Text -> [Value] -> [Integer]
sizedLiterals' "Clash.Sized.Internal.Unsigned.fromInteger#"

bitVectorLiterals'
  :: [Value] -> [(Integer,Integer)]
bitVectorLiterals' :: [Value] -> [(Integer, Integer)]
bitVectorLiterals' = (Value -> Maybe (Integer, Integer))
-> [Value] -> [(Integer, Integer)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Value -> Maybe (Integer, Integer)
go
 where
  go :: Value -> Maybe (Integer,Integer)
  go :: Value -> Maybe (Integer, Integer)
go val :: Value
val = case Value
val of
    PrimVal nm :: Text
nm  _ _ [_, Lit (IntegerLiteral mi :: Integer
mi), Lit (IntegerLiteral i :: Integer
i)]
      | Text
nm Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "Clash.Sized.Internal.BitVector.fromInteger#" -> (Integer, Integer) -> Maybe (Integer, Integer)
forall a. a -> Maybe a
Just (Integer
mi, Integer
i)
    _ -> Maybe (Integer, Integer)
forall a. Maybe a
Nothing

toBV :: (Integer,Integer) -> BitVector n
toBV :: (Integer, Integer) -> BitVector n
toBV = (Integer -> Integer -> BitVector n)
-> (Integer, Integer) -> BitVector n
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Integer -> Integer -> BitVector n
forall (n :: Nat). Integer -> Integer -> BitVector n
BV

splitBV :: BitVector n -> (Integer,Integer)
splitBV :: BitVector n -> (Integer, Integer)
splitBV (BV msk :: Integer
msk val :: Integer
val) = (Integer
msk,Integer
val)

valArgs
  :: Value
  -> Maybe [Term]
valArgs :: Value -> Maybe [Term]
valArgs (PrimVal _ _ _ vs :: [Value]
vs) = [Term] -> Maybe [Term]
forall a. a -> Maybe a
Just ((Value -> Term) -> [Value] -> [Term]
forall a b. (a -> b) -> [a] -> [b]
map Value -> Term
valToTerm [Value]
vs)
valArgs (DC _ args :: [Either Term Type]
args)        = [Term] -> Maybe [Term]
forall a. a -> Maybe a
Just ([Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts [Either Term Type]
args)
valArgs _                  = Maybe [Term]
forall a. Maybe a
Nothing


-- Tries to match literal arguments to a function like
--   (Unsigned.shiftL#  :: forall n. KnownNat n => Unsigned n -> Int -> Unsigned n)
sizedLitIntLit
  :: Text -> TyConMap -> [Type] -> [Value]
  -> Maybe (Type,Integer,Integer,Integer)
sizedLitIntLit :: Text
-> TyConMap
-> [Type]
-> [Value]
-> Maybe (Type, Integer, Integer, Integer)
sizedLitIntLit szCon :: Text
szCon tcm :: TyConMap
tcm tys :: [Type]
tys args :: [Value]
args
  | Just (nTy :: Type
nTy,kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
  , [_
    ,PrimVal nm :: Text
nm _ _ [_,Lit (IntegerLiteral i :: Integer
i)]
    ,Value -> Maybe [Term]
valArgs -> Just [Literal (IntLiteral j :: Integer
j)]
    ] <- [Value]
args
  , Text
nm Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
szCon
  = (Type, Integer, Integer, Integer)
-> Maybe (Type, Integer, Integer, Integer)
forall a. a -> Maybe a
Just (Type
nTy,Integer
kn,Integer
i,Integer
j)
  | Bool
otherwise
  = Maybe (Type, Integer, Integer, Integer)
forall a. Maybe a
Nothing

signedLitIntLit, unsignedLitIntLit
  :: TyConMap -> [Type] -> [Value]
  -> Maybe (Type,Integer,Integer,Integer)
signedLitIntLit :: TyConMap
-> [Type] -> [Value] -> Maybe (Type, Integer, Integer, Integer)
signedLitIntLit    = Text
-> TyConMap
-> [Type]
-> [Value]
-> Maybe (Type, Integer, Integer, Integer)
sizedLitIntLit "Clash.Sized.Internal.Signed.fromInteger#"
unsignedLitIntLit :: TyConMap
-> [Type] -> [Value] -> Maybe (Type, Integer, Integer, Integer)
unsignedLitIntLit  = Text
-> TyConMap
-> [Type]
-> [Value]
-> Maybe (Type, Integer, Integer, Integer)
sizedLitIntLit "Clash.Sized.Internal.Unsigned.fromInteger#"

bitVectorLitIntLit
  :: TyConMap -> [Type] -> [Value]
  -> Maybe (Type,Integer,(Integer,Integer),Integer)
bitVectorLitIntLit :: TyConMap
-> [Type]
-> [Value]
-> Maybe (Type, Integer, (Integer, Integer), Integer)
bitVectorLitIntLit tcm :: TyConMap
tcm tys :: [Type]
tys args :: [Value]
args
  | Just (nTy :: Type
nTy,kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
  , [_
    ,PrimVal nm :: Text
nm _ _ [_,Lit (IntegerLiteral m :: Integer
m),Lit (IntegerLiteral i :: Integer
i)]
    ,Value -> Maybe [Term]
valArgs -> Just [Literal (IntLiteral j :: Integer
j)]
    ] <- [Value]
args
  , Text
nm Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "Clash.Sized.Internal.BitVector.fromInteger#"
  = (Type, Integer, (Integer, Integer), Integer)
-> Maybe (Type, Integer, (Integer, Integer), Integer)
forall a. a -> Maybe a
Just (Type
nTy,Integer
kn,(Integer
m,Integer
i),Integer
j)
  | Bool
otherwise
  = Maybe (Type, Integer, (Integer, Integer), Integer)
forall a. Maybe a
Nothing

-- From an argument list to function of type
--   forall n. KnownNat n => ...
-- extract (nTy,nInt)
-- where nTy is the Type of n
-- and   nInt is its value as an Integer
extractKnownNat :: TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat :: TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat tcm :: TyConMap
tcm tys :: [Type]
tys = case [Type]
tys of
  nTy :: Type
nTy : _ | Right nInt :: Integer
nInt <- Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> (Type, Integer) -> Maybe (Type, Integer)
forall a. a -> Maybe a
Just (Type
nTy, Integer
nInt)
  _ -> Maybe (Type, Integer)
forall a. Maybe a
Nothing

extractKnownNatVal :: TyConMap -> [Type] -> Maybe Integer
extractKnownNatVal :: TyConMap -> [Type] -> Maybe Integer
extractKnownNatVal tcm :: TyConMap
tcm tys :: [Type]
tys = ((Type, Integer) -> Integer)
-> Maybe (Type, Integer) -> Maybe Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Type, Integer) -> Integer
forall a b. (a, b) -> b
snd (TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys)

-- From an argument list to function of type
--   forall n m o .. . (KnownNat n, KnownNat m, KnownNat o, ..) => ...
-- extract [(nTy,nInt), (mTy,mInt), (oTy,oInt)]
-- where nTy is the Type of n
-- and   nInt is its value as an Integer
extractKnownNats :: TyConMap -> [Type] -> [(Type, Integer)]
extractKnownNats :: TyConMap -> [Type] -> [(Type, Integer)]
extractKnownNats tcm :: TyConMap
tcm tys :: [Type]
tys =
  [Maybe (Type, Integer)] -> [(Type, Integer)]
forall a. [Maybe a] -> [a]
catMaybes ((Type -> Maybe (Type, Integer))
-> [Type] -> [Maybe (Type, Integer)]
forall a b. (a -> b) -> [a] -> [b]
map (TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm ([Type] -> Maybe (Type, Integer))
-> (Type -> [Type]) -> Type -> Maybe (Type, Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> [Type]
forall (f :: * -> *) a. Applicative f => a -> f a
pure)  [Type]
tys)

extractKnownNatVals :: TyConMap -> [Type] -> [Integer]
extractKnownNatVals :: TyConMap -> [Type] -> [Integer]
extractKnownNatVals tcm :: TyConMap
tcm tys :: [Type]
tys = ((Type, Integer) -> Integer) -> [(Type, Integer)] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Type, Integer) -> Integer
forall a b. (a, b) -> b
snd (TyConMap -> [Type] -> [(Type, Integer)]
extractKnownNats TyConMap
tcm [Type]
tys)

-- Construct a constant term of a sized type
mkSizedLit
  :: (Type -> Term)
  -- ^ Type constructor?
  -> Type
  -- ^ Result type
  -> Type
  -- ^ forall n.
  -> Integer
  -- ^ KnownNat n
  -> Integer
  -- ^ Value to construct
  -> Term
mkSizedLit :: (Type -> Term) -> Type -> Type -> Integer -> Integer -> Term
mkSizedLit conPrim :: Type -> Term
conPrim ty :: Type
ty nTy :: Type
nTy kn :: Integer
kn val :: Integer
val =
  Term -> [Either Term Type] -> Term
mkApps
    (Type -> Term
conPrim Type
sTy)
    [ Type -> Either Term Type
forall a b. b -> Either a b
Right Type
nTy
    , Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
NaturalLiteral Integer
kn))
    , Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
IntegerLiteral Integer
val)) ]
 where
    (_,sTy :: Type
sTy) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty

mkBitLit
  :: Type
  -- ^ Result type
  -> Integer
  -- ^ Mask
  -> Integer
  -- ^ Value
  -> Term
mkBitLit :: Type -> Integer -> Integer -> Term
mkBitLit ty :: Type
ty msk :: Integer
msk val :: Integer
val =
  Term -> [Either Term Type] -> Term
mkApps (Type -> Term
bConPrim Type
sTy) [ Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
IntegerLiteral (Integer
msk Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. 1)))
                        , Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
IntegerLiteral (Integer
val Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. 1)))]
  where
    (_,sTy :: Type
sTy) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty

mkSignedLit, mkUnsignedLit
  :: Type
  -- Result type
  -> Type
  -- forall n.
  -> Integer
  -- KnownNat n
  -> Integer
  -- Value
  -> Term
mkSignedLit :: Type -> Type -> Integer -> Integer -> Term
mkSignedLit    = (Type -> Term) -> Type -> Type -> Integer -> Integer -> Term
mkSizedLit Type -> Term
signedConPrim
mkUnsignedLit :: Type -> Type -> Integer -> Integer -> Term
mkUnsignedLit  = (Type -> Term) -> Type -> Type -> Integer -> Integer -> Term
mkSizedLit Type -> Term
unsignedConPrim

mkBitVectorLit
  :: Type
  -- ^ Result type
  -> Type
  -- ^ forall n.
  -> Integer
  -- ^ KnownNat n
  -> Integer
  -- ^ mask
  -> Integer
  -- ^ Value to construct
  -> Term
mkBitVectorLit :: Type -> Type -> Integer -> Integer -> Integer -> Term
mkBitVectorLit ty :: Type
ty nTy :: Type
nTy kn :: Integer
kn mask :: Integer
mask val :: Integer
val
  = Term -> [Either Term Type] -> Term
mkApps (Type -> Term
bvConPrim Type
sTy)
           [Type -> Either Term Type
forall a b. b -> Either a b
Right Type
nTy
           ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
NaturalLiteral Integer
kn))
           ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
IntegerLiteral Integer
mask))
           ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
IntegerLiteral Integer
val))]
  where
    (_,sTy :: Type
sTy) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty

mkIndexLitE
  :: Type
  -- ^ Result type
  -> Type
  -- ^ forall n.
  -> Integer
  -- ^ KnownNat n
  -> Integer
  -- ^ Value to construct
  -> Either Term Term
  -- ^ Either undefined (if given value is out of bounds of given type) or term
  -- representing literal
mkIndexLitE :: Type -> Type -> Integer -> Integer -> Either Term Term
mkIndexLitE rTy :: Type
rTy nTy :: Type
nTy kn :: Integer
kn val :: Integer
val
  | Integer
val Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= 0
  , Integer
val Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
kn
  = Term -> Either Term Term
forall a b. b -> Either a b
Right ((Type -> Term) -> Type -> Type -> Integer -> Integer -> Term
mkSizedLit Type -> Term
indexConPrim Type
rTy Type
nTy Integer
kn Integer
val)
  | Bool
otherwise
  = Term -> Either Term Term
forall a b. a -> Either a b
Left (Type -> Term
undefinedTm (TyConName -> [Type] -> Type
mkTyConApp TyConName
indexTcNm [Type
nTy]))
  where
    TyConApp indexTcNm :: TyConName
indexTcNm _ = Type -> TypeView
tyView (([Either TyVar Type], Type) -> Type
forall a b. (a, b) -> b
snd (Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
rTy))

mkIndexLit
  :: Type
  -- ^ Result type
  -> Type
  -- ^ forall n.
  -> Integer
  -- ^ KnownNat n
  -> Integer
  -- ^ Value to construct
  -> Term
mkIndexLit :: Type -> Type -> Integer -> Integer -> Term
mkIndexLit rTy :: Type
rTy nTy :: Type
nTy kn :: Integer
kn val :: Integer
val =
  (Term -> Term) -> (Term -> Term) -> Either Term Term -> Term
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Term -> Term
forall a. a -> a
id Term -> Term
forall a. a -> a
id (Type -> Type -> Integer -> Integer -> Either Term Term
mkIndexLitE Type
rTy Type
nTy Integer
kn Integer
val)

-- | Construct a constant term of a sized type
mkSizedLit'
  :: (Type -> Term)
  -- ^ Type constructor?
  -> (Type, Type, Integer)
  -- ^ (result type, forall n., KnownNat n)
  -> Integer
  -- ^ Value to construct
  -> Term
mkSizedLit' :: (Type -> Term) -> (Type, Type, Integer) -> Integer -> Term
mkSizedLit' conPrim :: Type -> Term
conPrim (ty :: Type
ty,nTy :: Type
nTy,kn :: Integer
kn) = (Type -> Term) -> Type -> Type -> Integer -> Integer -> Term
mkSizedLit Type -> Term
conPrim Type
ty Type
nTy Integer
kn

mkSignedLit', mkUnsignedLit'
  :: (Type, Type, Integer)
  -- ^ (result type, forall n., KnownNat n)
  -> Integer
  -- ^ Value to construct
  -> Term
mkSignedLit' :: (Type, Type, Integer) -> Integer -> Term
mkSignedLit'    = (Type -> Term) -> (Type, Type, Integer) -> Integer -> Term
mkSizedLit' Type -> Term
signedConPrim
mkUnsignedLit' :: (Type, Type, Integer) -> Integer -> Term
mkUnsignedLit'  = (Type -> Term) -> (Type, Type, Integer) -> Integer -> Term
mkSizedLit' Type -> Term
unsignedConPrim

mkBitVectorLit'
  :: (Type, Type, Integer)
  -- ^ (result type, forall n., KnownNat n)
  -> Integer
  -- ^ Mask
  -> Integer
  -- ^ Value
  -> Term
mkBitVectorLit' :: (Type, Type, Integer) -> Integer -> Integer -> Term
mkBitVectorLit' (ty :: Type
ty,nTy :: Type
nTy,kn :: Integer
kn) = Type -> Type -> Integer -> Integer -> Integer -> Term
mkBitVectorLit Type
ty Type
nTy Integer
kn

mkIndexLit'
  :: (Type, Type, Integer)
  -- ^ (result type, forall n., KnownNat n)
  -> Integer
  -- ^ value
  -> Term
mkIndexLit' :: (Type, Type, Integer) -> Integer -> Term
mkIndexLit' (rTy :: Type
rTy,nTy :: Type
nTy,kn :: Integer
kn) = Type -> Type -> Integer -> Integer -> Term
mkIndexLit Type
rTy Type
nTy Integer
kn

-- | Create a vector of supplied elements
mkVecCons
  :: DataCon
  -- ^ The Cons (:>) constructor
  -> Type
  -- ^ Element type
  -> Integer
  -- ^ Length of the vector
  -> Term
  -- ^ head of the vector
  -> Term
  -- ^ tail of the vector
  -> Term
mkVecCons :: DataCon -> Type -> Integer -> Term -> Term -> Term
mkVecCons consCon :: DataCon
consCon resTy :: Type
resTy n :: Integer
n h :: Term
h t :: Term
t =
  Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
consCon) [Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy Integer
n))
                        ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
resTy
                        ,Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-1)))
                        ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Type -> Term
primCo Type
consCoTy)
                        ,Term -> Either Term Type
forall a b. a -> Either a b
Left Term
h
                        ,Term -> Either Term Type
forall a b. a -> Either a b
Left Term
t]

  where
    args :: Maybe [Type]
args = DataCon -> [Type] -> Maybe [Type]
dataConInstArgTys DataCon
consCon [LitTy -> Type
LitTy (Integer -> LitTy
NumTy Integer
n),Type
resTy,LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-1))]
    Just (consCoTy :: Type
consCoTy : _) = Maybe [Type]
args

-- | Create an empty vector
mkVecNil
  :: DataCon
  -- ^ The Nil constructor
  -> Type
  -- ^ The element type
  -> Term
mkVecNil :: DataCon -> Type -> Term
mkVecNil nilCon :: DataCon
nilCon resTy :: Type
resTy =
  Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
nilCon) [Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy 0))
                       ,Type -> Either Term Type
forall a b. b -> Either a b
Right Type
resTy
                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left  (Type -> Term
primCo Type
nilCoTy)
                       ]
  where
    args :: Maybe [Type]
args = DataCon -> [Type] -> Maybe [Type]
dataConInstArgTys DataCon
nilCon [LitTy -> Type
LitTy (Integer -> LitTy
NumTy 0),Type
resTy]
    Just (nilCoTy :: Type
nilCoTy : _ ) = Maybe [Type]
args

boolToIntLiteral :: Bool -> Term
boolToIntLiteral :: Bool -> Term
boolToIntLiteral b :: Bool
b = if Bool
b then Literal -> Term
Literal (Integer -> Literal
IntLiteral 1) else Literal -> Term
Literal (Integer -> Literal
IntLiteral 0)

boolToBoolLiteral :: TyConMap -> Type -> Bool -> Term
boolToBoolLiteral :: TyConMap -> Type -> Bool -> Term
boolToBoolLiteral tcm :: TyConMap
tcm ty :: Type
ty b :: Bool
b =
 let (_,Type -> TypeView
tyView -> TyConApp boolTcNm :: TyConName
boolTcNm []) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
     (Just boolTc :: TyCon
boolTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
lookupUniqMap TyConName
boolTcNm TyConMap
tcm
     [falseDc :: DataCon
falseDc,trueDc :: DataCon
trueDc] = TyCon -> [DataCon]
tyConDataCons TyCon
boolTc
     retDc :: DataCon
retDc = if Bool
b then DataCon
trueDc else DataCon
falseDc
 in  DataCon -> Term
Data DataCon
retDc

charToCharLiteral :: Char -> Term
charToCharLiteral :: Char -> Term
charToCharLiteral = Literal -> Term
Literal (Literal -> Term) -> (Char -> Literal) -> Char -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Literal
CharLiteral

integerToIntLiteral :: Integer -> Term
integerToIntLiteral :: Integer -> Term
integerToIntLiteral = Literal -> Term
Literal (Literal -> Term) -> (Integer -> Literal) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral (Integer -> Literal) -> (Integer -> Integer) -> Integer -> Literal
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
. (Integer -> Int
forall a. Num a => Integer -> a
fromInteger :: Integer -> Int) -- for overflow behavior

integerToWordLiteral :: Integer -> Term
integerToWordLiteral :: Integer -> Term
integerToWordLiteral = Literal -> Term
Literal (Literal -> Term) -> (Integer -> Literal) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
WordLiteral (Integer -> Literal) -> (Integer -> Integer) -> Integer -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Integer
forall a. Integral a => a -> Integer
toInteger (Word -> Integer) -> (Integer -> Word) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Word
forall a. Num a => Integer -> a
fromInteger :: Integer -> Word) -- for overflow behavior

integerToIntegerLiteral :: Integer -> Term
integerToIntegerLiteral :: Integer -> Term
integerToIntegerLiteral = Literal -> Term
Literal (Literal -> Term) -> (Integer -> Literal) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntegerLiteral

naturalToNaturalLiteral :: Natural -> Term
naturalToNaturalLiteral :: Natural -> Term
naturalToNaturalLiteral = Literal -> Term
Literal (Literal -> Term) -> (Natural -> Literal) -> Natural -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
NaturalLiteral (Integer -> Literal) -> (Natural -> Integer) -> Natural -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Integer
forall a. Integral a => a -> Integer
toInteger

bConPrim :: Type -> Term
bConPrim :: Type -> Term
bConPrim (Type -> TypeView
tyView -> TyConApp bTcNm :: TyConName
bTcNm _)
  = Text -> PrimInfo -> Term
Prim "Clash.Sized.Internal.BitVector.fromInteger##" (Type -> WorkInfo -> PrimInfo
PrimInfo Type
funTy WorkInfo
WorkNever)
  where
    funTy :: Type
funTy      = (Type -> Type -> Type) -> [Type] -> Type
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Type -> Type -> Type
mkFunTy [Type
integerPrimTy,Type
integerPrimTy,TyConName -> [Type] -> Type
mkTyConApp TyConName
bTcNm []]
bConPrim _ = [Char] -> Term
forall a. HasCallStack => [Char] -> a
error ([Char] -> Term) -> [Char] -> Term
forall a b. (a -> b) -> a -> b
$ $(curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "called with incorrect type"

bvConPrim :: Type -> Term
bvConPrim :: Type -> Term
bvConPrim (Type -> TypeView
tyView -> TyConApp bvTcNm :: TyConName
bvTcNm _)
  = Text -> PrimInfo -> Term
Prim "Clash.Sized.Internal.BitVector.fromInteger#" (Type -> WorkInfo -> PrimInfo
PrimInfo (TyVar -> Type -> Type
ForAllTy TyVar
nTV Type
funTy) WorkInfo
WorkNever)
  where
    funTy :: Type
funTy = (Type -> Type -> Type) -> [Type] -> Type
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Type -> Type -> Type
mkFunTy [Type
naturalPrimTy,Type
integerPrimTy,Type
integerPrimTy,TyConName -> [Type] -> Type
mkTyConApp TyConName
bvTcNm [Type
nVar]]
    nName :: Name a
nName = Text -> Int -> Name a
forall a. Text -> Int -> Name a
mkUnsafeSystemName "n" 0
    nVar :: Type
nVar  = TyVar -> Type
VarTy TyVar
nTV
    nTV :: TyVar
nTV   = Type -> TyName -> TyVar
mkTyVar Type
typeNatKind TyName
forall a. Name a
nName
bvConPrim _ = [Char] -> Term
forall a. HasCallStack => [Char] -> a
error ([Char] -> Term) -> [Char] -> Term
forall a b. (a -> b) -> a -> b
$ $(curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "called with incorrect type"

indexConPrim :: Type -> Term
indexConPrim :: Type -> Term
indexConPrim (Type -> TypeView
tyView -> TyConApp indexTcNm :: TyConName
indexTcNm _)
  = Text -> PrimInfo -> Term
Prim "Clash.Sized.Internal.Index.fromInteger#" (Type -> WorkInfo -> PrimInfo
PrimInfo (TyVar -> Type -> Type
ForAllTy TyVar
nTV Type
funTy) WorkInfo
WorkNever)
  where
    funTy :: Type
funTy        = (Type -> Type -> Type) -> [Type] -> Type
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Type -> Type -> Type
mkFunTy [Type
naturalPrimTy,Type
integerPrimTy,TyConName -> [Type] -> Type
mkTyConApp TyConName
indexTcNm [Type
nVar]]
    nName :: Name a
nName      = Text -> Int -> Name a
forall a. Text -> Int -> Name a
mkUnsafeSystemName "n" 0
    nVar :: Type
nVar       = TyVar -> Type
VarTy TyVar
nTV
    nTV :: TyVar
nTV        = Type -> TyName -> TyVar
mkTyVar Type
typeNatKind TyName
forall a. Name a
nName
indexConPrim _ = [Char] -> Term
forall a. HasCallStack => [Char] -> a
error ([Char] -> Term) -> [Char] -> Term
forall a b. (a -> b) -> a -> b
$ $(curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "called with incorrect type"

signedConPrim :: Type -> Term
signedConPrim :: Type -> Term
signedConPrim (Type -> TypeView
tyView -> TyConApp signedTcNm :: TyConName
signedTcNm _)
  = Text -> PrimInfo -> Term
Prim "Clash.Sized.Internal.Signed.fromInteger#" (Type -> WorkInfo -> PrimInfo
PrimInfo (TyVar -> Type -> Type
ForAllTy TyVar
nTV Type
funTy) WorkInfo
WorkNever)
  where
    funTy :: Type
funTy        = (Type -> Type -> Type) -> [Type] -> Type
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Type -> Type -> Type
mkFunTy [Type
naturalPrimTy,Type
integerPrimTy,TyConName -> [Type] -> Type
mkTyConApp TyConName
signedTcNm [Type
nVar]]
    nName :: Name a
nName      = Text -> Int -> Name a
forall a. Text -> Int -> Name a
mkUnsafeSystemName "n" 0
    nVar :: Type
nVar       = TyVar -> Type
VarTy TyVar
nTV
    nTV :: TyVar
nTV        = Type -> TyName -> TyVar
mkTyVar Type
typeNatKind TyName
forall a. Name a
nName
signedConPrim _ = [Char] -> Term
forall a. HasCallStack => [Char] -> a
error ([Char] -> Term) -> [Char] -> Term
forall a b. (a -> b) -> a -> b
$ $(curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "called with incorrect type"

unsignedConPrim :: Type -> Term
unsignedConPrim :: Type -> Term
unsignedConPrim (Type -> TypeView
tyView -> TyConApp unsignedTcNm :: TyConName
unsignedTcNm _)
  = Text -> PrimInfo -> Term
Prim "Clash.Sized.Internal.Unsigned.fromInteger#" (Type -> WorkInfo -> PrimInfo
PrimInfo (TyVar -> Type -> Type
ForAllTy TyVar
nTV Type
funTy) WorkInfo
WorkNever)
  where
    funTy :: Type
funTy        = (Type -> Type -> Type) -> [Type] -> Type
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Type -> Type -> Type
mkFunTy [Type
naturalPrimTy,Type
integerPrimTy,TyConName -> [Type] -> Type
mkTyConApp TyConName
unsignedTcNm [Type
nVar]]
    nName :: Name a
nName        = Text -> Int -> Name a
forall a. Text -> Int -> Name a
mkUnsafeSystemName "n" 0
    nVar :: Type
nVar         = TyVar -> Type
VarTy TyVar
nTV
    nTV :: TyVar
nTV          = Type -> TyName -> TyVar
mkTyVar Type
typeNatKind TyName
forall a. Name a
nName
unsignedConPrim _ = [Char] -> Term
forall a. HasCallStack => [Char] -> a
error ([Char] -> Term) -> [Char] -> Term
forall a b. (a -> b) -> a -> b
$ $(curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "called with incorrect type"


-- |  Lift a binary function over 'Unsigned' values to be used as literal Evaluator
--
--
liftUnsigned2 :: KnownNat n
              => (Unsigned n -> Unsigned n -> Unsigned n)
              -> Type
              -> TyConMap
              -> [Type]
              -> [Value]
              -> (Proxy n -> Maybe Term)
liftUnsigned2 :: (Unsigned n -> Unsigned n -> Unsigned n)
-> Type -> TyConMap -> [Type] -> [Value] -> Proxy n -> Maybe Term
liftUnsigned2 = ([Value] -> [Integer])
-> (Type -> Type -> Integer -> Integer -> Term)
-> (Unsigned n -> Unsigned n -> Unsigned n)
-> Type
-> TyConMap
-> [Type]
-> [Value]
-> Proxy n
-> Maybe Term
forall (n :: Nat) (sized :: Nat -> *).
(KnownNat n, Integral (sized n)) =>
([Value] -> [Integer])
-> (Type -> Type -> Integer -> Integer -> Term)
-> (sized n -> sized n -> sized n)
-> Type
-> TyConMap
-> [Type]
-> [Value]
-> Proxy n
-> Maybe Term
liftSized2 [Value] -> [Integer]
unsignedLiterals' Type -> Type -> Integer -> Integer -> Term
mkUnsignedLit

liftSigned2 :: KnownNat n
              => (Signed n -> Signed n -> Signed n)
              -> Type
              -> TyConMap
              -> [Type]
              -> [Value]
              -> (Proxy n -> Maybe Term)
liftSigned2 :: (Signed n -> Signed n -> Signed n)
-> Type -> TyConMap -> [Type] -> [Value] -> Proxy n -> Maybe Term
liftSigned2 = ([Value] -> [Integer])
-> (Type -> Type -> Integer -> Integer -> Term)
-> (Signed n -> Signed n -> Signed n)
-> Type
-> TyConMap
-> [Type]
-> [Value]
-> Proxy n
-> Maybe Term
forall (n :: Nat) (sized :: Nat -> *).
(KnownNat n, Integral (sized n)) =>
([Value] -> [Integer])
-> (Type -> Type -> Integer -> Integer -> Term)
-> (sized n -> sized n -> sized n)
-> Type
-> TyConMap
-> [Type]
-> [Value]
-> Proxy n
-> Maybe Term
liftSized2 [Value] -> [Integer]
signedLiterals' Type -> Type -> Integer -> Integer -> Term
mkSignedLit

liftBitVector2 :: KnownNat n
              => (BitVector n -> BitVector n -> BitVector n)
              -> Type
              -> TyConMap
              -> [Type]
              -> [Value]
              -> (Proxy n -> Maybe Term)
liftBitVector2 :: (BitVector n -> BitVector n -> BitVector n)
-> Type -> TyConMap -> [Type] -> [Value] -> Proxy n -> Maybe Term
liftBitVector2  f :: BitVector n -> BitVector n -> BitVector n
f ty :: Type
ty tcm :: TyConMap
tcm tys :: [Type]
tys args :: [Value]
args _p :: Proxy n
_p
  | Just (nTy :: Type
nTy, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
  , [i :: (Integer, Integer)
i,j :: (Integer, Integer)
j] <- [Value] -> [(Integer, Integer)]
bitVectorLiterals' [Value]
args
  = let BV mask :: Integer
mask val :: Integer
val = BitVector n -> BitVector n -> BitVector n
f ((Integer, Integer) -> BitVector n
forall (n :: Nat). (Integer, Integer) -> BitVector n
toBV (Integer, Integer)
i) ((Integer, Integer) -> BitVector n
forall (n :: Nat). (Integer, Integer) -> BitVector n
toBV (Integer, Integer)
j)
    in Term -> Maybe Term
forall a. a -> Maybe a
Just (Term -> Maybe Term) -> Term -> Maybe Term
forall a b. (a -> b) -> a -> b
$ Type -> Type -> Integer -> Integer -> Integer -> Term
mkBitVectorLit Type
ty Type
nTy Integer
kn Integer
mask Integer
val
  | Bool
otherwise = Maybe Term
forall a. Maybe a
Nothing

liftBitVector2Bool :: KnownNat n
              => (BitVector n -> BitVector n -> Bool)
              -> Type
              -> TyConMap
              -> [Value]
              -> (Proxy n -> Maybe Term)
liftBitVector2Bool :: (BitVector n -> BitVector n -> Bool)
-> Type -> TyConMap -> [Value] -> Proxy n -> Maybe Term
liftBitVector2Bool  f :: BitVector n -> BitVector n -> Bool
f ty :: Type
ty tcm :: TyConMap
tcm args :: [Value]
args _p :: Proxy n
_p
  | [i :: (Integer, Integer)
i,j :: (Integer, Integer)
j] <- [Value] -> [(Integer, Integer)]
bitVectorLiterals' [Value]
args
  = let val :: Bool
val = BitVector n -> BitVector n -> Bool
f ((Integer, Integer) -> BitVector n
forall (n :: Nat). (Integer, Integer) -> BitVector n
toBV (Integer, Integer)
i) ((Integer, Integer) -> BitVector n
forall (n :: Nat). (Integer, Integer) -> BitVector n
toBV (Integer, Integer)
j)
    in Term -> Maybe Term
forall a. a -> Maybe a
Just (Term -> Maybe Term) -> Term -> Maybe Term
forall a b. (a -> b) -> a -> b
$ TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty Bool
val
  | Bool
otherwise = Maybe Term
forall a. Maybe a
Nothing

liftSized2 :: (KnownNat n, Integral (sized n))
           => ([Value] -> [Integer])
              -- ^ literal argument extraction function
           -> (Type -> Type -> Integer -> Integer -> Term)
              -- ^ literal contruction function
           -> (sized n -> sized n -> sized n)
           -> Type
           -> TyConMap
           -> [Type]
           -> [Value]
           -> (Proxy n -> Maybe Term)
liftSized2 :: ([Value] -> [Integer])
-> (Type -> Type -> Integer -> Integer -> Term)
-> (sized n -> sized n -> sized n)
-> Type
-> TyConMap
-> [Type]
-> [Value]
-> Proxy n
-> Maybe Term
liftSized2 extractLitArgs :: [Value] -> [Integer]
extractLitArgs mkLit :: Type -> Type -> Integer -> Integer -> Term
mkLit f :: sized n -> sized n -> sized n
f ty :: Type
ty tcm :: TyConMap
tcm tys :: [Type]
tys args :: [Value]
args p :: Proxy n
p
  | Just (nTy :: Type
nTy, kn :: Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
  , [i :: Integer
i,j :: Integer
j] <- [Value] -> [Integer]
extractLitArgs [Value]
args
  = let val :: Integer
val = (sized n -> sized n -> sized n)
-> Integer -> Integer -> Proxy n -> Integer
forall (n :: Nat) (sized :: Nat -> *).
(KnownNat n, Integral (sized n)) =>
(sized n -> sized n -> sized n)
-> Integer -> Integer -> Proxy n -> Integer
runSizedF sized n -> sized n -> sized n
f Integer
i Integer
j Proxy n
p
    in Term -> Maybe Term
forall a. a -> Maybe a
Just (Term -> Maybe Term) -> Term -> Maybe Term
forall a b. (a -> b) -> a -> b
$ Type -> Type -> Integer -> Integer -> Term
mkLit Type
ty Type
nTy Integer
kn Integer
val
  | Bool
otherwise = Maybe Term
forall a. Maybe a
Nothing

-- | Helper to run a function over sized types on integers
--
-- This only works on function of type (sized n -> sized n -> sized n)
-- The resulting function must be executed with reifyNat
runSizedF
  :: (KnownNat n, Integral (sized n))
  => (sized n -> sized n -> sized n)
  -- ^ function to run
  -> Integer
  -- ^ first  argument
  -> Integer
  -- ^ second argument
  -> (Proxy n -> Integer)
runSizedF :: (sized n -> sized n -> sized n)
-> Integer -> Integer -> Proxy n -> Integer
runSizedF f :: sized n -> sized n -> sized n
f i :: Integer
i j :: Integer
j _ = sized n -> Integer
forall a. Integral a => a -> Integer
toInteger (sized n -> Integer) -> sized n -> Integer
forall a b. (a -> b) -> a -> b
$ sized n -> sized n -> sized n
f (Integer -> sized n
forall a. Num a => Integer -> a
fromInteger Integer
i) (Integer -> sized n
forall a. Num a => Integer -> a
fromInteger Integer
j)

extractTySizeInfo :: TyConMap -> Type -> [Type] -> (Type, Type, Integer)
extractTySizeInfo :: TyConMap -> Type -> [Type] -> (Type, Type, Integer)
extractTySizeInfo tcm :: TyConMap
tcm ty :: Type
ty tys :: [Type]
tys = (Type
resTy,Type
resSizeTy,Integer
resSize)
  where
    ty' :: Type
ty' = TyConMap -> Type -> [Type] -> Type
piResultTys TyConMap
tcm Type
ty [Type]
tys
    (_,resTy :: Type
resTy) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty'
    TyConApp _ [resSizeTy :: Type
resSizeTy] = Type -> TypeView
tyView Type
resTy
    Right resSize :: Integer
resSize = Except [Char] Integer -> Either [Char] Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except [Char] Integer
tyNatSize TyConMap
tcm Type
resSizeTy)

getResultTy
  :: TyConMap
  -> Type
  -> [Type]
  -> Type
getResultTy :: TyConMap -> Type -> [Type] -> Type
getResultTy tcm :: TyConMap
tcm ty :: Type
ty tys :: [Type]
tys = Type
resTy
 where
  ty' :: Type
ty' = TyConMap -> Type -> [Type] -> Type
piResultTys TyConMap
tcm Type
ty [Type]
tys
  (_,resTy :: Type
resTy) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty'

liftDDI :: (Double# -> Double# -> Int#) -> [Value] -> Maybe Term
liftDDI :: (Double# -> Double# -> Int#) -> [Value] -> Maybe Term
liftDDI f :: Double# -> Double# -> Int#
f args :: [Value]
args = case [Value] -> [Rational]
doubleLiterals' [Value]
args of
  [i :: Rational
i,j :: Rational
j] -> Term -> Maybe Term
forall a. a -> Maybe a
Just (Term -> Maybe Term) -> Term -> Maybe Term
forall a b. (a -> b) -> a -> b
$ (Double# -> Double# -> Int#) -> Rational -> Rational -> Term
runDDI Double# -> Double# -> Int#
f Rational
i Rational
j
  _     -> Maybe Term
forall a. Maybe a
Nothing
liftDDD :: (Double# -> Double# -> Double#) -> [Value] -> Maybe Term
liftDDD :: (Double# -> Double# -> Double#) -> [Value] -> Maybe Term
liftDDD f :: Double# -> Double# -> Double#
f args :: [Value]
args = case [Value] -> [Rational]
doubleLiterals' [Value]
args of
  [i :: Rational
i,j :: Rational
j] -> Term -> Maybe Term
forall a. a -> Maybe a
Just (Term -> Maybe Term) -> Term -> Maybe Term
forall a b. (a -> b) -> a -> b
$ (Double# -> Double# -> Double#) -> Rational -> Rational -> Term
runDDD Double# -> Double# -> Double#
f Rational
i Rational
j
  _     -> Maybe Term
forall a. Maybe a
Nothing
liftDD  :: (Double# -> Double#) -> [Value] -> Maybe Term
liftDD :: (Double# -> Double#) -> [Value] -> Maybe Term
liftDD  f :: Double# -> Double#
f args :: [Value]
args = case [Value] -> [Rational]
doubleLiterals' [Value]
args of
  [i :: Rational
i]   -> Term -> Maybe Term
forall a. a -> Maybe a
Just (Term -> Maybe Term) -> Term -> Maybe Term
forall a b. (a -> b) -> a -> b
$ (Double# -> Double#) -> Rational -> Term
runDD Double# -> Double#
f Rational
i
  _     -> Maybe Term
forall a. Maybe a
Nothing
runDDI :: (Double# -> Double# -> Int#) -> Rational -> Rational -> Term
runDDI :: (Double# -> Double# -> Int#) -> Rational -> Rational -> Term
runDDI f :: Double# -> Double# -> Int#
f i :: Rational
i j :: Rational
j
  = let !(D# a :: Double#
a) = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
i
        !(D# b :: Double#
b) = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
j
        r :: Int#
r = Double# -> Double# -> Int#
f Double#
a Double#
b
    in  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#
r
runDDD :: (Double# -> Double# -> Double#) -> Rational -> Rational -> Term
runDDD :: (Double# -> Double# -> Double#) -> Rational -> Rational -> Term
runDDD f :: Double# -> Double# -> Double#
f i :: Rational
i j :: Rational
j
  = let !(D# a :: Double#
a) = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
i
        !(D# b :: Double#
b) = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
j
        r :: Double#
r = Double# -> Double# -> Double#
f Double#
a Double#
b
    in  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 -> Term) -> Double -> Term
forall a b. (a -> b) -> a -> b
$ Double# -> Double
D# Double#
r
runDD :: (Double# -> Double#) -> Rational -> Term
runDD :: (Double# -> Double#) -> Rational -> Term
runDD f :: Double# -> Double#
f i :: Rational
i
  = let !(D# a :: Double#
a) = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
i
        r :: Double#
r = Double# -> Double#
f Double#
a
    in  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 -> Term) -> Double -> Term
forall a b. (a -> b) -> a -> b
$ Double# -> Double
D# Double#
r

liftFFI :: (Float# -> Float# -> Int#) -> [Value] -> Maybe Term
liftFFI :: (Float# -> Float# -> Int#) -> [Value] -> Maybe Term
liftFFI f :: Float# -> Float# -> Int#
f args :: [Value]
args = case [Value] -> [Rational]
floatLiterals' [Value]
args of
  [i :: Rational
i,j :: Rational
j] -> Term -> Maybe Term
forall a. a -> Maybe a
Just (Term -> Maybe Term) -> Term -> Maybe Term
forall a b. (a -> b) -> a -> b
$ (Float# -> Float# -> Int#) -> Rational -> Rational -> Term
runFFI Float# -> Float# -> Int#
f Rational
i Rational
j
  _     -> Maybe Term
forall a. Maybe a
Nothing
liftFFF :: (Float# -> Float# -> Float#) -> [Value] -> Maybe Term
liftFFF :: (Float# -> Float# -> Float#) -> [Value] -> Maybe Term
liftFFF f :: Float# -> Float# -> Float#
f args :: [Value]
args = case [Value] -> [Rational]
floatLiterals' [Value]
args of
  [i :: Rational
i,j :: Rational
j] -> Term -> Maybe Term
forall a. a -> Maybe a
Just (Term -> Maybe Term) -> Term -> Maybe Term
forall a b. (a -> b) -> a -> b
$ (Float# -> Float# -> Float#) -> Rational -> Rational -> Term
runFFF Float# -> Float# -> Float#
f Rational
i Rational
j
  _     -> Maybe Term
forall a. Maybe a
Nothing
liftFF  :: (Float# -> Float#) -> [Value] -> Maybe Term
liftFF :: (Float# -> Float#) -> [Value] -> Maybe Term
liftFF  f :: Float# -> Float#
f args :: [Value]
args = case [Value] -> [Rational]
floatLiterals' [Value]
args of
  [i :: Rational
i]   -> Term -> Maybe Term
forall a. a -> Maybe a
Just (Term -> Maybe Term) -> Term -> Maybe Term
forall a b. (a -> b) -> a -> b
$ (Float# -> Float#) -> Rational -> Term
runFF Float# -> Float#
f Rational
i
  _     -> Maybe Term
forall a. Maybe a
Nothing
runFFI :: (Float# -> Float# -> Int#) -> Rational -> Rational -> Term
runFFI :: (Float# -> Float# -> Int#) -> Rational -> Rational -> Term
runFFI f :: Float# -> Float# -> Int#
f i :: Rational
i j :: Rational
j
  = let !(F# a :: Float#
a) = Rational -> Float
forall a. Fractional a => Rational -> a
fromRational Rational
i
        !(F# b :: Float#
b) = Rational -> Float
forall a. Fractional a => Rational -> a
fromRational Rational
j
        r :: Int#
r = Float# -> Float# -> Int#
f Float#
a Float#
b
    in  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#
r
runFFF :: (Float# -> Float# -> Float#) -> Rational -> Rational -> Term
runFFF :: (Float# -> Float# -> Float#) -> Rational -> Rational -> Term
runFFF f :: Float# -> Float# -> Float#
f i :: Rational
i j :: Rational
j
  = let !(F# a :: Float#
a) = Rational -> Float
forall a. Fractional a => Rational -> a
fromRational Rational
i
        !(F# b :: Float#
b) = Rational -> Float
forall a. Fractional a => Rational -> a
fromRational Rational
j
        r :: Float#
r = Float# -> Float# -> Float#
f Float#
a Float#
b
    in  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 -> Term) -> Float -> Term
forall a b. (a -> b) -> a -> b
$ Float# -> Float
F# Float#
r
runFF :: (Float# -> Float#) -> Rational -> Term
runFF :: (Float# -> Float#) -> Rational -> Term
runFF f :: Float# -> Float#
f i :: Rational
i
  = let !(F# a :: Float#
a) = Rational -> Float
forall a. Fractional a => Rational -> a
fromRational Rational
i
        r :: Float#
r = Float# -> Float#
f Float#
a
    in  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 -> Term) -> Float -> Term
forall a b. (a -> b) -> a -> b
$ Float# -> Float
F# Float#
r

vecHeadPrim
  :: TyConName
  -- ^ Vec TyCon name
  -> Term
vecHeadPrim :: TyConName -> Term
vecHeadPrim vecTcNm :: TyConName
vecTcNm = Text -> PrimInfo -> Term
Prim "Clash.Sized.Vector.head"
                           (Type -> WorkInfo -> PrimInfo
PrimInfo (TyConName -> Type
vecHeadTy TyConName
vecTcNm) WorkInfo
WorkNever)

vecLastPrim
  :: TyConName
  -- ^ Vec TyCon name
  -> Term
vecLastPrim :: TyConName -> Term
vecLastPrim vecTcNm :: TyConName
vecTcNm = Text -> PrimInfo -> Term
Prim "Clash.Sized.Vector.last"
                           (Type -> WorkInfo -> PrimInfo
PrimInfo (TyConName -> Type
vecHeadTy TyConName
vecTcNm) WorkInfo
WorkNever)

vecHeadTy
  :: TyConName
  -- ^ Vec TyCon name
  -> Type
vecHeadTy :: TyConName -> Type
vecHeadTy vecNm :: TyConName
vecNm =
    TyVar -> Type -> Type
ForAllTy TyVar
nTV (
    TyVar -> Type -> Type
ForAllTy TyVar
aTV (
    Type -> Type -> Type
mkFunTy
      (TyConName -> [Type] -> Type
mkTyConApp TyConName
vecNm [TyConName -> [Type] -> Type
mkTyConApp TyConName
typeNatAdd
                           [TyVar -> Type
VarTy TyVar
nTV
                           ,LitTy -> Type
LitTy (Integer -> LitTy
NumTy 1)]
                        ,TyVar -> Type
VarTy TyVar
aTV
                        ])
      (TyVar -> Type
VarTy TyVar
aTV)))
  where
    aTV :: TyVar
aTV = Type -> TyName -> TyVar
mkTyVar Type
liftedTypeKind (Text -> Int -> TyName
forall a. Text -> Int -> Name a
mkUnsafeSystemName "a" 0)
    nTV :: TyVar
nTV = Type -> TyName -> TyVar
mkTyVar Type
typeNatKind (Text -> Int -> TyName
forall a. Text -> Int -> Name a
mkUnsafeSystemName "n" 1)

vecTailPrim
  :: TyConName
  -- ^ Vec TyCon name
  -> Term
vecTailPrim :: TyConName -> Term
vecTailPrim vecTcNm :: TyConName
vecTcNm = Text -> PrimInfo -> Term
Prim "Clash.Sized.Vector.tail"
                           (Type -> WorkInfo -> PrimInfo
PrimInfo (TyConName -> Type
vecTailTy TyConName
vecTcNm) WorkInfo
WorkNever)

vecInitPrim
  :: TyConName
  -- ^ Vec TyCon name
  -> Term
vecInitPrim :: TyConName -> Term
vecInitPrim vecTcNm :: TyConName
vecTcNm = Text -> PrimInfo -> Term
Prim "Clash.Sized.Vector.init"
                           (Type -> WorkInfo -> PrimInfo
PrimInfo (TyConName -> Type
vecTailTy TyConName
vecTcNm) WorkInfo
WorkNever)

vecTailTy
  :: TyConName
  -- ^ Vec TyCon name
  -> Type
vecTailTy :: TyConName -> Type
vecTailTy vecNm :: TyConName
vecNm =
    TyVar -> Type -> Type
ForAllTy TyVar
nTV (
    TyVar -> Type -> Type
ForAllTy TyVar
aTV (
    Type -> Type -> Type
mkFunTy
      (TyConName -> [Type] -> Type
mkTyConApp TyConName
vecNm [TyConName -> [Type] -> Type
mkTyConApp TyConName
typeNatAdd
                           [TyVar -> Type
VarTy TyVar
nTV
                           ,LitTy -> Type
LitTy (Integer -> LitTy
NumTy 1)]
                        ,TyVar -> Type
VarTy TyVar
aTV
                        ])
      (TyConName -> [Type] -> Type
mkTyConApp TyConName
vecNm [TyVar -> Type
VarTy TyVar
nTV
                        ,TyVar -> Type
VarTy TyVar
aTV
                        ])))
  where
    nTV :: TyVar
nTV = Type -> TyName -> TyVar
mkTyVar Type
typeNatKind (Text -> Int -> TyName
forall a. Text -> Int -> Name a
mkUnsafeSystemName "n" 0)
    aTV :: TyVar
aTV = Type -> TyName -> TyVar
mkTyVar Type
liftedTypeKind (Text -> Int -> TyName
forall a. Text -> Int -> Name a
mkUnsafeSystemName "a" 1)

splitAtPrim
  :: TyConName
  -- ^ SNat TyCon name
  -> TyConName
  -- ^ Vec TyCon name
  -> Term
splitAtPrim :: TyConName -> TyConName -> Term
splitAtPrim snatTcNm :: TyConName
snatTcNm vecTcNm :: TyConName
vecTcNm =
  Text -> PrimInfo -> Term
Prim "Clash.Sized.Vector.splitAt"
       (Type -> WorkInfo -> PrimInfo
PrimInfo (TyConName -> TyConName -> Type
splitAtTy TyConName
snatTcNm TyConName
vecTcNm) WorkInfo
WorkNever)

splitAtTy
  :: TyConName
  -- ^ SNat TyCon name
  -> TyConName
  -- ^ Vec TyCon name
  -> Type
splitAtTy :: TyConName -> TyConName -> Type
splitAtTy snatNm :: TyConName
snatNm vecNm :: TyConName
vecNm =
  TyVar -> Type -> Type
ForAllTy TyVar
mTV (
  TyVar -> Type -> Type
ForAllTy TyVar
nTV (
  TyVar -> Type -> Type
ForAllTy TyVar
aTV (
  Type -> Type -> Type
mkFunTy
    (TyConName -> [Type] -> Type
mkTyConApp TyConName
snatNm [TyVar -> Type
VarTy TyVar
mTV])
    (Type -> Type -> Type
mkFunTy
      (TyConName -> [Type] -> Type
mkTyConApp TyConName
vecNm
                  [TyConName -> [Type] -> Type
mkTyConApp TyConName
typeNatAdd
                    [TyVar -> Type
VarTy TyVar
mTV
                    ,TyVar -> Type
VarTy TyVar
nTV]
                  ,TyVar -> Type
VarTy TyVar
aTV])
      (TyConName -> [Type] -> Type
mkTyConApp TyConName
tupNm
                  [TyConName -> [Type] -> Type
mkTyConApp TyConName
vecNm
                              [TyVar -> Type
VarTy TyVar
mTV
                              ,TyVar -> Type
VarTy TyVar
aTV]
                  ,TyConName -> [Type] -> Type
mkTyConApp TyConName
vecNm
                              [TyVar -> Type
VarTy TyVar
nTV
                              ,TyVar -> Type
VarTy TyVar
aTV]])))))
  where
    mTV :: TyVar
mTV   = Type -> TyName -> TyVar
mkTyVar Type
typeNatKind (Text -> Int -> TyName
forall a. Text -> Int -> Name a
mkUnsafeSystemName "m" 0)
    nTV :: TyVar
nTV   = Type -> TyName -> TyVar
mkTyVar Type
typeNatKind (Text -> Int -> TyName
forall a. Text -> Int -> Name a
mkUnsafeSystemName "n" 1)
    aTV :: TyVar
aTV   = Type -> TyName -> TyVar
mkTyVar Type
liftedTypeKind (Text -> Int -> TyName
forall a. Text -> Int -> Name a
mkUnsafeSystemName "a" 2)
    tupNm :: TyConName
tupNm = TyCon -> TyConName
ghcTyconToTyConName (Boxity -> Int -> TyCon
tupleTyCon Boxity
Boxed 2)

foldSplitAtTy
  :: TyConName
  -- ^ Vec TyCon name
  -> Type
foldSplitAtTy :: TyConName -> Type
foldSplitAtTy vecNm :: TyConName
vecNm =
  TyVar -> Type -> Type
ForAllTy TyVar
mTV (
  TyVar -> Type -> Type
ForAllTy TyVar
nTV (
  TyVar -> Type -> Type
ForAllTy TyVar
aTV (
  Type -> Type -> Type
mkFunTy
    Type
naturalPrimTy
    (Type -> Type -> Type
mkFunTy
      (TyConName -> [Type] -> Type
mkTyConApp TyConName
vecNm
                  [TyConName -> [Type] -> Type
mkTyConApp TyConName
typeNatAdd
                    [TyVar -> Type
VarTy TyVar
mTV
                    ,TyVar -> Type
VarTy TyVar
nTV]
                  ,TyVar -> Type
VarTy TyVar
aTV])
      (TyConName -> [Type] -> Type
mkTyConApp TyConName
tupNm
                  [TyConName -> [Type] -> Type
mkTyConApp TyConName
vecNm
                              [TyVar -> Type
VarTy TyVar
mTV
                              ,TyVar -> Type
VarTy TyVar
aTV]
                  ,TyConName -> [Type] -> Type
mkTyConApp TyConName
vecNm
                              [TyVar -> Type
VarTy TyVar
nTV
                              ,TyVar -> Type
VarTy TyVar
aTV]])))))
  where
    mTV :: TyVar
mTV   = Type -> TyName -> TyVar
mkTyVar Type
typeNatKind (Text -> Int -> TyName
forall a. Text -> Int -> Name a
mkUnsafeSystemName "m" 0)
    nTV :: TyVar
nTV   = Type -> TyName -> TyVar
mkTyVar Type
typeNatKind (Text -> Int -> TyName
forall a. Text -> Int -> Name a
mkUnsafeSystemName "n" 1)
    aTV :: TyVar
aTV   = Type -> TyName -> TyVar
mkTyVar Type
liftedTypeKind (Text -> Int -> TyName
forall a. Text -> Int -> Name a
mkUnsafeSystemName "a" 2)
    tupNm :: TyConName
tupNm = TyCon -> TyConName
ghcTyconToTyConName (Boxity -> Int -> TyCon
tupleTyCon Boxity
Boxed 2)

vecAppendPrim
  :: TyConName
  -- ^ Vec TyCon name
  -> Term
vecAppendPrim :: TyConName -> Term
vecAppendPrim vecNm :: TyConName
vecNm = Text -> PrimInfo -> Term
Prim "Clash.Sized.Vector.++"
                           (Type -> WorkInfo -> PrimInfo
PrimInfo (TyConName -> Type
vecAppendTy TyConName
vecNm) WorkInfo
WorkNever)

vecAppendTy
  :: TyConName
  -- ^ Vec TyCon name
  -> Type
vecAppendTy :: TyConName -> Type
vecAppendTy vecNm :: TyConName
vecNm =
    TyVar -> Type -> Type
ForAllTy TyVar
nTV (
    TyVar -> Type -> Type
ForAllTy TyVar
aTV (
    TyVar -> Type -> Type
ForAllTy TyVar
mTV (
    Type -> Type -> Type
mkFunTy
      (TyConName -> [Type] -> Type
mkTyConApp TyConName
vecNm [TyVar -> Type
VarTy TyVar
nTV
                        ,TyVar -> Type
VarTy TyVar
aTV
                        ])
      (Type -> Type -> Type
mkFunTy
         (TyConName -> [Type] -> Type
mkTyConApp TyConName
vecNm [TyVar -> Type
VarTy TyVar
mTV
                           ,TyVar -> Type
VarTy TyVar
aTV
                           ])
         (TyConName -> [Type] -> Type
mkTyConApp TyConName
vecNm [TyConName -> [Type] -> Type
mkTyConApp TyConName
typeNatAdd
                              [TyVar -> Type
VarTy TyVar
nTV
                              ,TyVar -> Type
VarTy TyVar
mTV]
                           ,TyVar -> Type
VarTy TyVar
aTV
                           ])))))
  where
    nTV :: TyVar
nTV = Type -> TyName -> TyVar
mkTyVar Type
typeNatKind (Text -> Int -> TyName
forall a. Text -> Int -> Name a
mkUnsafeSystemName "n" 0)
    aTV :: TyVar
aTV = Type -> TyName -> TyVar
mkTyVar Type
liftedTypeKind (Text -> Int -> TyName
forall a. Text -> Int -> Name a
mkUnsafeSystemName "a" 1)
    mTV :: TyVar
mTV = Type -> TyName -> TyVar
mkTyVar Type
typeNatKind (Text -> Int -> TyName
forall a. Text -> Int -> Name a
mkUnsafeSystemName "m" 2)

vecZipWithPrim
  :: TyConName
  -- ^ Vec TyCon name
  -> Term
vecZipWithPrim :: TyConName -> Term
vecZipWithPrim vecNm :: TyConName
vecNm = Text -> PrimInfo -> Term
Prim "Clash.Sized.Vector.zipWith"
                            (Type -> WorkInfo -> PrimInfo
PrimInfo (TyConName -> Type
vecAppendTy TyConName
vecNm) WorkInfo
WorkNever)

vecZipWithTy
  :: TyConName
  -- ^ Vec TyCon name
  -> Type
vecZipWithTy :: TyConName -> Type
vecZipWithTy vecNm :: TyConName
vecNm =
  TyVar -> Type -> Type
ForAllTy TyVar
aTV (
  TyVar -> Type -> Type
ForAllTy TyVar
bTV (
  TyVar -> Type -> Type
ForAllTy TyVar
cTV (
  TyVar -> Type -> Type
ForAllTy TyVar
nTV (
  Type -> Type -> Type
mkFunTy
    (Type -> Type -> Type
mkFunTy Type
aTy (Type -> Type -> Type
mkFunTy Type
bTy Type
cTy))
    (Type -> Type -> Type
mkFunTy
      (TyConName -> [Type] -> Type
mkTyConApp TyConName
vecNm [Type
nTy,Type
aTy])
      (Type -> Type -> Type
mkFunTy
        (TyConName -> [Type] -> Type
mkTyConApp TyConName
vecNm [Type
nTy,Type
bTy])
        (TyConName -> [Type] -> Type
mkTyConApp TyConName
vecNm [Type
nTy,Type
cTy])))))))
  where
    aTV :: TyVar
aTV = Type -> TyName -> TyVar
mkTyVar Type
liftedTypeKind (Text -> Int -> TyName
forall a. Text -> Int -> Name a
mkUnsafeSystemName "a" 0)
    bTV :: TyVar
bTV = Type -> TyName -> TyVar
mkTyVar Type
liftedTypeKind (Text -> Int -> TyName
forall a. Text -> Int -> Name a
mkUnsafeSystemName "b" 1)
    cTV :: TyVar
cTV = Type -> TyName -> TyVar
mkTyVar Type
liftedTypeKind (Text -> Int -> TyName
forall a. Text -> Int -> Name a
mkUnsafeSystemName "c" 2)
    nTV :: TyVar
nTV = Type -> TyName -> TyVar
mkTyVar Type
typeNatKind (Text -> Int -> TyName
forall a. Text -> Int -> Name a
mkUnsafeSystemName "n" 3)
    aTy :: Type
aTy = TyVar -> Type
VarTy TyVar
aTV
    bTy :: Type
bTy = TyVar -> Type
VarTy TyVar
bTV
    cTy :: Type
cTy = TyVar -> Type
VarTy TyVar
cTV
    nTy :: Type
nTy = TyVar -> Type
VarTy TyVar
nTV

vecImapGoTy
  :: TyConName
  -- ^ Vec TyCon name
  -> TyConName
  -- ^ Index TyCon name
  -> Type
vecImapGoTy :: TyConName -> TyConName -> Type
vecImapGoTy vecTcNm :: TyConName
vecTcNm indexTcNm :: TyConName
indexTcNm =
  TyVar -> Type -> Type
ForAllTy TyVar
nTV (
  TyVar -> Type -> Type
ForAllTy TyVar
mTV (
  TyVar -> Type -> Type
ForAllTy TyVar
aTV (
  TyVar -> Type -> Type
ForAllTy TyVar
bTV (
  Type -> Type -> Type
mkFunTy Type
indexTy
    (Type -> Type -> Type
mkFunTy Type
fTy
       (Type -> Type -> Type
mkFunTy Type
vecATy Type
vecBTy))))))
  where
    nTV :: TyVar
nTV = Type -> TyName -> TyVar
mkTyVar Type
typeNatKind (Text -> Int -> TyName
forall a. Text -> Int -> Name a
mkUnsafeSystemName "n" 0)
    mTV :: TyVar
mTV = Type -> TyName -> TyVar
mkTyVar Type
typeNatKind (Text -> Int -> TyName
forall a. Text -> Int -> Name a
mkUnsafeSystemName "m" 1)
    aTV :: TyVar
aTV = Type -> TyName -> TyVar
mkTyVar Type
liftedTypeKind (Text -> Int -> TyName
forall a. Text -> Int -> Name a
mkUnsafeSystemName "a" 2)
    bTV :: TyVar
bTV = Type -> TyName -> TyVar
mkTyVar Type
liftedTypeKind (Text -> Int -> TyName
forall a. Text -> Int -> Name a
mkUnsafeSystemName "b" 3)
    indexTy :: Type
indexTy = TyConName -> [Type] -> Type
mkTyConApp TyConName
indexTcNm [Type
nTy]
    nTy :: Type
nTy = TyVar -> Type
VarTy TyVar
nTV
    mTy :: Type
mTy = TyVar -> Type
VarTy TyVar
mTV
    fTy :: Type
fTy = Type -> Type -> Type
mkFunTy Type
indexTy (Type -> Type -> Type
mkFunTy Type
aTy Type
bTy)
    aTy :: Type
aTy = TyVar -> Type
VarTy TyVar
aTV
    bTy :: Type
bTy = TyVar -> Type
VarTy TyVar
bTV
    vecATy :: Type
vecATy = TyConName -> [Type] -> Type
mkTyConApp TyConName
vecTcNm [Type
mTy,Type
aTy]
    vecBTy :: Type
vecBTy = TyConName -> [Type] -> Type
mkTyConApp TyConName
vecTcNm [Type
mTy,Type
bTy]

indexAddTy
  :: TyConName
  -- ^ Index TyCon name
  -> Type
indexAddTy :: TyConName -> Type
indexAddTy indexTcNm :: TyConName
indexTcNm =
  TyVar -> Type -> Type
ForAllTy TyVar
nTV (
  Type -> Type -> Type
mkFunTy Type
naturalPrimTy (Type -> Type -> Type
mkFunTy Type
indexTy (Type -> Type -> Type
mkFunTy Type
indexTy Type
indexTy)))
  where
    nTV :: TyVar
nTV     = Type -> TyName -> TyVar
mkTyVar Type
typeNatKind (Text -> Int -> TyName
forall a. Text -> Int -> Name a
mkUnsafeSystemName "n" 0)
    indexTy :: Type
indexTy = TyConName -> [Type] -> Type
mkTyConApp TyConName
indexTcNm [TyVar -> Type
VarTy TyVar
nTV]

bvAppendPrim
  :: TyConName
  -- ^ BitVector TyCon Name
  -> Term
bvAppendPrim :: TyConName -> Term
bvAppendPrim bvTcNm :: TyConName
bvTcNm = Text -> PrimInfo -> Term
Prim "Clash.Sized.Internal.BitVector.++#"
                           (Type -> WorkInfo -> PrimInfo
PrimInfo (TyConName -> Type
bvAppendTy TyConName
bvTcNm) WorkInfo
WorkNever)

bvAppendTy
  :: TyConName
  -- ^ BitVector TyCon Name
  -> Type
bvAppendTy :: TyConName -> Type
bvAppendTy bvNm :: TyConName
bvNm =
  TyVar -> Type -> Type
ForAllTy TyVar
mTV (
  TyVar -> Type -> Type
ForAllTy TyVar
nTV (
  Type -> Type -> Type
mkFunTy Type
naturalPrimTy (Type -> Type -> Type
mkFunTy
    (TyConName -> [Type] -> Type
mkTyConApp TyConName
bvNm [TyVar -> Type
VarTy TyVar
nTV])
    (Type -> Type -> Type
mkFunTy
      (TyConName -> [Type] -> Type
mkTyConApp TyConName
bvNm [TyVar -> Type
VarTy TyVar
mTV])
      (TyConName -> [Type] -> Type
mkTyConApp TyConName
bvNm [TyConName -> [Type] -> Type
mkTyConApp TyConName
typeNatAdd
                          [TyVar -> Type
VarTy TyVar
nTV
                          ,TyVar -> Type
VarTy TyVar
mTV]])))))
  where
    mTV :: TyVar
mTV = Type -> TyName -> TyVar
mkTyVar Type
typeNatKind (Text -> Int -> TyName
forall a. Text -> Int -> Name a
mkUnsafeSystemName "m" 0)
    nTV :: TyVar
nTV = Type -> TyName -> TyVar
mkTyVar Type
typeNatKind (Text -> Int -> TyName
forall a. Text -> Int -> Name a
mkUnsafeSystemName "n" 1)

bvSplitPrim
  :: TyConName
  -- ^ BitVector TyCon Name
  -> Term
bvSplitPrim :: TyConName -> Term
bvSplitPrim bvTcNm :: TyConName
bvTcNm = Text -> PrimInfo -> Term
Prim "Clash.Sized.Internal.BitVector.split#"
                          (Type -> WorkInfo -> PrimInfo
PrimInfo (TyConName -> Type
bvSplitTy TyConName
bvTcNm) WorkInfo
WorkNever)

bvSplitTy
  :: TyConName
  -- ^ BitVector TyCon Name
  -> Type
bvSplitTy :: TyConName -> Type
bvSplitTy bvNm :: TyConName
bvNm =
  TyVar -> Type -> Type
ForAllTy TyVar
nTV (
  TyVar -> Type -> Type
ForAllTy TyVar
mTV (
  Type -> Type -> Type
mkFunTy Type
naturalPrimTy (Type -> Type -> Type
mkFunTy
    (TyConName -> [Type] -> Type
mkTyConApp TyConName
bvNm [TyConName -> [Type] -> Type
mkTyConApp TyConName
typeNatAdd
                                 [TyVar -> Type
VarTy TyVar
mTV
                                 ,TyVar -> Type
VarTy TyVar
nTV]])
    (TyConName -> [Type] -> Type
mkTyConApp TyConName
tupNm [TyConName -> [Type] -> Type
mkTyConApp TyConName
bvNm [TyVar -> Type
VarTy TyVar
mTV]
                      ,TyConName -> [Type] -> Type
mkTyConApp TyConName
bvNm [TyVar -> Type
VarTy TyVar
nTV]]))))
  where
    nTV :: TyVar
nTV   = Type -> TyName -> TyVar
mkTyVar Type
typeNatKind (Text -> Int -> TyName
forall a. Text -> Int -> Name a
mkUnsafeSystemName "n" 0)
    mTV :: TyVar
mTV   = Type -> TyName -> TyVar
mkTyVar Type
typeNatKind (Text -> Int -> TyName
forall a. Text -> Int -> Name a
mkUnsafeSystemName "m" 1)
    tupNm :: TyConName
tupNm = TyCon -> TyConName
ghcTyconToTyConName (Boxity -> Int -> TyCon
tupleTyCon Boxity
Boxed 2)

typeNatAdd :: TyConName
typeNatAdd :: TyConName
typeNatAdd = NameSort -> Text -> Int -> SrcSpan -> TyConName
forall a. NameSort -> Text -> Int -> SrcSpan -> Name a
Name NameSort
User
                  "GHC.TypeNats.+"
                  (Unique -> Int
getKey Unique
typeNatAddTyFamNameKey)
                  SrcSpan
wiredInSrcSpan


typeNatMul :: TyConName
typeNatMul :: TyConName
typeNatMul = NameSort -> Text -> Int -> SrcSpan -> TyConName
forall a. NameSort -> Text -> Int -> SrcSpan -> Name a
Name NameSort
User
                  "GHC.TypeNats.*"
                  (Unique -> Int
getKey Unique
typeNatMulTyFamNameKey)
                  SrcSpan
wiredInSrcSpan

typeNatSub :: TyConName
typeNatSub :: TyConName
typeNatSub = NameSort -> Text -> Int -> SrcSpan -> TyConName
forall a. NameSort -> Text -> Int -> SrcSpan -> Name a
Name NameSort
User
                  "GHC.TypeNats.-"
                  (Unique -> Int
getKey Unique
typeNatSubTyFamNameKey)
                  SrcSpan
wiredInSrcSpan

ghcTyconToTyConName
  :: TyCon.TyCon
  -> TyConName
ghcTyconToTyConName :: TyCon -> TyConName
ghcTyconToTyConName tc :: TyCon
tc =
    NameSort -> Text -> Int -> SrcSpan -> TyConName
forall a. NameSort -> Text -> Int -> SrcSpan -> Name a
Name NameSort
User Text
n' (Unique -> Int
getKey (TyCon -> Unique
TyCon.tyConUnique TyCon
tc)) (Name -> SrcSpan
forall a. NamedThing a => a -> SrcSpan
getSrcSpan Name
n)
  where
    n' :: Text
n'      = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe "_INTERNAL_" (Name -> Maybe Text
modNameM Name
n) Text -> Text -> Text
`Text.append`
              ('.' Char -> Text -> Text
`Text.cons` [Char] -> Text
Text.pack [Char]
occName)
    occName :: [Char]
occName = OccName -> [Char]
occNameString (OccName -> [Char]) -> OccName -> [Char]
forall a b. (a -> b) -> a -> b
$ Name -> OccName
nameOccName Name
n
    n :: Name
n       = TyCon -> Name
TyCon.tyConName TyCon
tc

svoid :: (State# RealWorld -> State# RealWorld) -> IO ()
svoid :: (State# RealWorld -> State# RealWorld) -> IO ()
svoid m0 :: State# RealWorld -> State# RealWorld
m0 = (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO (\s :: State# RealWorld
s -> case State# RealWorld -> State# RealWorld
m0 State# RealWorld
s of s' :: State# RealWorld
s' -> (# State# RealWorld
s', () #))