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

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

module Clash.GHC.Evaluator
  ( primEvaluator
  ) where

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

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

import           Clash.Class.BitPack (pack,unpack)
import           Clash.Core.DataCon  (DataCon (..))
import           Clash.Core.Evaluator
import           Clash.Core.Evaluator.Types
import           Clash.Core.Literal  (Literal (..))
import           Clash.Core.Name
  (Name (..), NameSort (..), mkUnsafeSystemName)
import           Clash.Core.Pretty   (showPpr)
import           Clash.Core.Term
  (Pat (..), PrimInfo (..), Term (..), WorkInfo (..))
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)


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


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

unwindPrim tcm :: TyConMap
tcm ty :: PrimInfo
ty tys :: [Type]
tys vs :: [Value]
vs v :: Value
v [e :: Term
e] m0 :: Machine
m0
  | PrimInfo -> Text
primName PrimInfo
ty Text -> [Text] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` [ "Clash.Sized.Vector.lazyV"
                       , "Clash.Sized.Vector.replicate"
                       , "Clash.Sized.Vector.replace_int"
                       , "GHC.Classes.&&"
                       , "GHC.Classes.||"
                       ]
  = let (m1 :: Machine
m1,i :: Id
i) = TyConMap -> Machine -> Term -> (Machine, Id)
newLetBinding TyConMap
tcm Machine
m0 Term
e
    in  Machine -> PrimStep
mPrimStep Machine
m0 TyConMap
tcm (Machine -> Bool
forcePrims Machine
m0) PrimInfo
ty [Type]
tys ([Value]
vs [Value] -> [Value] -> [Value]
forall a. [a] -> [a] -> [a]
++ [Value
v,Term -> Value
Suspend (Id -> Term
Var Id
i)]) Machine
m1

unwindPrim _ ty :: PrimInfo
ty tys :: [Type]
tys vs :: [Value]
vs (Value -> (Value, [TickInfo])
collectValueTicks -> (v :: Value
v, ts :: [TickInfo]
ts)) (e :: Term
e:es :: [Term]
es) m :: Machine
m =
  Machine -> Maybe Machine
forall a. a -> Maybe a
Just (Machine -> Maybe Machine)
-> (Machine -> Machine) -> Machine -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Machine -> Machine
setTerm Term
e (Machine -> Maybe Machine) -> Machine -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ StackFrame -> Machine -> Machine
stackPush (PrimInfo -> [Type] -> [Value] -> [Term] -> StackFrame
PrimApply PrimInfo
ty [Type]
tys ([Value]
vs [Value] -> [Value] -> [Value]
forall a. [a] -> [a] -> [a]
++ [(TickInfo -> Value -> Value) -> Value -> [TickInfo] -> Value
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr TickInfo -> Value -> Value
TickValue Value
v [TickInfo]
ts]) [Term]
es) Machine
m


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

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

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

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

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

  "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 Machine
reduce (Integer -> Term
integerToIntLiteral (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
c))

  "GHC.Prim.quotInt#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
intLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Term -> Term
catchDivByZero (Integer -> Term
integerToIntLiteral (Integer
i Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
j))
  "GHC.Prim.remInt#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
intLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Term -> Term
catchDivByZero (Integer -> Term
integerToIntLiteral (Integer
i Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`rem` Integer
j))
  "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 Machine
reduce Term
ret

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

  "GHC.Prim.negateInt#"
    | [Lit (IntLiteral i :: Integer
i)] <- [Value]
args
    -> Term -> Maybe Machine
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 Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
           Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
tupDc) ((Type -> Either Term Type) -> [Type] -> [Either Term Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Either Term Type
forall a b. b -> Either a b
Right [Type]
tyArgs [Either Term Type] -> [Either Term Type] -> [Either Term Type]
forall a. [a] -> [a] -> [a]
++
                   [ Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Literal -> Term) -> (Int -> Literal) -> Int -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral (Integer -> Literal) -> (Int -> Integer) -> Int -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Term) -> Int -> Term
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
d)
                   , Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Literal -> Term) -> (Int -> Literal) -> Int -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral (Integer -> Literal) -> (Int -> Integer) -> Int -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Term) -> Int -> Term
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
c)])
  "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 Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
           Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
tupDc) ((Type -> Either Term Type) -> [Type] -> [Either Term Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Either Term Type
forall a b. b -> Either a b
Right [Type]
tyArgs [Either Term Type] -> [Either Term Type] -> [Either Term Type]
forall a. [a] -> [a] -> [a]
++
                   [ Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Literal -> Term) -> (Int -> Literal) -> Int -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral (Integer -> Literal) -> (Int -> Integer) -> Int -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Term) -> Int -> Term
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
d)
                   , Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Literal -> Term) -> (Int -> Literal) -> Int -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral (Integer -> Literal) -> (Int -> Integer) -> Int -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Term) -> Int -> Term
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
c)])

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

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

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

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

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

  "GHC.Prim.uncheckedIShiftL#"
    | [ Lit (IntLiteral i :: Integer
i)
      , Lit (IntLiteral s :: Integer
s)
      ] <- [Value]
args
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToIntLiteral (Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
s))
  "GHC.Prim.uncheckedIShiftRA#"
    | [ Lit (IntLiteral i :: Integer
i)
      , Lit (IntLiteral s :: Integer
s)
      ] <- [Value]
args
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToIntLiteral (Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
s))
  "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 Machine
reduce (Integer -> Term
integerToIntLiteral (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
c))

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

  "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 Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
           Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
tupDc) ((Type -> Either Term Type) -> [Type] -> [Either Term Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Either Term Type
forall a b. b -> Either a b
Right [Type]
tyArgs [Either Term Type] -> [Either Term Type] -> [Either Term Type]
forall a. [a] -> [a] -> [a]
++
                   [ Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Literal -> Term) -> (Word -> Literal) -> Word -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
WordLiteral (Integer -> Literal) -> (Word -> Integer) -> Word -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Integer
forall a. Integral a => a -> Integer
toInteger (Word -> Term) -> Word -> Term
forall a b. (a -> b) -> a -> b
$ Word# -> Word
W# Word#
d)
                   , Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Literal -> Term) -> (Int -> Literal) -> Int -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral (Integer -> Literal) -> (Int -> Integer) -> Int -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Term) -> Int -> Term
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
c)])

  "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 Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
           Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
tupDc) ((Type -> Either Term Type) -> [Type] -> [Either Term Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Either Term Type
forall a b. b -> Either a b
Right [Type]
tyArgs [Either Term Type] -> [Either Term Type] -> [Either Term Type]
forall a. [a] -> [a] -> [a]
++
                   [ Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Literal -> Term) -> (Word -> Literal) -> Word -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
WordLiteral (Integer -> Literal) -> (Word -> Integer) -> Word -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Integer
forall a. Integral a => a -> Integer
toInteger (Word -> Term) -> Word -> Term
forall a b. (a -> b) -> a -> b
$ Word# -> Word
W# Word#
h')
                   , Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Literal -> Term) -> (Word -> Literal) -> Word -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
WordLiteral (Integer -> Literal) -> (Word -> Integer) -> Word -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Integer
forall a. Integral a => a -> Integer
toInteger (Word -> Term) -> Word -> Term
forall a b. (a -> b) -> a -> b
$ Word# -> Word
W# Word#
l)])

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

  "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 Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
           Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
tupDc) ((Type -> Either Term Type) -> [Type] -> [Either Term Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Either Term Type
forall a b. b -> Either a b
Right [Type]
tyArgs [Either Term Type] -> [Either Term Type] -> [Either Term Type]
forall a. [a] -> [a] -> [a]
++
                   [ Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Literal -> Term) -> (Word -> Literal) -> Word -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
WordLiteral (Integer -> Literal) -> (Word -> Integer) -> Word -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Integer
forall a. Integral a => a -> Integer
toInteger (Word -> Term) -> Word -> Term
forall a b. (a -> b) -> a -> b
$ Word# -> Word
W# Word#
h')
                   , Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Literal -> Term) -> (Word -> Literal) -> Word -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
WordLiteral (Integer -> Literal) -> (Word -> Integer) -> Word -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Integer
forall a. Integral a => a -> Integer
toInteger (Word -> Term) -> Word -> Term
forall a b. (a -> b) -> a -> b
$ Word# -> Word
W# Word#
l)])

  "GHC.Prim.quotWord#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
wordLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Term -> Term
catchDivByZero (Integer -> Term
integerToWordLiteral (Integer
i Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
j))
  "GHC.Prim.remWord#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
wordLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Term -> Term
catchDivByZero (Integer -> Term
integerToWordLiteral (Integer
i Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`rem` Integer
j))
  "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 Machine
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 Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
           Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
tupDc) ((Type -> Either Term Type) -> [Type] -> [Either Term Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Either Term Type
forall a b. b -> Either a b
Right [Type]
tyArgs [Either Term Type] -> [Either Term Type] -> [Either Term Type]
forall a. [a] -> [a] -> [a]
++
                   [ Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> Either Term Type) -> Term -> Either Term Type
forall a b. (a -> b) -> a -> b
$ Term -> Term
catchDivByZero (Literal -> Term
Literal (Literal -> Term) -> (Word -> Literal) -> Word -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
WordLiteral (Integer -> Literal) -> (Word -> Integer) -> Word -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Integer
forall a. Integral a => a -> Integer
toInteger (Word -> Term) -> Word -> Term
forall a b. (a -> b) -> a -> b
$ Word# -> Word
W# Word#
x)
                   , Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> Either Term Type) -> Term -> Either Term Type
forall a b. (a -> b) -> a -> b
$ Term -> Term
catchDivByZero (Literal -> Term
Literal (Literal -> Term) -> (Word -> Literal) -> Word -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
WordLiteral (Integer -> Literal) -> (Word -> Integer) -> Word -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Integer
forall a. Integral a => a -> Integer
toInteger (Word -> Term) -> Word -> Term
forall a b. (a -> b) -> a -> b
$ Word# -> Word
W# Word#
y)])

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

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

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

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

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

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

  "GHC.Prim.ctz8#" | [i :: Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine)
-> (Integer -> Term) -> Integer -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Term
integerToWordLiteral (Integer -> Term) -> (Integer -> Integer) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> (Integer -> Int) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros (Word -> Int) -> (Integer -> Word) -> Integer -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Word
forall a. Num a => Integer -> a
fromInteger :: Integer -> Word) (Integer -> Maybe Machine) -> Integer -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Integer
i Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. (Int -> Integer
forall a. Bits a => Int -> a
bit 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 Machine
reduce (Term -> Maybe Machine)
-> (Integer -> Term) -> Integer -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Term
integerToWordLiteral (Integer -> Term) -> (Integer -> Integer) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> (Integer -> Int) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros (Word -> Int) -> (Integer -> Word) -> Integer -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Word
forall a. Num a => Integer -> a
fromInteger :: Integer -> Word) (Integer -> Maybe Machine) -> Integer -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Integer
i Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. (Int -> Integer
forall a. Bits a => Int -> a
bit 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 Machine
reduce (Term -> Maybe Machine)
-> (Integer -> Term) -> Integer -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Term
integerToWordLiteral (Integer -> Term) -> (Integer -> Integer) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> (Integer -> Int) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros (Word -> Int) -> (Integer -> Word) -> Integer -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Word
forall a. Num a => Integer -> a
fromInteger :: Integer -> Word) (Integer -> Maybe Machine) -> Integer -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Integer
i Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. (Int -> Integer
forall a. Bits a => Int -> a
bit 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 Machine
reduce (Term -> Maybe Machine)
-> (Integer -> Term) -> Integer -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Term
integerToWordLiteral (Integer -> Term) -> (Integer -> Integer) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> (Integer -> Int) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros (Word64 -> Int) -> (Integer -> Word64) -> Integer -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Word64
forall a. Num a => Integer -> a
fromInteger :: Integer -> Word64) (Integer -> Maybe Machine) -> Integer -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Integer
i Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. (Int -> Integer
forall a. Bits a => Int -> a
bit 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 Machine
reduce (Term -> Maybe Machine)
-> (Integer -> Term) -> Integer -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Term
integerToWordLiteral (Integer -> Term) -> (Integer -> Integer) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> (Integer -> Int) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros (Word -> Int) -> (Integer -> Word) -> Integer -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Word
forall a. Num a => Integer -> a
fromInteger :: Integer -> Word) (Integer -> Maybe Machine) -> Integer -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Integer
i

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

------------
-- 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 Machine
reduce (Term -> Maybe Machine) -> (Int -> Term) -> Int -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Term
Literal (Literal -> Term) -> (Int -> Literal) -> Int -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral (Integer -> Literal) -> (Int -> Integer) -> Int -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Maybe Machine) -> Int -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
b
  "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 Machine
reduce (Term -> Maybe Machine) -> (Int -> Term) -> Int -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Term
Literal (Literal -> Term) -> (Int -> Literal) -> Int -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral (Integer -> Literal) -> (Int -> Integer) -> Int -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Maybe Machine) -> Int -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
b
  "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 Machine
reduce (Term -> Maybe Machine) -> (Int -> Term) -> Int -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Term
Literal (Literal -> Term) -> (Int -> Literal) -> Int -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral (Integer -> Literal) -> (Int -> Integer) -> Int -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Maybe Machine) -> Int -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
b
  "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 Machine
reduce (Term -> Maybe Machine) -> (Word -> Term) -> Word -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Term
Literal (Literal -> Term) -> (Word -> Literal) -> Word -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
WordLiteral (Integer -> Literal) -> (Word -> Integer) -> Word -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Integer
forall a. Integral a => a -> Integer
toInteger (Word -> Maybe Machine) -> Word -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Word# -> Word
W# Word#
b
  "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 Machine
reduce (Term -> Maybe Machine) -> (Word -> Term) -> Word -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Term
Literal (Literal -> Term) -> (Word -> Literal) -> Word -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
WordLiteral (Integer -> Literal) -> (Word -> Integer) -> Word -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Integer
forall a. Integral a => a -> Integer
toInteger (Word -> Maybe Machine) -> Word -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Word# -> Word
W# Word#
b
  "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 Machine
reduce (Term -> Maybe Machine) -> (Word -> Term) -> Word -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Term
Literal (Literal -> Term) -> (Word -> Literal) -> Word -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
WordLiteral (Integer -> Literal) -> (Word -> Integer) -> Word -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Integer
forall a. Integral a => a -> Integer
toInteger (Word -> Maybe Machine) -> Word -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Word# -> Word
W# Word#
b

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

  "GHC.Prim.negateDouble#" | Just r :: Term
r <- (Double# -> Double#) -> [Value] -> Maybe Term
liftDD Double# -> Double#
negateDouble# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  "GHC.Prim.fabsDouble#" | Just r :: Term
r <- (Double# -> Double#) -> [Value] -> Maybe Term
liftDD Double# -> Double#
fabsDouble# [Value]
args
    -> Term -> Maybe Machine
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 Machine
reduce (Term -> Maybe Machine) -> (Int -> Term) -> Int -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Term
Literal (Literal -> Term) -> (Int -> Literal) -> Int -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral (Integer -> Literal) -> (Int -> Integer) -> Int -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Maybe Machine) -> Int -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
r
  "GHC.Prim.double2Float#"
    | [Lit (DoubleLiteral d :: Rational
d)] <- [Value]
args
    -> Term -> Maybe Machine
reduce (Literal -> Term
Literal (Rational -> Literal
FloatLiteral (Float -> Rational
forall a. Real a => a -> Rational
toRational (Rational -> Float
forall a. Fractional a => Rational -> a
fromRational Rational
d :: Float))))


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

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

  "GHC.Prim.**##" | Just r :: Term
r <- (Double# -> Double# -> Double#) -> [Value] -> Maybe Term
liftDDD Double# -> Double# -> Double#
(**##) [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
-- decodeDouble_2Int# :: Double# -> (#Int#, Word#, Word#, Int##)
  "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 Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
          Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
tupDc) ((Type -> Either Term Type) -> [Type] -> [Either Term Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Either Term Type
forall a b. b -> Either a b
Right [Type]
tyArgs [Either Term Type] -> [Either Term Type] -> [Either Term Type]
forall a. [a] -> [a] -> [a]
++
                   [ Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Literal -> Term) -> (Int -> Literal) -> Int -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral  (Integer -> Literal) -> (Int -> Integer) -> Int -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Term) -> Int -> Term
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
p)
                   , Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Literal -> Term) -> (Word -> Literal) -> Word -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
WordLiteral (Integer -> Literal) -> (Word -> Integer) -> Word -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Integer
forall a. Integral a => a -> Integer
toInteger (Word -> Term) -> Word -> Term
forall a b. (a -> b) -> a -> b
$ Word# -> Word
W# Word#
q)
                   , Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Literal -> Term) -> (Word -> Literal) -> Word -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
WordLiteral (Integer -> Literal) -> (Word -> Integer) -> Word -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Integer
forall a. Integral a => a -> Integer
toInteger (Word -> Term) -> Word -> Term
forall a b. (a -> b) -> a -> b
$ Word# -> Word
W# Word#
r)
                   , Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Literal -> Term) -> (Int -> Literal) -> Int -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral  (Integer -> Literal) -> (Int -> Integer) -> Int -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Term) -> Int -> Term
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
s)])
-- decodeDouble_Int64# :: Double# -> (# Int64#, Int# #)
  "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 Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
          Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
tupDc) ((Type -> Either Term Type) -> [Type] -> [Either Term Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Either Term Type
forall a b. b -> Either a b
Right [Type]
tyArgs [Either Term Type] -> [Either Term Type] -> [Either Term Type]
forall a. [a] -> [a] -> [a]
++
                   [ Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Literal -> Term) -> (Int64 -> Literal) -> Int64 -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral  (Integer -> Literal) -> (Int64 -> Integer) -> Int64 -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int64 -> Term) -> Int64 -> Term
forall a b. (a -> b) -> a -> b
$ Int# -> Int64
I64# Int#
p)
                   , Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Literal -> Term) -> (Int -> Literal) -> Int -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral  (Integer -> Literal) -> (Int -> Integer) -> Int -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Term) -> Int -> Term
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
q)])

--------
-- Float
--------
  "GHC.Prim.gtFloat#"  | Just r :: Term
r <- (Float# -> Float# -> Int#) -> [Value] -> Maybe Term
liftFFI Float# -> Float# -> Int#
gtFloat# [Value]
args
    -> Term -> Maybe Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
reduce Term
r

  "GHC.Prim.negateFloat#"  | Just r :: Term
r <- (Float# -> Float#) -> [Value] -> Maybe Term
liftFF Float# -> Float#
negateFloat# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  "GHC.Prim.fabsFloat#"  | Just r :: Term
r <- (Float# -> Float#) -> [Value] -> Maybe Term
liftFF Float# -> Float#
fabsFloat# [Value]
args
    -> Term -> Maybe Machine
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 Machine
reduce (Term -> Maybe Machine) -> (Int -> Term) -> Int -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Term
Literal (Literal -> Term) -> (Int -> Literal) -> Int -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral (Integer -> Literal) -> (Int -> Integer) -> Int -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Maybe Machine) -> Int -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
r

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

#if MIN_VERSION_base(4,12,0)
  -- GHC.Float.asinh  -- XXX: Very fragile
  --  $w$casinh is the Double specialisation of asinh
  --  $w$casinh1 is the Float specialisation of asinh
  "GHC.Float.$w$casinh" | Just r :: Term
r <- (Double# -> Double#) -> [Value] -> Maybe Term
liftDD Double# -> Double#
go [Value]
args
    -> Term -> Maybe Machine
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 Machine
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 Machine
reduce Term
r
  "GHC.Prim.acoshFloat#"  | Just r :: Term
r <- (Float# -> Float#) -> [Value] -> Maybe Term
liftFF Float# -> Float#
acoshFloat# [Value]
args
    -> Term -> Maybe Machine
reduce Term
r
  "GHC.Prim.atanhFloat#"  | Just r :: Term
r <- (Float# -> Float#) -> [Value] -> Maybe Term
liftFF Float# -> Float#
atanhFloat# [Value]
args
    -> Term -> Maybe Machine
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 Machine
reduce (Term -> Maybe Machine)
-> (Double -> Term) -> Double -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Term
Literal (Literal -> Term) -> (Double -> Literal) -> Double -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Literal
DoubleLiteral (Rational -> Literal) -> (Double -> Rational) -> Double -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Rational
forall a. Real a => a -> Rational
toRational (Double -> Maybe Machine) -> Double -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Double# -> Double
D# Double#
r


  "GHC.Prim.newByteArray#"
    | [iV :: Value
iV,PrimVal 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
           p :: Int
p = Machine -> Int
primCount Machine
mach
           lit :: Term
lit = Literal -> Term
Literal (Vector Word8 -> Literal
ByteArrayLiteral (Int -> Word8 -> Vector Word8
forall a. Prim a => Int -> a -> Vector a
Vector.replicate (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i) 0))
           mbaTy :: Type
mbaTy = Type -> Type -> Type
mkFunTy Type
intPrimTy ([Type] -> Type
forall a. [a] -> a
last [Type]
tyArgs)
           newE :: Term
newE = Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
tupDc) ((Type -> Either Term Type) -> [Type] -> [Either Term Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Either Term Type
forall a b. b -> Either a b
Right [Type]
tyArgs [Either Term Type] -> [Either Term Type] -> [Either Term Type]
forall a. [a] -> [a] -> [a]
++
                    [Term -> Either Term Type
forall a b. a -> Either a b
Left (PrimInfo -> Term
Prim PrimInfo
rwTy)
                    ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> [Either Term Type] -> Term
mkApps (PrimInfo -> Term
Prim (Text -> Type -> WorkInfo -> PrimInfo
PrimInfo "GHC.Prim.MutableByteArray#" Type
mbaTy WorkInfo
WorkNever))
                                  [Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Literal -> Term) -> (Integer -> Literal) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral (Integer -> Term) -> Integer -> Term
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
p)])
                    ])
       in Machine -> Maybe Machine
forall a. a -> Maybe a
Just (Machine -> Maybe Machine)
-> (Machine -> Machine) -> Machine -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Machine -> Machine
setTerm Term
newE (Machine -> Maybe Machine) -> Machine -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Int -> Term -> Machine -> Machine
primInsert Int
p Term
lit Machine
mach

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

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

  "GHC.Prim.unsafeFreezeByteArray#"
    | [PrimVal _mbaTy :: PrimInfo
_mbaTy _ [baV :: Value
baV]
      ,PrimVal 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
           Just ba' :: Term
ba' = Int -> Machine -> Maybe Term
primLookup (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
ba) Machine
mach
       in  Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
tupDc) ((Type -> Either Term Type) -> [Type] -> [Either Term Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Either Term Type
forall a b. b -> Either a b
Right [Type]
tyArgs [Either Term Type] -> [Either Term Type] -> [Either Term Type]
forall a. [a] -> [a] -> [a]
++
                      [Term -> Either Term Type
forall a b. a -> Either a b
Left (PrimInfo -> Term
Prim PrimInfo
rwTy)
                      ,Term -> Either Term Type
forall a b. a -> Either a b
Left Term
ba'])

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

  "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 Machine
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 _mbaTy :: PrimInfo
_mbaTy _ [baV :: Value
baV]
      ,PrimVal 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
           Just (Literal (ByteArrayLiteral ba' :: Vector Word8
ba')) = Int -> Machine -> Maybe Term
primLookup (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
ba) Machine
mach
           lit :: Term
lit = Literal -> Term
Literal (Integer -> Literal
IntLiteral (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Vector Word8 -> Int
forall a. Prim a => Vector a -> Int
Vector.length Vector Word8
ba')))
       in  Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
tupDc) ((Type -> Either Term Type) -> [Type] -> [Either Term Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Either Term Type
forall a b. b -> Either a b
Right [Type]
tyArgs [Either Term Type] -> [Either Term Type] -> [Either Term Type]
forall a. [a] -> [a] -> [a]
++
                      [Term -> Either Term Type
forall a b. a -> Either a b
Left (PrimInfo -> Term
Prim PrimInfo
rwTy)
                      ,Term -> Either Term Type
forall a b. a -> Either a b
Left Term
lit])

  "GHC.Prim.resizeMutableByteArray#"
    | [PrimVal mbaTy :: PrimInfo
mbaTy _ [baV :: Value
baV]
      ,iV :: Value
iV
      ,PrimVal 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
           p :: Int
p = Machine -> Int
primCount Machine
mach
           Just (Literal (ByteArrayLiteral (Vector.Vector 0 _ ba1 :: ByteArray
ba1)))
            = Int -> Machine -> Maybe Term
primLookup (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
ba) Machine
mach
           !(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 :: Type -> Type).
PrimMonad m =>
ByteArray -> m (MutableByteArray (PrimState m))
ByteArray.unsafeThawByteArray ByteArray
ba1
                   MutableByteArray RealWorld
mba' <- (State# RealWorld
 -> (# State# RealWorld, MutableByteArray RealWorld #))
-> IO (MutableByteArray RealWorld)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO (\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 :: Type -> Type).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
ByteArray.unsafeFreezeByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
mba'
           ba3 :: Term
ba3 = Literal -> Term
Literal (Vector Word8 -> Literal
ByteArrayLiteral (Int -> Int -> ByteArray -> Vector Word8
forall a. Int -> Int -> ByteArray -> Vector a
Vector.Vector 0 (Int# -> Int
I# Int#
i') ByteArray
ba2))
           newE :: Term
newE = Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
tupDc) ((Type -> Either Term Type) -> [Type] -> [Either Term Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Either Term Type
forall a b. b -> Either a b
Right [Type]
tyArgs [Either Term Type] -> [Either Term Type] -> [Either Term Type]
forall a. [a] -> [a] -> [a]
++
                    [Term -> Either Term Type
forall a b. a -> Either a b
Left (PrimInfo -> Term
Prim PrimInfo
rwTy)
                    ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> [Either Term Type] -> Term
mkApps (PrimInfo -> Term
Prim PrimInfo
mbaTy)
                                  [Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Literal -> Term) -> (Integer -> Literal) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral (Integer -> Term) -> Integer -> Term
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
p)])
                    ])
       in Machine -> Maybe Machine
forall a. a -> Maybe a
Just (Machine -> Maybe Machine)
-> (Machine -> Machine) -> Machine -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Machine -> Machine
setTerm Term
newE (Machine -> Maybe Machine) -> Machine -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Int -> Term -> Machine -> Machine
primInsert Int
p Term
ba3 Machine
mach

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

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

  "GHC.Prim.readWordArray#"
    | [PrimVal _mbaTy :: PrimInfo
_mbaTy _  [baV :: Value
baV]
      ,offV :: Value
offV
      ,PrimVal 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
           Just (Literal (ByteArrayLiteral (Vector.Vector _ _ ba1 :: ByteArray
ba1))) =
              Int -> Machine -> Maybe Term
primLookup (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
ba) Machine
mach
           !(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 :: Type -> Type).
PrimMonad m =>
ByteArray -> m (MutableByteArray (PrimState m))
ByteArray.unsafeThawByteArray ByteArray
ba1
                  (State# RealWorld -> (# State# RealWorld, Word #)) -> IO Word
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO (\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 (PrimInfo -> Term
Prim PrimInfo
rwTy)
                    ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
WordLiteral (Word -> Integer
forall a. Integral a => a -> Integer
toInteger Word
w)))
                    ])
       in Term -> Maybe Machine
reduce Term
newE

-- decodeFloat_Int# :: Float# -> (#Int#, Int##)
  "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 Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
          Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
tupDc) ((Type -> Either Term Type) -> [Type] -> [Either Term Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Either Term Type
forall a b. b -> Either a b
Right [Type]
tyArgs [Either Term Type] -> [Either Term Type] -> [Either Term Type]
forall a. [a] -> [a] -> [a]
++
                   [ Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Literal -> Term) -> (Int -> Literal) -> Int -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral  (Integer -> Literal) -> (Int -> Integer) -> Int -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Term) -> Int -> Term
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
p)
                   , Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Literal -> Term) -> (Int -> Literal) -> Int -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral  (Integer -> Literal) -> (Int -> Integer) -> Int -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Term) -> Int -> Term
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
q)])

  "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 :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Maybe a
List.find ((Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+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 (\e :: DataCon
e -> Term -> Machine -> Machine
setTerm (DataCon -> Term
Data DataCon
e) Machine
mach) (DataCon -> Machine) -> Maybe DataCon -> Maybe Machine
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe DataCon
dc


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

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

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

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

         _ -> Maybe Machine
forall a. Maybe a
Nothing

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

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

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

         _ -> Maybe Machine
forall a. Maybe a
Nothing

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

  -- modInt# :: Int# -> Int# -> Int#
  "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 Machine
reduce (Type -> Term
undefinedTm Type
iTy)
      else
        Term -> Maybe Machine
reduce (Literal -> Term
Literal (Integer -> Literal
IntLiteral (Integer
dividend Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
divisor)))

  "GHC.Classes.not"
    | [DC bCon :: DataCon
bCon _] <- [Value]
args
    -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (Name DataCon -> Text
forall a. Name a -> Text
nameOcc (DataCon -> Name DataCon
dcName DataCon
bCon) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "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 Machine
reduce (Term -> Maybe Machine) -> (Int -> Term) -> Int -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Term
Literal (Literal -> Term) -> (Int -> Literal) -> Int -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral (Integer -> Literal) -> (Int -> Integer) -> Int -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger) Int
c

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

  "GHC.Integer.Type.integerToInt"
    | [i :: Integer
i] <- [Value] -> [Integer]
integerLiterals' [Value]
args
    -> Term -> Maybe Machine
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 Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
       Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
tupDc) ((Type -> Either Term Type) -> [Type] -> [Either Term Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Either Term Type
forall a b. b -> Either a b
Right [Type]
tyArgs [Either Term Type] -> [Either Term Type] -> [Either Term Type]
forall a. [a] -> [a] -> [a]
++
                [ Term -> Either Term Type
forall a b. a -> Either a b
Left (Integer -> Term
integerToIntegerLiteral Integer
b)
                , Term -> Either Term Type
forall a b. a -> Either a b
Left (Integer -> Term
integerToIntLiteral (Integer -> Term) -> (Int -> Integer) -> Int -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Term) -> Int -> Term
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
c)])

  "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 Machine
reduce (Term -> Maybe Machine)
-> (Double -> Term) -> Double -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Term
Literal (Literal -> Term) -> (Double -> Literal) -> Double -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Literal
DoubleLiteral (Rational -> Literal) -> (Double -> Rational) -> Double -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Rational
forall a. Real a => a -> Rational
toRational (Double -> Maybe Machine) -> Double -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Double# -> Double
D# Double#
r

  "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 Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
         Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
tupDc) ((Type -> Either Term Type) -> [Type] -> [Either Term Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Either Term Type
forall a b. b -> Either a b
Right [Type]
tyArgs [Either Term Type] -> [Either Term Type] -> [Either Term Type]
forall a. [a] -> [a] -> [a]
++
                [ Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> Either Term Type) -> Term -> Either Term Type
forall a b. (a -> b) -> a -> b
$ Term -> Term
catchDivByZero (Integer -> Term
integerToIntegerLiteral Integer
q)
                , Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> Either Term Type) -> Term -> Either Term Type
forall a b. (a -> b) -> a -> b
$ Term -> Term
catchDivByZero (Integer -> Term
integerToIntegerLiteral Integer
r)])

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

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

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

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

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

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

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

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

  "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 Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
           Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
ubTupDc) [ Type -> Either Term Type
forall a b. b -> Either a b
Right Type
liftedKi, Type -> Either Term Type
forall a b. b -> Either a b
Right Type
liftedKi
                                 , Type -> Either Term Type
forall a b. b -> Either a b
Right Type
intTy,    Type -> Either Term Type
forall a b. b -> Either a b
Right Type
intTy
                                 , Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> Either Term Type) -> Term -> Either Term Type
forall a b. (a -> b) -> a -> b
$ Term -> Term
catchDivByZero (Literal -> Term
Literal (Integer -> Literal
IntegerLiteral Integer
d))
                                 , Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> Either Term Type) -> Term -> Either Term Type
forall a b. (a -> b) -> a -> b
$ Term -> Term
catchDivByZero (Literal -> Term
Literal (Integer -> Literal
IntegerLiteral Integer
m))
                                 ]

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

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

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

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

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

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

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

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

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

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

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

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

  "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 Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
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 Machine
reduce (Integer -> Term
integerToIntegerLiteral (Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
j))

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

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

  "GHC.Integer.Type.integerToWord"
    | [i :: Integer
i] <- [Value] -> [Integer]
integerLiterals' [Value]
args
    -> Term -> Maybe Machine
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 Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (Integer -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Integer
i (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
j)))

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

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

  "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 Machine
reduce (Type -> Integer -> (Natural -> Natural) -> Term
checkNaturalRange1 Type
nTy Integer
i Natural -> Natural
forall a. a -> a
id)

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

  "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 Machine
reduce (Type
-> Integer -> Integer -> (Natural -> Natural -> Natural) -> Term
checkNaturalRange2 Type
nTy Integer
i Integer
j Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
(+))

  "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 Machine
reduce (Type
-> Integer -> Integer -> (Natural -> Natural -> Natural) -> Term
checkNaturalRange2 Type
nTy Integer
i Integer
j Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
(*))

  "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 Machine
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 Machine
reduce (Type -> Integer -> (Natural -> Natural) -> Term
checkNaturalRange1 Type
nTy Integer
w Natural -> Natural
forall a. a -> a
id)

  "GHC.Natural.gcdNatural"
    | 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 Machine
reduce (Type
-> Integer -> Integer -> (Natural -> Natural -> Natural) -> Term
checkNaturalRange2 Type
nTy Integer
i Integer
j Natural -> Natural -> Natural
forall a. Integral a => a -> a -> a
gcd)

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

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

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

  "GHC.TypeNats.natVal"
    | [Lit (NaturalLiteral n :: Integer
n), _] <- [Value]
args
    -> Term -> Maybe Machine
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 Machine
reduce (Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
charDc) [Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Char -> Literal
CharLiteral Char
c))])

  "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 Machine
reduce (Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
intDc) [Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
IntLiteral Integer
i))])
  "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 Machine
reduce (Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
intDc) [Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
IntLiteral Integer
i))])
  "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 Machine
reduce (Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
intDc) [Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
IntLiteral Integer
i))])
  "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 Machine
reduce (Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
intDc) [Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
IntLiteral Integer
i))])
  "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 Machine
reduce (Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
intDc) [Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
IntLiteral Integer
i))])

  "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 Machine
reduce (Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
wordDc) [Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
WordLiteral Integer
c))])
  "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 Machine
reduce (Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
wordDc) [Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
WordLiteral Integer
c))])
  "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 Machine
reduce (Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
wordDc) [Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
WordLiteral Integer
c))])
  "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 Machine
reduce (Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
wordDc) [Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
WordLiteral Integer
c))])
  "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 Machine
reduce (Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
wordDc) [Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
WordLiteral Integer
c))])

  "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 Machine
reduce (Literal -> Term
Literal (Rational -> Literal
FloatLiteral (Float -> Rational
forall a. Real a => a -> Rational
toRational (Rational -> Float
forall a. Fractional a => Rational -> a
fromRational (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 Machine
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 Machine
forall a. HasCallStack => [Char] -> a
error ([Char] -> Maybe Machine) -> [Char] -> Maybe Machine
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 Machine
reduce (Literal -> Term
Literal (Rational -> Literal
FloatLiteral (Float -> Rational
forall a. Real a => a -> Rational
toRational (Rational -> Float
forall a. Fractional a => Rational -> a
fromRational (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 Machine
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 Machine
forall a. HasCallStack => [Char] -> a
error ([Char] -> Maybe Machine) -> [Char] -> Maybe Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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
    , mach2 :: Machine
mach2@Machine{mStack :: Machine -> Stack
mStack=[],mTerm :: Machine -> Term
mTerm=Literal (DoubleLiteral i :: Rational
i)} <- TyConMap -> Bool -> Machine -> Machine
whnf TyConMap
tcm Bool
True (Term -> Machine -> Machine
setTerm Term
arg (Machine -> Machine) -> Machine -> Machine
forall a b. (a -> b) -> a -> b
$ Machine -> Machine
stackClear Machine
mach)
    -> let resTyInfo :: (Type, Type, Integer)
resTyInfo = TyConMap -> Type -> [Type] -> (Type, Type, Integer)
extractTySizeInfo TyConMap
tcm Type
ty [Type]
tys
        in Machine -> Maybe Machine
forall a. a -> Maybe a
Just (Machine -> Maybe Machine) -> Machine -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Machine
mach2
             { mStack :: Stack
mStack = Machine -> Stack
mStack Machine
mach
             , mTerm :: Term
mTerm = (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
    , mach2 :: Machine
mach2@Machine{mStack :: Machine -> Stack
mStack=[],mTerm :: Machine -> Term
mTerm=Literal (FloatLiteral i :: Rational
i)} <- TyConMap -> Bool -> Machine -> Machine
whnf TyConMap
tcm Bool
True (Term -> Machine -> Machine
setTerm Term
arg (Machine -> Machine) -> Machine -> Machine
forall a b. (a -> b) -> a -> b
$ Machine -> Machine
stackClear Machine
mach)
    -> let resTyInfo :: (Type, Type, Integer)
resTyInfo = TyConMap -> Type -> [Type] -> (Type, Type, Integer)
extractTySizeInfo TyConMap
tcm Type
ty [Type]
tys
        in Machine -> Maybe Machine
forall a. a -> Maybe a
Just (Machine -> Maybe Machine) -> Machine -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Machine
mach2
             { mStack :: Stack
mStack = Machine -> Stack
mStack Machine
mach
             , mTerm :: Term
mTerm = (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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
           Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
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 Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
           Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
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 Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
           Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
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 Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
           Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
reduce (Type -> Integer -> Integer -> Term
mkBitLit Type
ty 0 1)
  "Clash.Sized.Internal.BitVector.low"
    -> Term -> Maybe Machine
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 Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
j))
  "Clash.Sized.Internal.BitVector.neq##" | [(0,i :: Integer
i),(0,j :: Integer
j)] <- [Value] -> [(Integer, Integer)]
bitLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
j))

-- Ord
  "Clash.Sized.Internal.BitVector.lt##" | [(0,i :: Integer
i),(0,j :: Integer
j)] <- [Value] -> [(Integer, Integer)]
bitLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<  Integer
j))
  "Clash.Sized.Internal.BitVector.ge##" | [(0,i :: Integer
i),(0,j :: Integer
j)] <- [Value] -> [(Integer, Integer)]
bitLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
j))
  "Clash.Sized.Internal.BitVector.gt##" | [(0,i :: Integer
i),(0,j :: Integer
j)] <- [Value] -> [(Integer, Integer)]
bitLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>  Integer
j))
  "Clash.Sized.Internal.BitVector.le##" | [(0,i :: Integer
i),(0,j :: Integer
j)] <- [Value] -> [(Integer, Integer)]
bitLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
j))

-- Bits
  "Clash.Sized.Internal.BitVector.and##"
    | [(0,i :: Integer
i),(0,j :: Integer
j)] <- [Value] -> [(Integer, Integer)]
bitLiterals [Value]
args
    -> Term -> Maybe Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 bvP :: PrimInfo
bvP _ [_, Lit (IntegerLiteral mskBv :: Integer
mskBv), Lit (IntegerLiteral bv :: Integer
bv)]
      , Value -> Maybe [Term]
valArgs -> Just [Literal (IntLiteral i :: Integer
i)]
      , PrimVal bP :: PrimInfo
bP _ [Lit (IntegerLiteral mskB :: Integer
mskB), Lit (IntegerLiteral b :: Integer
b)]
      ] <- [Value]
args
    , PrimInfo -> Text
primName PrimInfo
bvP Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "Clash.Sized.Internal.BitVector.fromInteger#"
    , PrimInfo -> Text
primName PrimInfo
bP  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 Machine
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 Machine
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 Machine
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' = HasCallStack => TyConMap -> Type -> [Type] -> Type
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 Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
       Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
tupDc) ((Type -> Either Term Type) -> [Type] -> [Either Term Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Either Term Type
forall a b. b -> Either a b
Right [Type]
tyArgs [Either Term Type] -> [Either Term Type] -> [Either Term Type]
forall a. [a] -> [a] -> [a]
++
                [ Term -> Either Term Type
forall a b. a -> Either a b
Left (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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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' = HasCallStack => TyConMap -> Type -> [Type] -> Type
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 Machine
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' = HasCallStack => TyConMap -> Type -> [Type] -> Type
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 -> Type).
(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 Machine
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' = HasCallStack => TyConMap -> Type -> [Type] -> Type
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 Machine
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 Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
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 Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
j))
  "Clash.Sized.Internal.Index.neq#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
indexLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
j))

-- Ord
  "Clash.Sized.Internal.Index.lt#"
    | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
indexLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
j))
  "Clash.Sized.Internal.Index.ge#"
    | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
indexLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
j))
  "Clash.Sized.Internal.Index.gt#"
    | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
indexLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
j))
  "Clash.Sized.Internal.Index.le#"
    | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
indexLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
j))

-- 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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
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 Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
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 p :: PrimInfo
p _ [_, Lit (IntegerLiteral i :: Integer
i)]] <- [Value]
args
    , PrimInfo -> Text
primName PrimInfo
p Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "Clash.Sized.Internal.Index.fromInteger#"
    -> Term -> Maybe Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
j))
  "Clash.Sized.Internal.Signed.neq#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
signedLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
j))

-- Ord
  "Clash.Sized.Internal.Signed.lt#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
signedLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<  Integer
j))
  "Clash.Sized.Internal.Signed.ge#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
signedLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
j))
  "Clash.Sized.Internal.Signed.gt#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
signedLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>  Integer
j))
  "Clash.Sized.Internal.Signed.le#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
signedLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
j))

-- 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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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' = HasCallStack => TyConMap -> Type -> [Type] -> Type
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 Machine
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' = HasCallStack => TyConMap -> Type -> [Type] -> Type
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 Machine
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' = HasCallStack => TyConMap -> Type -> [Type] -> Type
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 Machine
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 Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
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 Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
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 Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
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 Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Term -> Term
catchDivByZero Term
val
  "Clash.Sized.Internal.Signed.toInteger#"
    | [PrimVal p :: PrimInfo
p _ [_, Lit (IntegerLiteral i :: Integer
i)]] <- [Value]
args
    , PrimInfo -> Text
primName PrimInfo
p Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "Clash.Sized.Internal.Signed.fromInteger#"
    -> Term -> Maybe Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
j))
  "Clash.Sized.Internal.Unsigned.neq#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
unsignedLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
j))

-- Ord
  "Clash.Sized.Internal.Unsigned.lt#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
unsignedLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<  Integer
j))
  "Clash.Sized.Internal.Unsigned.ge#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
unsignedLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
j))
  "Clash.Sized.Internal.Unsigned.gt#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
unsignedLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>  Integer
j))
  "Clash.Sized.Internal.Unsigned.le#" | Just (i :: Integer
i,j :: Integer
j) <- [Value] -> Maybe (Integer, Integer)
unsignedLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
j))

-- 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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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' = HasCallStack => TyConMap -> Type -> [Type] -> Type
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 Machine
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' = HasCallStack => TyConMap -> Type -> [Type] -> Type
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 -> Type).
(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 Machine
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' = HasCallStack => TyConMap -> Type -> [Type] -> Type
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 Machine
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 Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
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 Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Term -> Term
catchDivByZero Term
val
  "Clash.Sized.Internal.Unsigned.toInteger#"
    | [PrimVal p :: PrimInfo
p _ [_, Lit (IntegerLiteral i :: Integer
i)]] <- [Value]
args
    , PrimInfo -> Text
primName PrimInfo
p Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "Clash.Sized.Internal.Unsigned.fromInteger#"
    -> Term -> Maybe Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
           Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
tupDc)
                  [Type -> Either Term Type
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 Machine
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 Machine
reduceWHNF (Term -> Maybe Machine) -> Term -> Maybe Machine
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 (PrimInfo -> Term
Prim 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 (PrimInfo -> Term
Prim 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' = HasCallStack => TyConMap -> Type -> [Type] -> Type
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
reduceWHNF (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
                              Term -> [Either Term Type] -> Term
mkApps (PrimInfo -> Term
Prim 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 Machine
forall a. Maybe a
Nothing
                 _ -> Maybe Machine
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 Machine
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 Machine
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 Machine
reduceWHNF
                (Term -> [Either Term Type] -> Term
mkApps (PrimInfo -> Term
Prim 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 Machine
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 Machine
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 Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
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 (PrimInfo -> Term
Prim 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 Machine
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 Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
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 (PrimInfo -> Term
Prim 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 Machine
reduceWHNF (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
                   Term -> [Either Term Type] -> Term
mkApps (PrimInfo -> Term
Prim 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 = HasCallStack => TyConMap -> Type -> [Type] -> Type
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 (PrimInfo -> Term
Prim 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 Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
              Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
tupDc) ([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 Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
               Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
tupDc) ([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 Machine
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 Machine
reduce (DataCon -> Type -> Term
mkVecNil DataCon
nilCon Type
mVecTy)
         _ -> Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
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 (PrimInfo -> Term
Prim 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' = HasCallStack => TyConMap -> Type -> [Type] -> Type
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 Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
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 Machine
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 Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
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 (PrimInfo -> Term
Prim 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 Machine
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 Machine
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 Machine
reduceWHNF (Term -> Maybe Machine) -> Term -> Maybe Machine
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 (PrimInfo -> Term
Prim 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 Machine
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 Machine
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 Machine
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 Machine
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 Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
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 (PrimInfo -> Term
Prim 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 Machine
forall a. Maybe a
Nothing
                 _ -> Maybe Machine
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 Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
j))

-- - 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 Machine
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 Machine
reduceWHNF (Term -> Maybe Machine) -> Term -> Maybe Machine
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 (PrimInfo -> Term
Prim 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 Machine
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 Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
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 Machine
reduceWHNF (Term -> Maybe Machine) -> Term -> Maybe Machine
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 (PrimInfo -> Term
Prim 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 Machine
reduce (DataCon -> Type -> Term
mkVecNil DataCon
dc Type
aTy)
         n' :: Integer
n' | DC snatDc :: DataCon
snatDc [_,Left d' :: Term
d'] <- Value
d
            , mach2 :: Machine
mach2@Machine{mStack :: Machine -> Stack
mStack=[],mTerm :: Machine -> Term
mTerm=Literal (NaturalLiteral d2 :: Integer
d2)} <- TyConMap -> Bool -> Machine -> Machine
whnf TyConMap
tcm Bool
isSubj (Term -> Machine -> Machine
setTerm Term
d' (Machine -> Machine) -> Machine -> Machine
forall a b. (a -> b) -> a -> b
$ Machine -> Machine
stackClear Machine
mach)
            -> case (Integer
d2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
n) of
                 0  -> Term -> Maybe Machine
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  Machine -> Term -> Maybe Machine
reduceWHNF' Machine
mach2 (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
                           Term -> [Either Term Type] -> Term
mkApps (PrimInfo -> Term
Prim 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 Machine
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 Machine
reduce (DataCon -> Type -> Term
mkVecNil DataCon
dc Type
aTy)
         n' :: Integer
n' | DC snatDc :: DataCon
snatDc [_,Left d' :: Term
d'] <- Value
d
            , mach2 :: Machine
mach2@Machine{mStack :: Machine -> Stack
mStack=[],mTerm :: Machine -> Term
mTerm=Literal (NaturalLiteral d2 :: Integer
d2)} <- TyConMap -> Bool -> Machine -> Machine
whnf TyConMap
tcm Bool
isSubj (Term -> Machine -> Machine
setTerm Term
d' (Machine -> Machine) -> Machine -> Machine
forall a b. (a -> b) -> a -> b
$ Machine -> Machine
stackClear Machine
mach)
            -> case (Integer
d2 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
n) of
                 0  -> Term -> Maybe Machine
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  Machine -> Term -> Maybe Machine
reduceWHNF' Machine
mach2 (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
                           Term -> [Either Term Type] -> Term
mkApps (PrimInfo -> Term
Prim 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 Machine
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 Machine
reduce (DataCon -> Type -> Term
mkVecNil DataCon
dc Type
bTy)
         n' :: Integer
n' -> Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
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 (PrimInfo -> Term
Prim 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 Machine
reduceWHNF (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
       Term -> [Either Term Type] -> Term
mkApps (PrimInfo -> Term
Prim (Text -> Type -> WorkInfo -> PrimInfo
PrimInfo "Clash.Sized.Vector.imap_go" (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 Machine
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 Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
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 (PrimInfo -> Term
Prim 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 (PrimInfo -> Term
Prim (Text -> Type -> WorkInfo -> PrimInfo
PrimInfo "Clash.Sized.Internal.Index.+#" (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 Machine
reduce (DataCon -> Type -> Term
mkVecNil DataCon
dc Type
cTy)
         n' :: Integer
n' -> Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
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 (PrimInfo -> Term
Prim 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 Machine
reduce (Value -> Term
valToTerm Value
z)
         _ -> Term -> Maybe Machine
reduceWHNF (Term -> Maybe Machine) -> Term -> Maybe Machine
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 (PrimInfo -> Term
Prim 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 Machine
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 (PrimInfo -> Term
Prim (Text -> Type -> WorkInfo -> PrimInfo
PrimInfo "Clash.Sized.Vector.fold_split" (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 Machine
reduceWHNF (Term -> Maybe Machine) -> Term -> Maybe Machine
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 (PrimInfo -> Term
Prim 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 (PrimInfo -> Term
Prim 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 = HasCallStack => TyConMap -> Type -> [Type] -> Type
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 (PrimInfo -> Term
Prim 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 Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
              Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
tupDc) ([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 Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
               Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
tupDc) ([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 Machine
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 Machine
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 Machine
reduceWHNF (Term -> Maybe Machine) -> Term -> Maybe Machine
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 (PrimInfo -> Term
Prim 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 Machine
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 Machine
reduceWHNF (Term -> Maybe Machine) -> Term -> Maybe Machine
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 (PrimInfo -> Term
Prim 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 (PrimInfo -> Term
Prim 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 Machine
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 Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
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 (PrimInfo -> Term
Prim 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 :: Type -> Type).
(HasCallStack, Functor 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  Machine -> Term -> Maybe Machine
reduceWHNF' (Machine
mach { mSupply :: Supply
mSupply = Supply
ids' }) (Term -> Maybe Machine) -> Term -> Maybe Machine
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 :: Type -> Type).
(HasCallStack, Functor 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 :: Type -> Type).
(HasCallStack, Functor 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 :: Type -> Type).
(HasCallStack, Functor 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 :: Type -> Type) 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  Machine -> Term -> Maybe Machine
reduceWHNF' (Machine
mach { mSupply :: Supply
mSupply = Supply
ids' }) (Term -> Maybe Machine) -> Term -> Maybe Machine
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 (PrimInfo -> Term
Prim 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)
      (ids :: Supply
ids, is0 :: InScopeSet
is0) = (Machine -> Supply
mSupply Machine
mach, Machine -> InScopeSet
mScopeNames Machine
mach)

-- 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 Machine
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 Machine
reduceWHNF (Term -> Maybe Machine) -> Term -> Maybe Machine
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 (PrimInfo -> Term
Prim 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 Machine
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 Machine
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 Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
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 (PrimInfo -> Term
Prim 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 Machine
forall a. Maybe a
Nothing
  _ -> Maybe Machine
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 :: Type -> Type) 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 Machine
    reduce :: Term -> Maybe Machine
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 Machine -> Maybe Machine
forall a. [Char] -> a -> a
trace ([[Char]] -> [Char]
unlines ["Warning: Not evaluating constant expression:", Text -> [Char]
forall a. Show a => a -> [Char]
show (PrimInfo -> Text
primName PrimInfo
pInfo), "Because doing so generates an XException:", [Char]
msg]) Maybe Machine
forall a. Maybe a
Nothing
      Right e' :: Term
e' -> Machine -> Maybe Machine
forall a. a -> Maybe a
Just (Term -> Machine -> Machine
setTerm Term
e' Machine
mach)

    reduceWHNF :: Term -> Maybe Machine
reduceWHNF e :: Term
e =
      let mach1 :: Machine
mach1@Machine{mStack :: Machine -> Stack
mStack=[]} = TyConMap -> Bool -> Machine -> Machine
whnf TyConMap
tcm Bool
isSubj (Term -> Machine -> Machine
setTerm Term
e (Machine -> Machine) -> Machine -> Machine
forall a b. (a -> b) -> a -> b
$ Machine -> Machine
stackClear Machine
mach)
      in Machine -> Maybe Machine
forall a. a -> Maybe a
Just (Machine -> Maybe Machine) -> Machine -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Machine
mach1 { mStack :: Stack
mStack = Machine -> Stack
mStack Machine
mach }

    reduceWHNF' :: Machine -> Term -> Maybe Machine
reduceWHNF' mach1 :: Machine
mach1 e :: Term
e =
      let mach2 :: Machine
mach2@Machine{mStack :: Machine -> Stack
mStack=[]} = TyConMap -> Bool -> Machine -> Machine
whnf TyConMap
tcm Bool
isSubj (Term -> Machine -> Machine
setTerm Term
e Machine
mach1)
       in Machine -> Maybe Machine
forall a. a -> Maybe a
Just (Machine -> Maybe Machine) -> Machine -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Machine
mach2 { mStack :: Stack
mStack = Machine -> Stack
mStack Machine
mach }

    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 (PrimInfo -> Term
Prim 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)

-- Helper functions for literals

pairOf :: (Value -> Maybe a) -> [Value] -> Maybe (a, a)
pairOf :: (Value -> Maybe a) -> [Value] -> Maybe (a, a)
pairOf f :: Value -> Maybe a
f [x :: Value
x, y :: Value
y] = (,) (a -> a -> (a, a)) -> Maybe a -> Maybe (a -> (a, a))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Maybe a
f Value
x Maybe (a -> (a, a)) -> Maybe a -> Maybe (a, a)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Value -> Maybe a
f Value
y
pairOf _ _ = Maybe (a, a)
forall a. Maybe a
Nothing

listOf :: (Value -> Maybe a) -> [Value] -> [a]
listOf :: (Value -> Maybe a) -> [Value] -> [a]
listOf = (Value -> Maybe a) -> [Value] -> [a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe

wrapUnsigned :: Integer -> Integer -> Integer
wrapUnsigned :: Integer -> Integer -> Integer
wrapUnsigned n :: Integer
n i :: Integer
i = Integer
i Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
sz
 where
  sz :: Integer
sz = 1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n

wrapSigned :: Integer -> Integer -> Integer
wrapSigned :: Integer -> Integer -> Integer
wrapSigned n :: Integer
n i :: Integer
i = if Integer
mask Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then 0 else Integer
res
 where
  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
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 1)
  res :: Integer
res  = case Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
divMod Integer
i Integer
mask of
           (s :: Integer
s,i1 :: Integer
i1) | Integer -> Bool
forall a. Integral a => a -> Bool
even Integer
s    -> Integer
i1
                  | Bool
otherwise -> Integer
i1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
mask

doubleLiterals' :: [Value] -> [Rational]
doubleLiterals' :: [Value] -> [Rational]
doubleLiterals' = (Value -> Maybe Rational) -> [Value] -> [Rational]
forall a. (Value -> Maybe a) -> [Value] -> [a]
listOf Value -> Maybe Rational
doubleLiteral

doubleLiteral :: Value -> Maybe Rational
doubleLiteral :: Value -> Maybe Rational
doubleLiteral v :: Value
v = case Value
v 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]
listOf Value -> Maybe Rational
floatLiteral

floatLiteral :: Value -> Maybe Rational
floatLiteral :: Value -> Maybe Rational
floatLiteral v :: Value
v = case Value
v 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 = (Value -> Maybe Integer) -> [Value] -> Maybe (Integer, Integer)
forall a. (Value -> Maybe a) -> [Value] -> Maybe (a, a)
pairOf Value -> Maybe Integer
integerLiteral

integerLiteral :: Value -> Maybe Integer
integerLiteral :: Value -> Maybe Integer
integerLiteral v :: Value
v =
  case Value
v of
    Lit (IntegerLiteral i :: Integer
i) -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i
    DC dc :: DataCon
dc [Left (Literal (IntLiteral i :: Integer
i))]
      | DataCon -> Int
dcTag DataCon
dc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1
      -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i
    DC dc :: DataCon
dc [Left (Literal (ByteArrayLiteral (Vector.Vector _ _ (ByteArray.ByteArray ba :: ByteArray#
ba))))]
      | DataCon -> Int
dcTag DataCon
dc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 2
      -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just (BigNat -> Integer
Jp# (ByteArray# -> BigNat
BN# ByteArray#
ba))
      | DataCon -> Int
dcTag DataCon
dc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 3
      -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just (BigNat -> Integer
Jn# (ByteArray# -> BigNat
BN# ByteArray#
ba))
    _ -> Maybe Integer
forall a. Maybe a
Nothing

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

naturalLiteral :: Value -> Maybe Integer
naturalLiteral :: Value -> Maybe Integer
naturalLiteral v :: Value
v =
  case Value
v of
    Lit (NaturalLiteral i :: Integer
i) -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i
    DC dc :: DataCon
dc [Left (Literal (WordLiteral i :: Integer
i))]
      | DataCon -> Int
dcTag DataCon
dc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1
      -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i
    DC dc :: DataCon
dc [Left (Literal (ByteArrayLiteral (Vector.Vector _ _ (ByteArray.ByteArray ba :: ByteArray#
ba))))]
      | DataCon -> Int
dcTag DataCon
dc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 2
      -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just (BigNat -> Integer
Jp# (ByteArray# -> BigNat
BN# ByteArray#
ba))
    _ -> Maybe 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]
listOf Value -> Maybe Integer
integerLiteral

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

intLiterals :: [Value] -> Maybe (Integer,Integer)
intLiterals :: [Value] -> Maybe (Integer, Integer)
intLiterals = (Value -> Maybe Integer) -> [Value] -> Maybe (Integer, Integer)
forall a. (Value -> Maybe a) -> [Value] -> Maybe (a, a)
pairOf Value -> Maybe Integer
intLiteral

intLiterals' :: [Value] -> [Integer]
intLiterals' :: [Value] -> [Integer]
intLiterals' = (Value -> Maybe Integer) -> [Value] -> [Integer]
forall a. (Value -> Maybe a) -> [Value] -> [a]
listOf Value -> Maybe Integer
intLiteral

intLiteral :: Value -> Maybe Integer
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 v :: Value
v = case Value
v of
  (DC _ [Left (Literal (IntLiteral i :: Integer
i))]) -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i
  _ -> Maybe Integer
forall a. Maybe a
Nothing

intCLiterals :: [Value] -> Maybe (Integer, Integer)
intCLiterals :: [Value] -> Maybe (Integer, Integer)
intCLiterals = (Value -> Maybe Integer) -> [Value] -> Maybe (Integer, Integer)
forall a. (Value -> Maybe a) -> [Value] -> Maybe (a, a)
pairOf Value -> Maybe Integer
intCLiteral

wordLiterals :: [Value] -> Maybe (Integer,Integer)
wordLiterals :: [Value] -> Maybe (Integer, Integer)
wordLiterals = (Value -> Maybe Integer) -> [Value] -> Maybe (Integer, Integer)
forall a. (Value -> Maybe a) -> [Value] -> Maybe (a, a)
pairOf Value -> Maybe Integer
wordLiteral

wordLiterals' :: [Value] -> [Integer]
wordLiterals' :: [Value] -> [Integer]
wordLiterals' = (Value -> Maybe Integer) -> [Value] -> [Integer]
forall a. (Value -> Maybe a) -> [Value] -> [a]
listOf Value -> Maybe Integer
wordLiteral

wordLiteral :: Value -> Maybe Integer
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 = (Value -> Maybe Char) -> [Value] -> Maybe (Char, Char)
forall a. (Value -> Maybe a) -> [Value] -> Maybe (a, a)
pairOf Value -> Maybe Char
charLiteral

charLiterals' :: [Value] -> [Char]
charLiterals' :: [Value] -> [Char]
charLiterals' = (Value -> Maybe Char) -> [Value] -> [Char]
forall a. (Value -> Maybe a) -> [Value] -> [a]
listOf Value -> Maybe Char
charLiteral

charLiteral :: Value -> Maybe Char
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 = (Value -> Maybe Integer) -> [Value] -> Maybe (Integer, Integer)
forall a. (Value -> Maybe a) -> [Value] -> Maybe (a, a)
pairOf (Text -> Value -> Maybe Integer
sizedLiteral Text
szCon)

sizedLiterals' :: Text -> [Value] -> [Integer]
sizedLiterals' :: Text -> [Value] -> [Integer]
sizedLiterals' szCon :: Text
szCon = (Value -> Maybe Integer) -> [Value] -> [Integer]
forall a. (Value -> Maybe a) -> [Value] -> [a]
listOf (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 p :: PrimInfo
p _ [_, Lit (IntegerLiteral i :: Integer
i)]
    | PrimInfo -> Text
primName PrimInfo
p 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 b. (a -> Maybe b) -> [a] -> [b]
mapMaybe 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 p :: PrimInfo
p _ [Lit (IntegerLiteral m :: Integer
m), Lit (IntegerLiteral i :: Integer
i)]
      | PrimInfo -> Text
primName PrimInfo
p 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#"

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] -> Maybe ((Integer,Integer),(Integer,Integer))
bitVectorLiterals :: [Value] -> Maybe ((Integer, Integer), (Integer, Integer))
bitVectorLiterals = (Value -> Maybe (Integer, Integer))
-> [Value] -> Maybe ((Integer, Integer), (Integer, Integer))
forall a. (Value -> Maybe a) -> [Value] -> Maybe (a, a)
pairOf Value -> Maybe (Integer, Integer)
bitVectorLiteral

bitVectorLiterals'
  :: [Value] -> [(Integer,Integer)]
bitVectorLiterals' :: [Value] -> [(Integer, Integer)]
bitVectorLiterals' = (Value -> Maybe (Integer, Integer))
-> [Value] -> [(Integer, Integer)]
forall a. (Value -> Maybe a) -> [Value] -> [a]
listOf Value -> Maybe (Integer, Integer)
bitVectorLiteral

bitVectorLiteral :: Value -> Maybe (Integer, Integer)
bitVectorLiteral :: Value -> Maybe (Integer, Integer)
bitVectorLiteral val :: Value
val = case Value
val of
  (PrimVal p :: PrimInfo
p _ [_, Lit (IntegerLiteral m :: Integer
m), Lit (IntegerLiteral i :: Integer
i)])
    | PrimInfo -> Text
primName PrimInfo
p 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

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 v :: Value
v =
  case Value
v of
    PrimVal _ _ vs :: [Value]
vs -> [Term] -> Maybe [Term]
forall a. a -> Maybe a
Just ((Value -> Term) -> [Value] -> [Term]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Term
valToTerm [Value]
vs)
    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)
    _ -> 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 p :: PrimInfo
p _ [_,Lit (IntegerLiteral i :: Integer
i)]
    ,Value -> Maybe [Term]
valArgs -> Just [Literal (IntLiteral j :: Integer
j)]
    ] <- [Value]
args
  , PrimInfo -> Text
primName PrimInfo
p 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 p :: PrimInfo
p _ [_,Lit (IntegerLiteral m :: Integer
m),Lit (IntegerLiteral i :: Integer
i)]
    ,Value -> Maybe [Term]
valArgs -> Just [Literal (IntLiteral j :: Integer
j)]
    ] <- [Value]
args
  , PrimInfo -> Text
primName PrimInfo
p 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

-- 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 =
  (Type -> Maybe (Type, Integer)) -> [Type] -> [(Type, Integer)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (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 :: Type -> Type) a. Applicative f => a -> f a
pure)

-- 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)

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 _)
  = PrimInfo -> Term
Prim (Text -> Type -> WorkInfo -> PrimInfo
PrimInfo "Clash.Sized.Internal.BitVector.fromInteger##" Type
funTy WorkInfo
WorkNever)
  where
    funTy :: Type
funTy      = (Type -> Type -> Type) -> [Type] -> Type
forall (t :: Type -> Type) 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 _)
  = PrimInfo -> Term
Prim (Text -> Type -> WorkInfo -> PrimInfo
PrimInfo "Clash.Sized.Internal.BitVector.fromInteger#" (TyVar -> Type -> Type
ForAllTy TyVar
nTV Type
funTy) WorkInfo
WorkNever)
  where
    funTy :: Type
funTy = (Type -> Type -> Type) -> [Type] -> Type
forall (t :: Type -> Type) 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 _)
  = PrimInfo -> Term
Prim (Text -> Type -> WorkInfo -> PrimInfo
PrimInfo "Clash.Sized.Internal.Index.fromInteger#" (TyVar -> Type -> Type
ForAllTy TyVar
nTV Type
funTy) WorkInfo
WorkNever)
  where
    funTy :: Type
funTy        = (Type -> Type -> Type) -> [Type] -> Type
forall (t :: Type -> Type) 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 _)
  = PrimInfo -> Term
Prim (Text -> Type -> WorkInfo -> PrimInfo
PrimInfo "Clash.Sized.Internal.Signed.fromInteger#" (TyVar -> Type -> Type
ForAllTy TyVar
nTV Type
funTy) WorkInfo
WorkNever)
  where
    funTy :: Type
funTy        = (Type -> Type -> Type) -> [Type] -> Type
forall (t :: Type -> Type) 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 _)
  = PrimInfo -> Term
Prim (Text -> Type -> WorkInfo -> PrimInfo
PrimInfo "Clash.Sized.Internal.Unsigned.fromInteger#" (TyVar -> Type -> Type
ForAllTy TyVar
nTV Type
funTy) WorkInfo
WorkNever)
  where
    funTy :: Type
funTy        = (Type -> Type -> Type) -> [Type] -> Type
forall (t :: Type -> Type) 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 -> Type).
(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 -> Type).
(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 -> Type).
(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' = HasCallStack => TyConMap -> Type -> [Type] -> Type
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' = HasCallStack => TyConMap -> Type -> [Type] -> Type
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 =
  PrimInfo -> Term
Prim (Text -> Type -> WorkInfo -> PrimInfo
PrimInfo "Clash.Sized.Vector.head" (TyConName -> Type
vecHeadTy TyConName
vecTcNm) WorkInfo
WorkNever)

vecLastPrim
  :: TyConName
  -- ^ Vec TyCon name
  -> Term
vecLastPrim :: TyConName -> Term
vecLastPrim vecTcNm :: TyConName
vecTcNm =
  PrimInfo -> Term
Prim (Text -> Type -> WorkInfo -> PrimInfo
PrimInfo "Clash.Sized.Vector.last" (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 =
  PrimInfo -> Term
Prim (Text -> Type -> WorkInfo -> PrimInfo
PrimInfo "Clash.Sized.Vector.tail" (TyConName -> Type
vecTailTy TyConName
vecTcNm) WorkInfo
WorkNever)

vecInitPrim
  :: TyConName
  -- ^ Vec TyCon name
  -> Term
vecInitPrim :: TyConName -> Term
vecInitPrim vecTcNm :: TyConName
vecTcNm =
  PrimInfo -> Term
Prim (Text -> Type -> WorkInfo -> PrimInfo
PrimInfo "Clash.Sized.Vector.init" (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 =
  PrimInfo -> Term
Prim (Text -> Type -> WorkInfo -> PrimInfo
PrimInfo "Clash.Sized.Vector.splitAt" (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 =
  PrimInfo -> Term
Prim (Text -> Type -> WorkInfo -> PrimInfo
PrimInfo "Clash.Sized.Vector.++" (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 =
  PrimInfo -> Term
Prim (Text -> Type -> WorkInfo -> PrimInfo
PrimInfo "Clash.Sized.Vector.zipWith" (TyConName -> Type
vecZipWithTy 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 =
  PrimInfo -> Term
Prim (Text -> Type -> WorkInfo -> PrimInfo
PrimInfo "Clash.Sized.Internal.BitVector.++#" (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 =
  PrimInfo -> Term
Prim (Text -> Type -> WorkInfo -> PrimInfo
PrimInfo "Clash.Sized.Internal.BitVector.split#" (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', () #))

isTrueDC,isFalseDC :: DataCon -> Bool
isTrueDC :: DataCon -> Bool
isTrueDC dc :: DataCon
dc  = DataCon -> Int
dcUniq DataCon
dc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Unique -> Int
getKey Unique
trueDataConKey
isFalseDC :: DataCon -> Bool
isFalseDC dc :: DataCon
dc = DataCon -> Int
dcUniq DataCon
dc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Unique -> Int
getKey Unique
falseDataConKey