{-|
  Copyright   :  (C) 2013-2016, University of Twente,
                     2016-2017, Myrtle Software Ltd,
                     2017-2022, Google Inc.,
                     2017-2023, QBayLogic B.V.
  License     :  BSD2 (see the file LICENSE)
  Maintainer  :  QBayLogic B.V. <devops@qbaylogic.com>
-}

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

{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

module Clash.GHC.Evaluator.Primitive
  ( ghcPrimStep
  , ghcPrimUnwind
  , isUndefinedPrimVal
  , isUndefinedXPrimVal
  ) 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.Binary.IEEE754        (doubleToWord, floatToWord, wordToDouble, wordToFloat)
import           Data.Bits
import qualified Data.ByteString.Internal as BS
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 BA
import           Data.Proxy          (Proxy)
import           Data.Reflection     (reifyNat)
import           Data.Text           (Text)
import qualified Data.Text           as Text
import           GHC.Exts (IsList(..))
import           GHC.Float
import           GHC.Int
import           GHC.Integer
  (decodeDoubleInteger,encodeDoubleInteger,compareInteger,orInteger,andInteger,
   xorInteger,complementInteger,absInteger,signumInteger)
#if MIN_VERSION_base(4,16,0)
import           GHC.Num.Integer (Integer (..), integerEncodeFloat#)
#elif MIN_VERSION_base(4,15,0)
import           GHC.Num.Integer
  (Integer (..), integerEncodeFloat#, integerToFloat#, integerToDouble#)
#else
import           GHC.Integer.GMP.Internals
  (Integer (..), BigNat (..))
#endif
#if MIN_VERSION_base(4,15,0)
import           GHC.Num.Natural     (naturalSubUnsafe)
#endif
import           GHC.Natural
import           GHC.ForeignPtr
import           GHC.Prim
import           GHC.Real            (Ratio (..))
import           GHC.TypeLits        (KnownNat)
import           GHC.Types           (IO (..))
import           GHC.Word
import           System.IO.Unsafe    (unsafeDupablePerformIO)
#if MIN_VERSION_ghc(9,4,0)
import           Data.Bifunctor      (first)
import qualified Data.Text.Array     as Text
import qualified Data.Text.Internal  as Text
#endif

#if MIN_VERSION_ghc(9,0,0)
import           GHC.Types.Basic     (Boxity (..))
import           GHC.Types.Name      (getSrcSpan, nameOccName, occNameString)
import           GHC.Builtin.Names   (trueDataConKey, falseDataConKey)
import qualified GHC.Core.TyCon      as TyCon
import           GHC.Builtin.Types   (tupleTyCon)
import           GHC.Types.Unique    (getKey)
#else
import           BasicTypes          (Boxity (..))
import           Name                (getSrcSpan, nameOccName, occNameString)
import           PrelNames           (trueDataConKey, falseDataConKey)
import qualified TyCon
import           TysWiredIn          (tupleTyCon)
import           Unique              (getKey)
#endif

import           Clash.Class.BitPack (pack,unpack)
import           Clash.Core.DataCon  (DataCon (..))
import           Clash.Core.Evaluator.Types
import           Clash.Core.HasType  (piResultTys, applyTypeToArgs)
import           Clash.Core.Literal  (Literal (..))
import           Clash.Core.Name
  (Name (..), NameSort (..), mkUnsafeSystemName)
import           Clash.Core.Pretty   (showPpr)
import           Clash.Core.Term
  (IsMultiPrim (..), Pat (..), PrimInfo (..), Term (..), WorkInfo (..), mkApps,
   PrimUnfolding(..), collectArgs)
import           Clash.Core.Type
  (Type (..), ConstTy (..), LitTy (..), TypeView (..), mkFunTy, mkTyConApp,
   splitFunForallTy, tyView)
import           Clash.Core.TyCon
  (TyConMap, TyConName, tyConDataCons)
import           Clash.Core.TysPrim
import           Clash.Core.Util
  (mkRTree,mkVec,tyNatSize,dataConInstArgTys,primCo, mkSelectorCase,undefinedPrims,
   undefinedXPrims)
import           Clash.Core.Var      (mkLocalId, mkTyVar)
import qualified Clash.Data.UniqMap as UniqMap
import           Clash.Debug
import           Clash.GHC.GHC2Core  (modNameM)
import           Clash.Util
  (MonadUnique (..), clogBase, flogBase, curLoc)
import           Clash.Normalize.PrimitiveReductions
  (typeNatMul, typeNatSub, typeNatAdd, vecLastPrim, vecInitPrim, vecHeadPrim,
   vecTailPrim, mkVecCons, mkVecNil)

import qualified Clash.Normalize.Primitives as NP
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)

import {-# SOURCE #-} Clash.GHC.Evaluator

isUndefinedPrimVal :: Value -> Bool
isUndefinedPrimVal :: Value -> Bool
isUndefinedPrimVal (PrimVal (PrimInfo{Text
primName :: PrimInfo -> Text
primName :: Text
primName}) [Type]
_ [Value]
_) =
  Text
primName Text -> [Text] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` [Text]
undefinedPrims
isUndefinedPrimVal Value
_ = Bool
False

isUndefinedXPrimVal :: Value -> Bool
isUndefinedXPrimVal :: Value -> Bool
isUndefinedXPrimVal (PrimVal (PrimInfo{Text
primName :: Text
primName :: PrimInfo -> Text
primName}) [Type]
_ [Value]
_) =
  Text
primName Text -> [Text] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` [Text]
undefinedXPrims
isUndefinedXPrimVal Value
_ = Bool
False

-- | Evaluation of primitive operations.
ghcPrimUnwind :: PrimUnwind
ghcPrimUnwind :: PrimUnwind
ghcPrimUnwind TyConMap
tcm PrimInfo
p [Type]
tys [Value]
vs Value
v [] Machine
m
  | PrimInfo -> Text
primName PrimInfo
p Text -> [Text] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` [ Text
"Clash.Sized.Internal.Index.fromInteger#"
                       , Text
"GHC.CString.unpackCString#"
                       , String -> Text
Text.pack (Name -> String
forall a. Show a => a -> String
show 'NP.removedArg)
                       , Text
"GHC.Prim.MutableByteArray#"
                       , String -> Text
Text.pack (Name -> String
forall a. Show a => a -> String
show 'NP.undefined)
                       , String -> Text
Text.pack (Name -> String
forall a. Show a => a -> String
show 'NP.undefinedX)
                       ]
              -- The above primitives are actually values, and not operations.
  = Unwind
ghcUnwind (PrimInfo -> [Type] -> [Value] -> Value
PrimVal PrimInfo
p [Type]
tys ([Value]
vs [Value] -> [Value] -> [Value]
forall a. [a] -> [a] -> [a]
++ [Value
v])) Machine
m TyConMap
tcm
  | PrimInfo -> Text
primName PrimInfo
p Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Clash.Sized.Internal.BitVector.fromInteger#"
  = case ([Value]
vs,Value
v) of
    ([Value -> Maybe Integer
naturalLiteral -> Just Integer
n,Value
mask], Value -> Maybe Integer
integerLiteral -> Just Integer
i) ->
      Unwind
ghcUnwind (PrimInfo -> [Type] -> [Value] -> Value
PrimVal PrimInfo
p [Type]
tys [Literal -> Value
Lit (Integer -> Literal
NaturalLiteral Integer
n), Value
mask, Literal -> Value
Lit (Integer -> Literal
IntegerLiteral (Integer -> Integer -> Integer
wrapUnsigned Integer
n Integer
i))]) Machine
m TyConMap
tcm
    ([Value], Value)
_ -> String -> Maybe Machine
forall a. HasCallStack => String -> a
error ($(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Internal error"  String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([Value], Value) -> String
forall a. Show a => a -> String
show ([Value]
vs,Value
v))
  | PrimInfo -> Text
primName PrimInfo
p Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Clash.Sized.Internal.BitVector.fromInteger##"
  = case ([Value]
vs,Value
v) of
    ([Value
mask], Value -> Maybe Integer
integerLiteral -> Just Integer
i) ->
      Unwind
ghcUnwind (PrimInfo -> [Type] -> [Value] -> Value
PrimVal PrimInfo
p [Type]
tys [Value
mask, Literal -> Value
Lit (Integer -> Literal
IntegerLiteral (Integer -> Integer -> Integer
wrapUnsigned Integer
1 Integer
i))]) Machine
m TyConMap
tcm
    ([Value], Value)
_ -> String -> Maybe Machine
forall a. HasCallStack => String -> a
error ($(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Internal error"  String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([Value], Value) -> String
forall a. Show a => a -> String
show ([Value]
vs,Value
v))
  | PrimInfo -> Text
primName PrimInfo
p Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Clash.Sized.Internal.Signed.fromInteger#"
  = case ([Value]
vs,Value
v) of
    ([Value -> Maybe Integer
naturalLiteral -> Just Integer
n],Value -> Maybe Integer
integerLiteral -> Just Integer
i) ->
      Unwind
ghcUnwind (PrimInfo -> [Type] -> [Value] -> Value
PrimVal PrimInfo
p [Type]
tys [Literal -> Value
Lit (Integer -> Literal
NaturalLiteral Integer
n), Literal -> Value
Lit (Integer -> Literal
IntegerLiteral (Integer -> Integer -> Integer
wrapSigned Integer
n Integer
i))]) Machine
m TyConMap
tcm
    ([Value], Value)
_ -> String -> Maybe Machine
forall a. HasCallStack => String -> a
error ($(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Internal error"  String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([Value], Value) -> String
forall a. Show a => a -> String
show ([Value]
vs,Value
v))
  | PrimInfo -> Text
primName PrimInfo
p Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Clash.Sized.Internal.Unsigned.fromInteger#"
  = case ([Value]
vs,Value
v) of
    ([Value -> Maybe Integer
naturalLiteral -> Just Integer
n],Value -> Maybe Integer
integerLiteral -> Just Integer
i) ->
      Unwind
ghcUnwind (PrimInfo -> [Type] -> [Value] -> Value
PrimVal PrimInfo
p [Type]
tys [Literal -> Value
Lit (Integer -> Literal
NaturalLiteral Integer
n), Literal -> Value
Lit (Integer -> Literal
IntegerLiteral (Integer -> Integer -> Integer
wrapUnsigned Integer
n Integer
i))]) Machine
m TyConMap
tcm
    ([Value], Value)
_ -> String -> Maybe Machine
forall a. HasCallStack => String -> a
error ($(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Internal error"  String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([Value], Value) -> String
forall a. Show a => a -> String
show ([Value]
vs,Value
v))
  | Value -> Bool
isUndefinedPrimVal Value
v
  = let tyArgs :: [Either a Type]
tyArgs = (Type -> Either a Type) -> [Type] -> [Either a Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Either a Type
forall a b. b -> Either a b
Right [Type]
tys
        tmArgs :: [Either Term b]
tmArgs = (Value -> Either Term b) -> [Value] -> [Either Term b]
forall a b. (a -> b) -> [a] -> [b]
map (Term -> Either Term b
forall a b. a -> Either a b
Left (Term -> Either Term b)
-> (Value -> Term) -> Value -> Either Term b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Term
valToTerm) ([Value]
vs [Value] -> [Value] -> [Value]
forall a. [a] -> [a] -> [a]
++ [Value
v])
    in  Machine -> Maybe Machine
forall a. a -> Maybe a
Just (Machine -> Maybe Machine) -> Machine -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ (Term -> Machine -> Machine) -> Machine -> Term -> Machine
forall a b c. (a -> b -> c) -> b -> a -> c
flip Term -> Machine -> Machine
setTerm Machine
m (Term -> Machine) -> Term -> Machine
forall a b. (a -> b) -> a -> b
$ Term -> Type -> Term
TyApp (PrimInfo -> Term
Prim PrimInfo
NP.undefined) (Type -> Term) -> Type -> Term
forall a b. (a -> b) -> a -> b
$
          Term -> TyConMap -> Type -> [Either Term Type] -> Type
applyTypeToArgs (PrimInfo -> Term
Prim PrimInfo
p) TyConMap
tcm (PrimInfo -> Type
primType PrimInfo
p) ([Either Term Type]
forall a. [Either a Type]
tyArgs [Either Term Type] -> [Either Term Type] -> [Either Term Type]
forall a. [a] -> [a] -> [a]
++ [Either Term Type]
forall b. [Either Term b]
tmArgs)
  | Value -> Bool
isUndefinedXPrimVal Value
v
  = let tyArgs :: [Either a Type]
tyArgs = (Type -> Either a Type) -> [Type] -> [Either a Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Either a Type
forall a b. b -> Either a b
Right [Type]
tys
        tmArgs :: [Either Term b]
tmArgs = (Value -> Either Term b) -> [Value] -> [Either Term b]
forall a b. (a -> b) -> [a] -> [b]
map (Term -> Either Term b
forall a b. a -> Either a b
Left (Term -> Either Term b)
-> (Value -> Term) -> Value -> Either Term b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Term
valToTerm) ([Value]
vs [Value] -> [Value] -> [Value]
forall a. [a] -> [a] -> [a]
++ [Value
v])
    in  Machine -> Maybe Machine
forall a. a -> Maybe a
Just (Machine -> Maybe Machine) -> Machine -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ (Term -> Machine -> Machine) -> Machine -> Term -> Machine
forall a b c. (a -> b -> c) -> b -> a -> c
flip Term -> Machine -> Machine
setTerm Machine
m (Term -> Machine) -> Term -> Machine
forall a b. (a -> b) -> a -> b
$ Term -> Type -> Term
TyApp (PrimInfo -> Term
Prim PrimInfo
NP.undefinedX) (Type -> Term) -> Type -> Term
forall a b. (a -> b) -> a -> b
$
          Term -> TyConMap -> Type -> [Either Term Type] -> Type
applyTypeToArgs (PrimInfo -> Term
Prim PrimInfo
p) TyConMap
tcm (PrimInfo -> Type
primType PrimInfo
p) ([Either Term Type]
forall a. [Either a Type]
tyArgs [Either Term Type] -> [Either Term Type] -> [Either Term Type]
forall a. [a] -> [a] -> [a]
++ [Either Term Type]
forall b. [Either Term b]
tmArgs)
  | Bool
otherwise
  = PrimStep
ghcPrimStep TyConMap
tcm (Machine -> Bool
forcePrims Machine
m) PrimInfo
p [Type]
tys ([Value]
vs [Value] -> [Value] -> [Value]
forall a. [a] -> [a] -> [a]
++ [Value
v]) Machine
m

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

#if MIN_VERSION_base(4,14,0)
  Text
"GHC.Prim.bitReverse#" | [Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine)
-> (Integer -> Term) -> Integer -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Term
integerToWordLiteral (Integer -> Term) -> (Integer -> Integer) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word64 -> Integer) -> (Integer -> Word64) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Word64
bitReverse64 (Word64 -> Word64) -> (Integer -> Word64) -> Integer -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Word64
forall a. Num a => Integer -> a
fromInteger (Integer -> Maybe Machine) -> Integer -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Integer
i -- assume 64bits
  Text
"GHC.Prim.bitReverse8#" | [Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine)
-> (Integer -> Term) -> Integer -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Term
integerToWordLiteral (Integer -> Term) -> (Integer -> Integer) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word8 -> Integer) -> (Integer -> Word8) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word8
bitReverse8 (Word8 -> Word8) -> (Integer -> Word8) -> Integer -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Word8
forall a. Num a => Integer -> a
fromInteger (Integer -> Maybe Machine) -> Integer -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Integer
i
  Text
"GHC.Prim.bitReverse16#" | [Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine)
-> (Integer -> Term) -> Integer -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Term
integerToWordLiteral (Integer -> Term) -> (Integer -> Integer) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word16 -> Integer) -> (Integer -> Word16) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Word16
bitReverse16 (Word16 -> Word16) -> (Integer -> Word16) -> Integer -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Word16
forall a. Num a => Integer -> a
fromInteger (Integer -> Maybe Machine) -> Integer -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Integer
i
  Text
"GHC.Prim.bitReverse32#" | [Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine)
-> (Integer -> Term) -> Integer -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Term
integerToWordLiteral (Integer -> Term) -> (Integer -> Integer) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word32 -> Integer) -> (Integer -> Word32) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Word32
bitReverse32 (Word32 -> Word32) -> (Integer -> Word32) -> Integer -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Word32
forall a. Num a => Integer -> a
fromInteger (Integer -> Maybe Machine) -> Integer -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Integer
i
  Text
"GHC.Prim.bitReverse64#" | [Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine)
-> (Integer -> Term) -> Integer -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Term
integerToWordLiteral (Integer -> Term) -> (Integer -> Integer) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word64 -> Integer) -> (Integer -> Word64) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Word64
bitReverse64 (Word64 -> Word64) -> (Integer -> Word64) -> Integer -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Word64
forall a. Num a => Integer -> a
fromInteger (Integer -> Maybe Machine) -> Integer -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Integer
i
#endif
------------
-- Narrowing
------------
  Text
"GHC.Prim.narrow8Int#" | [Integer
i] <- [Value] -> [Integer]
intLiterals' [Value]
args
    -> let !(I# Int#
a)  = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i
           b :: Int#
b = Int# -> Int#
narrow8Int# Int#
a
       in  Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> (Int -> Term) -> Int -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Term
Literal (Literal -> Term) -> (Int -> Literal) -> Int -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral (Integer -> Literal) -> (Int -> Integer) -> Int -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Maybe Machine) -> Int -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
b
  Text
"GHC.Prim.narrow16Int#" | [Integer
i] <- [Value] -> [Integer]
intLiterals' [Value]
args
    -> let !(I# Int#
a)  = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i
           b :: Int#
b = Int# -> Int#
narrow16Int# Int#
a
       in  Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> (Int -> Term) -> Int -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Term
Literal (Literal -> Term) -> (Int -> Literal) -> Int -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral (Integer -> Literal) -> (Int -> Integer) -> Int -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Maybe Machine) -> Int -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
b
  Text
"GHC.Prim.narrow32Int#" | [Integer
i] <- [Value] -> [Integer]
intLiterals' [Value]
args
    -> let !(I# Int#
a)  = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i
           b :: Int#
b = Int# -> Int#
narrow32Int# Int#
a
       in  Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> (Int -> Term) -> Int -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Term
Literal (Literal -> Term) -> (Int -> Literal) -> Int -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral (Integer -> Literal) -> (Int -> Integer) -> Int -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Maybe Machine) -> Int -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
b
  Text
"GHC.Prim.narrow8Word#" | [Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> let !(W# Word#
a)  = Integer -> Word
forall a. Num a => Integer -> a
fromInteger Integer
i
           b :: Word#
b = Word# -> Word#
narrow8Word# Word#
a
       in  Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> (Word -> Term) -> Word -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Term
Literal (Literal -> Term) -> (Word -> Literal) -> Word -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
WordLiteral (Integer -> Literal) -> (Word -> Integer) -> Word -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Integer
forall a. Integral a => a -> Integer
toInteger (Word -> Maybe Machine) -> Word -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Word# -> Word
W# Word#
b
  Text
"GHC.Prim.narrow16Word#" | [Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> let !(W# Word#
a)  = Integer -> Word
forall a. Num a => Integer -> a
fromInteger Integer
i
           b :: Word#
b = Word# -> Word#
narrow16Word# Word#
a
       in  Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> (Word -> Term) -> Word -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Term
Literal (Literal -> Term) -> (Word -> Literal) -> Word -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
WordLiteral (Integer -> Literal) -> (Word -> Integer) -> Word -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Integer
forall a. Integral a => a -> Integer
toInteger (Word -> Maybe Machine) -> Word -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Word# -> Word
W# Word#
b
  Text
"GHC.Prim.narrow32Word#" | [Integer
i] <- [Value] -> [Integer]
wordLiterals' [Value]
args
    -> let !(W# Word#
a)  = Integer -> Word
forall a. Num a => Integer -> a
fromInteger Integer
i
           b :: Word#
b = Word# -> Word#
narrow32Word# Word#
a
       in  Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> (Word -> Term) -> Word -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Term
Literal (Literal -> Term) -> (Word -> Literal) -> Word -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
WordLiteral (Integer -> Literal) -> (Word -> Integer) -> Word -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Integer
forall a. Integral a => a -> Integer
toInteger (Word -> Maybe Machine) -> Word -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Word# -> Word
W# Word#
b

#if MIN_VERSION_base(4,16,0)
--------
-- Int8#
--------
  "GHC.Prim.intToInt8#" | [i] <- intLiterals' args
    -> let !(I# a)  = fromInteger i
           b = narrow8Int# a
       in  reduce . Literal . Int8Literal . toInteger $ I# b
  "GHC.Prim.int8ToInt#" | [i] <- int8Literals' args
    -> reduce . Literal $ IntLiteral i
  "GHC.Prim.negateInt8" | [i] <- int8Literals' args
    -> let !(I8# a) = fromInteger i
        in reduce (Literal (Int8Literal (toInteger (I8# (negateInt8# a)))))
  "GHC.Prim.plusInt8#" | Just r <- liftI8 plusInt8# args
    -> reduce r
  "GHC.Prim.subInt8#" | Just r <- liftI8 subInt8# args
    -> reduce r
  "GHC.Prim.timesInt8#" | Just r <- liftI8 timesInt8# args
    -> reduce r
  "GHC.Prim.quotInt8#" | Just r <- liftI8 quotInt8# args
    -> reduce r
  "GHC.Prim.remInt8#" | Just r <- liftI8 remInt8# args
    -> reduce r
  "GHC.Prim.quotRemInt8#"
    | [i, j] <- int8Literals' args
    , (_,tyView -> TyConApp tupTcNm tyArgs) <- splitFunForallTy ty
    , (Just tupTc) <- UniqMap.lookup tupTcNm tcm
    , [tupDc] <- tyConDataCons tupTc
    -> let !(I8# a)    = fromInteger i
           !(I8# b)    = fromInteger j
           !(# q, r #) = quotRemInt8# a b
        in reduce $
           mkApps (Data tupDc) (map Right tyArgs ++
                  [ Left (Literal (Int8Literal (toInteger (I8# q))))
                  , Left (Literal (Int8Literal (toInteger (I8# r))))])
  "GHC.Prim.uncheckedShiftLInt8#" | Just r <- liftI8I uncheckedShiftLInt8# args
    -> reduce r
  "GHC.Prim.uncheckedShiftRAInt8#" | Just r <- liftI8I uncheckedShiftRAInt8# args
    -> reduce r
  "GHC.Prim.uncheckedShiftRLInt8#" | Just r <- liftI8I uncheckedShiftRLInt8# args
    -> reduce r
  "GHC.Prim.int8ToWord8#" | [i] <- int8Literals' args
    -> let !(I8# a) = fromInteger i
        in reduce (Literal (Word8Literal (toInteger (W8# (int8ToWord8# a)))))
  "GHC.Prim.eqInt8#" | Just r <- liftI8RI eqInt8# args
    -> reduce r
  "GHC.Prim.geInt8#" | Just r <- liftI8RI geInt8# args
    -> reduce r
  "GHC.Prim.gtInt8#" | Just r <- liftI8RI gtInt8# args
    -> reduce r
  "GHC.Prim.leInt8#" | Just r <- liftI8RI leInt8# args
    -> reduce r
  "GHC.Prim.ltInt8#" | Just r <- liftI8RI ltInt8# args
    -> reduce r
  "GHC.Prim.neInt8#" | Just r <- liftI8RI neInt8# args
    -> reduce r

---------
-- Int16#
---------
  "GHC.Prim.intToInt16#" | [i] <- intLiterals' args
    -> let !(I# a)  = fromInteger i
           b = narrow16Int# a
       in  reduce . Literal . Int16Literal . toInteger $ I# b
  "GHC.Prim.int16ToInt#" | [i] <- int16Literals' args
    -> reduce . Literal $ IntLiteral i
  "GHC.Prim.negateInt16" | [i] <- int16Literals' args
    -> let !(I16# a) = fromInteger i
        in reduce (Literal (Int16Literal (toInteger (I16# (negateInt16# a)))))
  "GHC.Prim.plusInt16#" | Just r <- liftI16 plusInt16# args
    -> reduce r
  "GHC.Prim.subInt16#" | Just r <- liftI16 subInt16# args
    -> reduce r
  "GHC.Prim.timesInt16#" | Just r <- liftI16 timesInt16# args
    -> reduce r
  "GHC.Prim.quotInt16#" | Just r <- liftI16 quotInt16# args
    -> reduce r
  "GHC.Prim.remInt16#" | Just r <- liftI16 remInt16# args
    -> reduce r
  "GHC.Prim.quotRemInt16#"
    | [i, j] <- int16Literals' args
    , (_,tyView -> TyConApp tupTcNm tyArgs) <- splitFunForallTy ty
    , (Just tupTc) <- UniqMap.lookup tupTcNm tcm
    , [tupDc] <- tyConDataCons tupTc
    -> let !(I16# a)   = fromInteger i
           !(I16# b)   = fromInteger j
           !(# q, r #) = quotRemInt16# a b
        in reduce $
           mkApps (Data tupDc) (map Right tyArgs ++
                  [ Left (Literal (Int16Literal (toInteger (I16# q))))
                  , Left (Literal (Int16Literal (toInteger (I16# r))))])
  "GHC.Prim.uncheckedShiftLInt16#" | Just r <- liftI16I uncheckedShiftLInt16# args
    -> reduce r
  "GHC.Prim.uncheckedShiftRAInt16#" | Just r <- liftI16I uncheckedShiftRAInt16# args
    -> reduce r
  "GHC.Prim.uncheckedShiftRLInt16#" | Just r <- liftI16I uncheckedShiftRLInt16# args
    -> reduce r
  "GHC.Prim.int16ToWord16#" | [i] <- int16Literals' args
    -> let !(I16# a) = fromInteger i
        in reduce (Literal (Word16Literal (toInteger (W16# (int16ToWord16# a)))))
  "GHC.Prim.eqInt16#" | Just r <- liftI16RI eqInt16# args
    -> reduce r
  "GHC.Prim.geInt16#" | Just r <- liftI16RI geInt16# args
    -> reduce r
  "GHC.Prim.gtInt16#" | Just r <- liftI16RI gtInt16# args
    -> reduce r
  "GHC.Prim.leInt16#" | Just r <- liftI16RI leInt16# args
    -> reduce r
  "GHC.Prim.ltInt16#" | Just r <- liftI16RI ltInt16# args
    -> reduce r
  "GHC.Prim.neInt16#" | Just r <- liftI16RI neInt16# args
    -> reduce r

---------
-- Int32#
---------
  "GHC.Prim.intToInt32#" | [i] <- intLiterals' args
    -> let !(I# a)  = fromInteger i
           b = narrow32Int# a
       in  reduce . Literal . Int32Literal . toInteger $ I# b
  "GHC.Prim.int32ToInt#" | [i] <- int32Literals' args
    -> reduce . Literal $ IntLiteral i
  "GHC.Prim.negateInt32" | [i] <- int32Literals' args
    -> let !(I32# a) = fromInteger i
        in reduce (Literal (Int32Literal (toInteger (I32# (negateInt32# a)))))
  "GHC.Prim.plusInt32#" | Just r <- liftI32 plusInt32# args
    -> reduce r
  "GHC.Prim.subInt32#" | Just r <- liftI32 subInt32# args
    -> reduce r
  "GHC.Prim.timesInt32#" | Just r <- liftI32 timesInt32# args
    -> reduce r
  "GHC.Prim.quotInt32#" | Just r <- liftI32 quotInt32# args
    -> reduce r
  "GHC.Prim.remInt32#" | Just r <- liftI32 remInt32# args
    -> reduce r
  "GHC.Prim.quotRemInt32#"
    | [i, j] <- int32Literals' args
    , (_,tyView -> TyConApp tupTcNm tyArgs) <- splitFunForallTy ty
    , (Just tupTc) <- UniqMap.lookup tupTcNm tcm
    , [tupDc] <- tyConDataCons tupTc
    -> let !(I32# a)   = fromInteger i
           !(I32# b)   = fromInteger j
           !(# q, r #) = quotRemInt32# a b
        in reduce $
           mkApps (Data tupDc) (map Right tyArgs ++
                  [ Left (Literal (Int32Literal (toInteger (I32# q))))
                  , Left (Literal (Int32Literal (toInteger (I32# r))))])
  "GHC.Prim.uncheckedShiftLInt32#" | Just r <- liftI32I uncheckedShiftLInt32# args
    -> reduce r
  "GHC.Prim.uncheckedShiftRAInt32#" | Just r <- liftI32I uncheckedShiftRAInt32# args
    -> reduce r
  "GHC.Prim.uncheckedShiftRLInt32#" | Just r <- liftI32I uncheckedShiftRLInt32# args
    -> reduce r
  "GHC.Prim.int32ToWord32#" | [i] <- int32Literals' args
    -> let !(I32# a) = fromInteger i
        in reduce (Literal (Word32Literal (toInteger (W32# (int32ToWord32# a)))))
  "GHC.Prim.eqInt32#" | Just r <- liftI32RI eqInt32# args
    -> reduce r
  "GHC.Prim.geInt32#" | Just r <- liftI32RI geInt32# args
    -> reduce r
  "GHC.Prim.gtInt32#" | Just r <- liftI32RI gtInt32# args
    -> reduce r
  "GHC.Prim.leInt32#" | Just r <- liftI32RI leInt32# args
    -> reduce r
  "GHC.Prim.ltInt32#" | Just r <- liftI32RI ltInt32# args
    -> reduce r
  "GHC.Prim.neInt32#" | Just r <- liftI32RI neInt32# args
    -> reduce r

---------
-- Int64#
---------
#if MIN_VERSION_base(4,17,0)
  "GHC.Prim.intToInt64#" | [i] <- intLiterals' args
    -> reduce (Literal (Int64Literal i))
  "GHC.Prim.int64ToInt#" | [i] <- int64Literals' args
    -> reduce . Literal $ IntLiteral i
  "GHC.Prim.negateInt64" | [i] <- int64Literals' args
    -> let !(I64# a) = fromInteger i
        in reduce (Literal (Int64Literal (toInteger (I64# (negateInt64# a)))))
  "GHC.Prim.plusInt64#" | Just r <- liftI64 plusInt64# args
    -> reduce r
  "GHC.Prim.subInt64#" | Just r <- liftI64 subInt64# args
    -> reduce r
  "GHC.Prim.timesInt64#" | Just r <- liftI64 timesInt64# args
    -> reduce r
  "GHC.Prim.quotInt64#" | Just r <- liftI64 quotInt64# args
    -> reduce r
  "GHC.Prim.remInt64#" | Just r <- liftI64 remInt64# args
    -> reduce r
  "GHC.Prim.uncheckedIShiftL64#" | Just r <- liftI64I uncheckedIShiftL64# args
    -> reduce r
  "GHC.Prim.uncheckedIShiftRA64#" | Just r <- liftI64I uncheckedIShiftRA64# args
    -> reduce r
  "GHC.Prim.uncheckedIShiftRL64#" | Just r <- liftI64I uncheckedIShiftRL64# args
    -> reduce r
  "GHC.Prim.int64ToWord64#" | [i] <- int64Literals' args
    -> let !(I64# a) = fromInteger i
        in reduce (Literal (Word64Literal (toInteger (W64# (int64ToWord64# a)))))
  "GHC.Prim.eqInt64#" | Just r <- liftI64RI eqInt64# args
    -> reduce r
  "GHC.Prim.geInt64#" | Just r <- liftI64RI geInt64# args
    -> reduce r
  "GHC.Prim.gtInt64#" | Just r <- liftI64RI gtInt64# args
    -> reduce r
  "GHC.Prim.leInt64#" | Just r <- liftI64RI leInt64# args
    -> reduce r
  "GHC.Prim.ltInt64#" | Just r <- liftI64RI ltInt64# args
    -> reduce r
  "GHC.Prim.neInt64#" | Just r <- liftI64RI neInt64# args
    -> reduce r
#endif

---------
-- Word8#
---------
  "GHC.Prim.wordToWord8#" | [i] <- wordLiterals' args
    -> let !(W# a)  = fromInteger i
           b = narrow8Word# a
       in  reduce . Literal . Word8Literal . toInteger $ W# b
  "GHC.Prim.word8ToWord#" | [i] <- word8Literals' args
    -> reduce . Literal $ WordLiteral i
  "GHC.Prim.plusWord8#" | Just r <- liftW8 plusWord8# args
    -> reduce r
  "GHC.Prim.subWord8#" | Just r <- liftW8 subWord8# args
    -> reduce r
  "GHC.Prim.timesWord8#" | Just r <- liftW8 timesWord8# args
    -> reduce r
  "GHC.Prim.quotWord8#" | Just r <- liftW8 quotWord8# args
    -> reduce r
  "GHC.Prim.remWord8#" | Just r <- liftW8 remWord8# args
    -> reduce r
  "GHC.Prim.quotRemWord8#"
    | [i, j] <- word8Literals' args
    , (_,tyView -> TyConApp tupTcNm tyArgs) <- splitFunForallTy ty
    , (Just tupTc) <- UniqMap.lookup tupTcNm tcm
    , [tupDc] <- tyConDataCons tupTc
    -> let !(W8# a)    = fromInteger i
           !(W8# b)    = fromInteger j
           !(# q, r #) = quotRemWord8# a b
        in reduce $
           mkApps (Data tupDc) (map Right tyArgs ++
                  [ Left (Literal (Word8Literal (toInteger (W8# q))))
                  , Left (Literal (Word8Literal (toInteger (W8# r))))])
  "GHC.Prim.andWord8#" | Just r <- liftW8 andWord8# args
    -> reduce r
  "GHC.Prim.orWord8#" | Just r <- liftW8 orWord8# args
    -> reduce r
  "GHC.Prim.xorWord8#" | Just r <- liftW8 xorWord8# args
    -> reduce r
  "GHC.Prim.notWord8#" | [i] <- word8Literals' args
    -> let !(W8# a) = fromInteger i
        in reduce (Literal (Word8Literal (toInteger (W8# (notWord8# a)))))
  "GHC.Prim.uncheckedShiftLWord8#" | Just r <- liftW8I uncheckedShiftLWord8# args
    -> reduce r
  "GHC.Prim.uncheckedShiftRLWord8#" | Just r <- liftW8I uncheckedShiftRLWord8# args
    -> reduce r
  "GHC.Prim.word8ToInt8#" | [i] <- word8Literals' args
    -> let !(W8# a) = fromInteger i
        in reduce (Literal (Int8Literal (toInteger (I8# (word8ToInt8# a)))))
  "GHC.Prim.eqWord8#" | Just r <- liftW8RI eqWord8# args
    -> reduce r
  "GHC.Prim.geWord8#" | Just r <- liftW8RI geWord8# args
    -> reduce r
  "GHC.Prim.gtWord8#" | Just r <- liftW8RI gtWord8# args
    -> reduce r
  "GHC.Prim.leWord8#" | Just r <- liftW8RI leWord8# args
    -> reduce r
  "GHC.Prim.ltWord8#" | Just r <- liftW8RI ltWord8# args
    -> reduce r
  "GHC.Prim.neWord8#" | Just r <- liftW8RI neWord8# args
    -> reduce r

----------
-- Word16#
----------
  "GHC.Prim.wordToWord16#" | [i] <- wordLiterals' args
    -> let !(W# a)  = fromInteger i
           b = narrow16Word# a
       in  reduce . Literal . Word16Literal . toInteger $ W# b
  "GHC.Prim.word16ToWord#" | [i] <- word16Literals' args
    -> reduce . Literal $ WordLiteral i
  "GHC.Prim.plusWord16#" | Just r <- liftW16 plusWord16# args
    -> reduce r
  "GHC.Prim.subWord16#" | Just r <- liftW16 subWord16# args
    -> reduce r
  "GHC.Prim.timesWord16#" | Just r <- liftW16 timesWord16# args
    -> reduce r
  "GHC.Prim.quotWord16#" | Just r <- liftW16 quotWord16# args
    -> reduce r
  "GHC.Prim.remWord16#" | Just r <- liftW16 remWord16# args
    -> reduce r
  "GHC.Prim.quotRemWord16#"
    | [i, j] <- word16Literals' args
    , (_,tyView -> TyConApp tupTcNm tyArgs) <- splitFunForallTy ty
    , (Just tupTc) <- UniqMap.lookup tupTcNm tcm
    , [tupDc] <- tyConDataCons tupTc
    -> let !(W16# a)    = fromInteger i
           !(W16# b)    = fromInteger j
           !(# q, r #) = quotRemWord16# a b
        in reduce $
           mkApps (Data tupDc) (map Right tyArgs ++
                  [ Left (Literal (Word16Literal (toInteger (W16# q))))
                  , Left (Literal (Word16Literal (toInteger (W16# r))))])
  "GHC.Prim.andWord16#" | Just r <- liftW16 andWord16# args
    -> reduce r
  "GHC.Prim.orWord16#" | Just r <- liftW16 orWord16# args
    -> reduce r
  "GHC.Prim.xorWord16#" | Just r <- liftW16 xorWord16# args
    -> reduce r
  "GHC.Prim.notWord16#" | [i] <- word16Literals' args
    -> let !(W16# a) = fromInteger i
        in reduce (Literal (Word16Literal (toInteger (W16# (notWord16# a)))))
  "GHC.Prim.uncheckedShiftLWord16#" | Just r <- liftW16I uncheckedShiftLWord16# args
    -> reduce r
  "GHC.Prim.uncheckedShiftRLWord16#" | Just r <- liftW16I uncheckedShiftRLWord16# args
    -> reduce r
  "GHC.Prim.word16ToInt16#" | [i] <- word16Literals' args
    -> let !(W16# a) = fromInteger i
        in reduce (Literal (Int16Literal (toInteger (I16# (word16ToInt16# a)))))
  "GHC.Prim.eqWord16#" | Just r <- liftW16RI eqWord16# args
    -> reduce r
  "GHC.Prim.geWord16#" | Just r <- liftW16RI geWord16# args
    -> reduce r
  "GHC.Prim.gtWord16#" | Just r <- liftW16RI gtWord16# args
    -> reduce r
  "GHC.Prim.leWord16#" | Just r <- liftW16RI leWord16# args
    -> reduce r
  "GHC.Prim.ltWord16#" | Just r <- liftW16RI ltWord16# args
    -> reduce r
  "GHC.Prim.neWord16#" | Just r <- liftW16RI neWord16# args
    -> reduce r

----------
-- Word32#
----------
  "GHC.Prim.wordToWord32#" | [i] <- wordLiterals' args
    -> let !(W# a)  = fromInteger i
           b = narrow32Word# a
       in  reduce . Literal . Word32Literal . toInteger $ W# b
  "GHC.Prim.word32ToWord#" | [i] <- word32Literals' args
    -> reduce . Literal $ WordLiteral i
  "GHC.Prim.plusWord32#" | Just r <- liftW32 plusWord32# args
    -> reduce r
  "GHC.Prim.subWord32#" | Just r <- liftW32 subWord32# args
    -> reduce r
  "GHC.Prim.timesWord32#" | Just r <- liftW32 timesWord32# args
    -> reduce r
  "GHC.Prim.quotWord32#" | Just r <- liftW32 quotWord32# args
    -> reduce r
  "GHC.Prim.remWord32#" | Just r <- liftW32 remWord32# args
    -> reduce r
  "GHC.Prim.quotRemWord32#"
    | [i, j] <- word32Literals' args
    , (_,tyView -> TyConApp tupTcNm tyArgs) <- splitFunForallTy ty
    , (Just tupTc) <- UniqMap.lookup tupTcNm tcm
    , [tupDc] <- tyConDataCons tupTc
    -> let !(W32# a)    = fromInteger i
           !(W32# b)    = fromInteger j
           !(# q, r #) = quotRemWord32# a b
        in reduce $
           mkApps (Data tupDc) (map Right tyArgs ++
                  [ Left (Literal (Word32Literal (toInteger (W32# q))))
                  , Left (Literal (Word32Literal (toInteger (W32# r))))])
  "GHC.Prim.andWord32#" | Just r <- liftW32 andWord32# args
    -> reduce r
  "GHC.Prim.orWord32#" | Just r <- liftW32 orWord32# args
    -> reduce r
  "GHC.Prim.xorWord32#" | Just r <- liftW32 xorWord32# args
    -> reduce r
  "GHC.Prim.notWord32#" | [i] <- word32Literals' args
    -> let !(W32# a) = fromInteger i
        in reduce (Literal (Word32Literal (toInteger (W32# (notWord32# a)))))
  "GHC.Prim.uncheckedShiftLWord32#" | Just r <- liftW32I uncheckedShiftLWord32# args
    -> reduce r
  "GHC.Prim.uncheckedShiftRLWord32#" | Just r <- liftW32I uncheckedShiftRLWord32# args
    -> reduce r
  "GHC.Prim.word32ToInt32#" | [i] <- word32Literals' args
    -> let !(W32# a) = fromInteger i
        in reduce (Literal (Int32Literal (toInteger (I32# (word32ToInt32# a)))))
  "GHC.Prim.eqWord32#" | Just r <- liftW32RI eqWord32# args
    -> reduce r
  "GHC.Prim.geWord32#" | Just r <- liftW32RI geWord32# args
    -> reduce r
  "GHC.Prim.gtWord32#" | Just r <- liftW32RI gtWord32# args
    -> reduce r
  "GHC.Prim.leWord32#" | Just r <- liftW32RI leWord32# args
    -> reduce r
  "GHC.Prim.ltWord32#" | Just r <- liftW32RI ltWord32# args
    -> reduce r
  "GHC.Prim.neWord32#" | Just r <- liftW32RI neWord32# args
    -> reduce r

#if MIN_VERSION_base(4,17,0)
----------
-- Word64#
----------
  "GHC.Prim.wordToWord64#" | [i] <- wordLiterals' args
    -> reduce (Literal (Word64Literal i))
  "GHC.Prim.word64ToWord#" | [i] <- word64Literals' args
    -> reduce . Literal $ WordLiteral i
  "GHC.Prim.plusWord64#" | Just r <- liftW64 plusWord64# args
    -> reduce r
  "GHC.Prim.subWord64#" | Just r <- liftW64 subWord64# args
    -> reduce r
  "GHC.Prim.timesWord64#" | Just r <- liftW64 timesWord64# args
    -> reduce r
  "GHC.Prim.quotWord64#" | Just r <- liftW64 quotWord64# args
    -> reduce r
  "GHC.Prim.remWord64#" | Just r <- liftW64 remWord64# args
    -> reduce r
  "GHC.Prim.and64#" | Just r <- liftW64 and64# args
    -> reduce r
  "GHC.Prim.or64#" | Just r <- liftW64 or64# args
    -> reduce r
  "GHC.Prim.xor64#" | Just r <- liftW64 xor64# args
    -> reduce r
  "GHC.Prim.not64#" | [i] <- word64Literals' args
    -> let !(W64# a) = fromInteger i
        in reduce (Literal (Word64Literal (toInteger (W64# (not64# a)))))
  "GHC.Prim.uncheckedShiftL64#" | Just r <- liftW64I uncheckedShiftL64# args
    -> reduce r
  "GHC.Prim.uncheckedShiftRL64#" | Just r <- liftW64I uncheckedShiftRL64# args
    -> reduce r
  "GHC.Prim.word64ToInt64#" | [i] <- word64Literals' args
    -> let !(W64# a) = fromInteger i
        in reduce (Literal (Int64Literal (toInteger (I64# (word64ToInt64# a)))))
  "GHC.Prim.eqWord64#" | Just r <- liftW64RI eqWord64# args
    -> reduce r
  "GHC.Prim.geWord64#" | Just r <- liftW64RI geWord64# args
    -> reduce r
  "GHC.Prim.gtWord64#" | Just r <- liftW64RI gtWord64# args
    -> reduce r
  "GHC.Prim.leWord64#" | Just r <- liftW64RI leWord64# args
    -> reduce r
  "GHC.Prim.ltWord64#" | Just r <- liftW64RI ltWord64# args
    -> reduce r
  "GHC.Prim.neWord64#" | Just r <- liftW64RI neWord64# args
    -> reduce r
#endif
#endif

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

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

  Text
"GHC.Prim.double2Int#" | [Word64
i] <- [Value] -> [Word64]
doubleLiterals' [Value]
args
    -> let !(D# Double#
a) = Word64 -> Double
wordToDouble Word64
i
           r :: Int#
r = Double# -> Int#
double2Int# Double#
a
       in  Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> (Int -> Term) -> Int -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Term
Literal (Literal -> Term) -> (Int -> Literal) -> Int -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
IntLiteral (Integer -> Literal) -> (Int -> Integer) -> Int -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Maybe Machine) -> Int -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
r
  Text
"GHC.Prim.double2Float#"
    | [Lit (DoubleLiteral Word64
d)] <- [Value]
args
    -> let !(D# Double#
a) = Word64 -> Double
wordToDouble Word64
d
           r :: Float#
r = Double# -> Float#
double2Float# Double#
a
       in 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
. Word32 -> Literal
FloatLiteral (Word32 -> Literal) -> (Float -> Word32) -> Float -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Word32
floatToWord (Float -> Maybe Machine) -> Float -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Float# -> Float
F# Float#
r

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

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

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

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

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

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

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

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

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

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

  Text
"GHC.Prim.float2Double#" | [Word32
i] <- [Value] -> [Word32]
floatLiterals' [Value]
args
    -> let !(F# Float#
a) = Word32 -> Float
wordToFloat Word32
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
. Word64 -> Literal
DoubleLiteral (Word64 -> Literal) -> (Double -> Word64) -> Double -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Word64
doubleToWord (Double -> Maybe Machine) -> Double -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Double# -> Double
D# Double#
r


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

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

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

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

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

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

  Text
"GHC.Prim.getSizeofMutBigNat#"
    | [PrimVal PrimInfo
_mbaTy [Type]
_ [Value
baV]
      ,PrimVal PrimInfo
rwTy [Type]
_ [Value]
_
      ] <- [Value]
args
    , [Integer
ba] <- [Value] -> [Integer]
intLiterals' [Value
baV]
    -> let ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
tupTcNm [Type]
tyArgs) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just TyCon
tupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
tupTcNm TyConMap
tcm
           [DataCon
tupDc] = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
           Just (Literal (ByteArrayLiteral ByteArray
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 (ByteArray -> Int
BA.sizeofByteArray ByteArray
ba')))
       in  Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
tupDc) ((Type -> Either Term Type) -> [Type] -> [Either Term Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Either Term Type
forall a b. b -> Either a b
Right [Type]
tyArgs [Either Term Type] -> [Either Term Type] -> [Either Term Type]
forall a. [a] -> [a] -> [a]
++
                      [Term -> Either Term Type
forall a b. a -> Either a b
Left (PrimInfo -> Term
Prim PrimInfo
rwTy)
                      ,Term -> Either Term Type
forall a b. a -> Either a b
Left Term
lit])

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

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

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

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

  Text
"GHC.Prim.copyAddrToByteArray#"
    | [ Lit (StringLiteral String
addr)
      , PrimVal PrimInfo
_mbaTy [Type]
_ [Value
dst_mbaV]
      , Value
offV, Value
lenV
      , PrimVal PrimInfo
rwTy [Type]
_ [Value]
_
      ] <- [Value]
args
    , [Integer
off,Integer
len,Integer
dst_mba] <- [Value] -> [Integer]
intLiterals' [Value
offV, Value
lenV, Value
dst_mbaV]
    -> let Just (Literal (ByteArrayLiteral ByteArray
dst_ba)) =
              Int -> Machine -> Maybe Term
primLookup (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
dst_mba) Machine
mach
           !(I# Int#
off') = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
off
           !(I# Int#
len') = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
len
           !(BS.PS (ForeignPtr Addr#
addr' ForeignPtrContents
_) Int
_ Int
_) = String -> ByteString
BS.packChars String
addr
           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
                    BA.MutableByteArray MutableByteArray# RealWorld
dst_mba1 <- ByteArray -> IO (MutableByteArray (PrimState IO))
forall (m :: Type -> Type).
PrimMonad m =>
ByteArray -> m (MutableByteArray (PrimState m))
BA.unsafeThawByteArray ByteArray
dst_ba
                    (State# RealWorld -> State# RealWorld) -> IO ()
svoid (Addr#
-> MutableByteArray# RealWorld
-> Int#
-> Int#
-> State# RealWorld
-> State# RealWorld
forall d.
Addr#
-> MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
copyAddrToByteArray# Addr#
addr' MutableByteArray# RealWorld
dst_mba1 Int#
off' Int#
len')
                    MutableByteArray (PrimState IO) -> IO ByteArray
forall (m :: Type -> Type).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
BA.unsafeFreezeByteArray (MutableByteArray# RealWorld -> MutableByteArray RealWorld
forall s. MutableByteArray# s -> MutableByteArray s
BA.MutableByteArray MutableByteArray# RealWorld
dst_mba1)
           ba3 :: Term
ba3 = Literal -> Term
Literal (ByteArray -> Literal
ByteArrayLiteral 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

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

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

  Text
"GHC.Prim.dataToTag#"
    | [DC DataCon
dc [Either Term Type]
_] <- [Value]
args
    -> Term -> Maybe Machine
reduce (Literal -> Term
Literal (Integer -> Literal
IntLiteral (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (DataCon -> Int
dcTag DataCon
dc Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))))

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Integer.integerLogBase#"
    | Just (a,b) <- integerLiterals args
    , Just c <- flogBase a b
    -> (reduce . Literal . WordLiteral . toInteger) c

  "GHC.Num.Integer.integerToFloat#"
    | [v] <- args
    , Just i <- integerLiteral v
    -> reduce . Literal . FloatLiteral . floatToWord $ F# (integerToFloat# i)

  "GHC.Num.Integer.integerToDouble#"
    | [v] <- args
    , Just i <- integerLiteral v
    -> reduce . Literal . DoubleLiteral . doubleToWord $ D# (integerToDouble# i)

  "GHC.Float.integerToFloat#"
    | [v] <- args
    , Just i <- integerLiteral v
    -> reduce . Literal . FloatLiteral . floatToWord $ F# (integerToFloat# i)

  "GHC.Float.integerToDouble#"
    | [v] <- args
    , Just i <- integerLiteral v
    -> reduce . Literal . DoubleLiteral . doubleToWord $ D# (integerToDouble# i)

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

#if !MIN_VERSION_base(4,15,0)
  Text
"GHC.Integer.Type.smallInteger"
    | [Lit (IntLiteral Integer
i)] <- [Value]
args
    -> Term -> Maybe Machine
reduce (Literal -> Term
Literal (Integer -> Literal
IntegerLiteral Integer
i))
#endif

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Integer.integerToInt#"
#else
  Text
"GHC.Integer.Type.integerToInt"
#endif
    | [Integer
i] <- [Value] -> [Integer]
integerLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToIntLiteral Integer
i)

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

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Integer.integerEncodeDouble#" -- :: Integer -> Int# -> Double
#else
  Text
"GHC.Integer.Type.encodeDoubleInteger" -- :: Integer -> Int# -> Double
#endif
    | [Value
iV, Lit (IntLiteral Integer
j)] <- [Value]
args
    , [Integer
i] <- [Value] -> [Integer]
integerLiterals' [Value
iV]
    -> let !(I# Int#
k') = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
j
           r :: Double#
r = Integer -> Int# -> Double#
encodeDoubleInteger Integer
i Int#
k'
    in  Term -> Maybe Machine
reduce (Term -> Maybe Machine)
-> (Double -> Term) -> Double -> Maybe Machine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Term
Literal (Literal -> Term) -> (Double -> Literal) -> Double -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Literal
DoubleLiteral (Word64 -> Literal) -> (Double -> Word64) -> Double -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Word64
doubleToWord (Double -> Maybe Machine) -> Double -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Double# -> Double
D# Double#
r

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Integer.integerEncodeFloat#"
    | [iV, Lit (IntLiteral j)] <- args
    , [i] <- integerLiterals' [iV]
    -> let !(I# k') = fromInteger j
           r = integerEncodeFloat# i k'
        in reduce . Literal . FloatLiteral . floatToWord $ F# r
#endif

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

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Integer.integerAdd"
#else
  Text
"GHC.Integer.Type.plusInteger"
#endif
    | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToIntegerLiteral (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
j))

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Integer.integerSub"
#else
  Text
"GHC.Integer.Type.minusInteger"
#endif
    | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToIntegerLiteral (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
j))

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Integer.integerMul"
#else
  Text
"GHC.Integer.Type.timesInteger"
#endif
    | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToIntegerLiteral (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
j))

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Integer.integerNegate"
#else
  Text
"GHC.Integer.Type.negateInteger"
#endif
    | [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))

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Integer.integerDiv"
#else
  Text
"GHC.Integer.Type.divInteger"
#endif
    | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Term -> Term
catchDivByZero (Integer -> Term
integerToIntegerLiteral (Integer
i Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
j))

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Integer.integerMod"
#else
  Text
"GHC.Integer.Type.modInteger"
#endif
    | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Term -> Term
catchDivByZero (Integer -> Term
integerToIntegerLiteral (Integer
i Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
j))

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Integer.integerQuot"
#else
  Text
"GHC.Integer.Type.quotInteger"
#endif
    | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Term -> Term
catchDivByZero (Integer -> Term
integerToIntegerLiteral (Integer
i Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
j))

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Integer.integerRem"
#else
  Text
"GHC.Integer.Type.remInteger"
#endif
    | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ Term -> Term
catchDivByZero (Integer -> Term
integerToIntegerLiteral (Integer
i Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`rem` Integer
j))

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

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Integer.integerGt"
#else
  Text
"GHC.Integer.Type.gtInteger"
#endif
    | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
j))

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Integer.integerGe"
#else
  Text
"GHC.Integer.Type.geInteger"
#endif
    | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
j))

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Integer.integerEq"
#else
  Text
"GHC.Integer.Type.eqInteger"
#endif
    | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
j))

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Integer.integerNe"
#else
  Text
"GHC.Integer.Type.neqInteger"
#endif
    | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
j))

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Integer.integerLt"
#else
  Text
"GHC.Integer.Type.ltInteger"
#endif
    | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
j))

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Integer.integerLe"
#else
  Text
"GHC.Integer.Type.leInteger"
#endif
    | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
j))

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Integer.integerGt#"
#else
  Text
"GHC.Integer.Type.gtInteger#"
#endif
    | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Bool -> Term
boolToIntLiteral (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
j))

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Integer.integerGe#"
#else
  Text
"GHC.Integer.Type.geInteger#"
#endif
    | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Bool -> Term
boolToIntLiteral (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
j))

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Integer.integerEq#"
#else
  Text
"GHC.Integer.Type.eqInteger#"
#endif
    | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Bool -> Term
boolToIntLiteral (Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
j))

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Integer.integerNe#"
#else
  Text
"GHC.Integer.Type.neqInteger#"
#endif
    | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Bool -> Term
boolToIntLiteral (Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
j))

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Integer.integerLt#"
#else
  Text
"GHC.Integer.Type.ltInteger#"
#endif
    | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Bool -> Term
boolToIntLiteral (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
j))

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Integer.integerLe#"
#else
  Text
"GHC.Integer.Type.leInteger#"
#endif
    | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
integerLiterals [Value]
args
    -> Term -> Maybe Machine
reduce (Bool -> Term
boolToIntLiteral (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
j))

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

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Integer.integerShiftR#"
    | [iV, Lit (WordLiteral j)] <- args
#else
  Text
"GHC.Integer.Type.shiftRInteger"
    | [Value
iV, Lit (IntLiteral Integer
j)] <- [Value]
args
#endif
    , [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))

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Integer.integerShiftL#"
    | [iV, Lit (WordLiteral j)] <- args
#else
  Text
"GHC.Integer.Type.shiftLInteger"
    | [Value
iV, Lit (IntLiteral Integer
j)] <- [Value]
args
#endif
    , [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))

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Integer.integerFromWord#"
#else
  Text
"GHC.Integer.Type.wordToInteger"
#endif
    | [Lit (WordLiteral Integer
w)] <- [Value]
args
    -> Term -> Maybe Machine
reduce (Literal -> Term
Literal (Integer -> Literal
IntegerLiteral Integer
w))

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Integer.integerToWord#"
#else
  Text
"GHC.Integer.Type.integerToWord"
#endif
    | [Integer
i] <- [Value] -> [Integer]
integerLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToWordLiteral Integer
i)

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

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Natural.NS"
    | [Lit (WordLiteral w)] <- args
    -> reduce (Literal (NaturalLiteral w))
  "GHC.Num.Natural.NB"
    | [Lit (ByteArrayLiteral (BA.ByteArray ba))] <- args
    -> reduce (Literal (NaturalLiteral (IP ba)))
    | [Lit l] <- args
    -> error ("NB: " <> show l)
  "GHC.Num.Integer.IS"
    | [Lit (IntLiteral i)] <- args
    -> reduce (Literal (IntegerLiteral i))
  "GHC.Num.Integer.IP"
    | [Lit (ByteArrayLiteral (BA.ByteArray ba))] <- args
    -> reduce (Literal (IntegerLiteral (IP ba)))
    | [Lit l] <- args
    -> error ("IP: " <> show l)
  "GHC.Num.Integer.IN"
    | [Lit l] <- args
    -> error ("IN: " <> show l)
#else
  Text
"GHC.Natural.NatS#"
    | [Lit (WordLiteral Integer
w)] <- [Value]
args
    -> Term -> Maybe Machine
reduce (Literal -> Term
Literal (Integer -> Literal
NaturalLiteral Integer
w))
#endif

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Integer.integerFromNatural"
#else
  Text
"GHC.Natural.naturalToInteger"
#endif
    | [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)))

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Integer.integerToNatural"
#else
  Text
"GHC.Natural.naturalFromInteger"
#endif
    | [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)

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Integer.integerToNaturalClamp"
    | [i] <- integerLiterals' args
    -> if i < 0 then
         reduce (naturalToNaturalLiteral 0)
       else
         reduce (naturalToNaturalLiteral (fromInteger i))

  "GHC.Num.Integer.integerToNaturalThrow"
    | [i] <- integerLiterals' args
    -> let nTy = snd (splitFunForallTy ty) in
       reduce (checkNaturalRange1 nTy i id)
#endif

  Text
"GHC.Num.Integer.integerToInt64#"
    | [Integer
i] <- [Value] -> [Integer]
integerLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToInt64Literal Integer
i)

  Text
"GHC.Num.Integer.integerToWord64#"
    | [Integer
i] <- [Value] -> [Integer]
integerLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToWord64Literal Integer
i)

#if MIN_VERSION_base(4,17,0)
  "GHC.Num.Integer.integerFromWord64#"
    | [w] <- word64Literals' args
    -> reduce (Literal (IntegerLiteral w))
#endif

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

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

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

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Natural.naturalSubUnsafe"
    | Just (i,j) <- naturalLiterals args
    ->
     let nTy = snd (splitFunForallTy ty) in
     reduce (checkNaturalRange nTy [i, j] (\[i', j'] ->
      naturalToNaturalLiteral (naturalSubUnsafe i' j')))

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

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

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Natural.naturalToWord#"
    | [i] <- naturalLiterals' args
    -> reduce (integerToWordLiteral i)

  "GHC.Num.Natural.naturalQuot"
    | Just (i,j) <- naturalLiterals args
    ->
     let nTy = snd (splitFunForallTy ty) in
     reduce (checkNaturalRange2 nTy i j quot)

  "GHC.Num.Natural.naturalRem"
    | Just (i,j) <- naturalLiterals args
    ->
     let nTy = snd (splitFunForallTy ty) in
     reduce (checkNaturalRange2 nTy i j rem)
#endif

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Natural.naturalQuotRem#" -- :: Natural -> Natural -> (#Natural, Natural#)
    | [i, j] <- naturalLiterals' args
    -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty
           (Just tupTc) = UniqMap.lookup tupTcNm tcm
           [tupDc] = tyConDataCons tupTc
           (q,r) = quotRem (fromInteger i) (fromInteger j)
    in reduce $
         mkApps (Data tupDc) (map Right tyArgs ++
                [ Left $ catchDivByZero (naturalToNaturalLiteral q)
                , Left $ catchDivByZero (naturalToNaturalLiteral r)])
#endif

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

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Natural.naturalLcm"
    | Just (i,j) <- naturalLiterals args
    ->
     let nTy = snd (splitFunForallTy ty) in
     reduce (checkNaturalRange2 nTy i j lcm)
#endif

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Natural.naturalGt#"
    | Just (i,j) <- naturalLiterals args
    -> reduce (boolToIntLiteral (i > j))

  "GHC.Num.Natural.naturalGe#"
    | Just (i,j) <- naturalLiterals args
    -> reduce (boolToIntLiteral (i >= j))

  "GHC.Num.Natural.naturalEq#"
    | Just (i,j) <- naturalLiterals args
    -> reduce (boolToIntLiteral (i == j))

  "GHC.Num.Natural.naturalNe#"
    | Just (i,j) <- naturalLiterals args
    -> reduce (boolToIntLiteral (i /= j))

  "GHC.Num.Natural.naturalLt#"
    | Just (i,j) <- naturalLiterals args
    -> reduce (boolToIntLiteral (i < j))

  "GHC.Num.Natural.naturalLe#"
    | Just (i,j) <- naturalLiterals args
    -> reduce (boolToIntLiteral (i <= j))

  "GHC.Num.Natural.naturalShiftL#"
    | [iV, Lit (WordLiteral j)] <- args
    , [i] <- naturalLiterals' [iV]
    -> reduce (naturalToNaturalLiteral (fromInteger (i `shiftL` fromInteger j)))

  "GHC.Num.Natural.naturalShiftR#"
    | [iV, Lit (WordLiteral j)] <- args
    , [i] <- naturalLiterals' [iV]
    -> reduce (naturalToNaturalLiteral (fromInteger (i `shiftR` fromInteger j)))

  "GHC.Num.Natural.naturalCompare"
    | [i, j] <- naturalLiterals' args
    -> let -- Get the required result type (viewed as an applied type constructor name)
           (_,tyView -> TyConApp tupTcNm []) = splitFunForallTy ty
           -- Find the type constructor from the name
           (Just tupTc) = UniqMap.lookup tupTcNm tcm
           -- Get the data constructors of that type
           -- The type is 'Ordering', so they are: 'LT', 'EQ', 'GT'
           [ltDc, eqDc, gtDc] = tyConDataCons tupTc
           -- Do the actual compile-time evaluation
           ordVal = compareInteger i j
        in reduce $ case ordVal of
            LT -> Data ltDc
            EQ -> Data eqDc
            GT -> Data gtDc

  "GHC.Num.Natural.naturalSignum"
    | [i] <- naturalLiterals' args
    -> reduce (Literal (NaturalLiteral (signum i)))

  "GHC.Num.Natural.$wnaturalSignum"
    | [i] <- naturalLiterals' args
    -> reduce (Literal (WordLiteral (signum i)))
#endif

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

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

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

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

  Text
"GHC.TypeNats.someNatVal"
    | [Lit (NaturalLiteral Integer
n)] <- [Value]
args
    -> let resTy :: Type
resTy = TyConMap -> Type -> [Type] -> Type
getResultTy TyConMap
tcm Type
ty [Type]
tys
        in Term -> Maybe Machine
reduce (TyConMap -> Integer -> Type -> Term
mkSomeNat TyConMap
tcm Integer
n Type
resTy)

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

  Text
"GHC.Int.I8#"
    | Bool
isSubj
#if MIN_VERSION_base(4,16,0)
    , [Lit (Int8Literal i)] <- args
#else
    , [Lit (IntLiteral Integer
i)] <- [Value]
args
#endif
    ->  let ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
intTcNm []) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
            (Just TyCon
intTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
intTcNm TyConMap
tcm
            [DataCon
intDc] = TyCon -> [DataCon]
tyConDataCons TyCon
intTc
#if MIN_VERSION_base(4,16,0)
        in  reduce (mkApps (Data intDc) [Left (Literal (Int8Literal i))])
#else
        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))])
#endif
  Text
"GHC.Int.I16#"
    | Bool
isSubj
#if MIN_VERSION_base(4,16,0)
    , [Lit (Int16Literal i)] <- args
#else
    , [Lit (IntLiteral Integer
i)] <- [Value]
args
#endif
    ->  let ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
intTcNm []) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
            (Just TyCon
intTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
intTcNm TyConMap
tcm
            [DataCon
intDc] = TyCon -> [DataCon]
tyConDataCons TyCon
intTc
#if MIN_VERSION_base(4,16,0)
        in  reduce (mkApps (Data intDc) [Left (Literal (Int16Literal i))])
#else
        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))])
#endif
  Text
"GHC.Int.I32#"
    | Bool
isSubj
#if MIN_VERSION_base(4,16,0)
    , [Lit (Int32Literal i)] <- args
#else
    , [Lit (IntLiteral Integer
i)] <- [Value]
args
#endif
    ->  let ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
intTcNm []) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
            (Just TyCon
intTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
intTcNm TyConMap
tcm
            [DataCon
intDc] = TyCon -> [DataCon]
tyConDataCons TyCon
intTc
#if MIN_VERSION_base(4,16,0)
        in  reduce (mkApps (Data intDc) [Left (Literal (Int32Literal i))])
#else
        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))])
#endif
  Text
"GHC.Int.I64#"
    | Bool
isSubj
#if MIN_VERSION_base(4,16,0)
    , [Lit (Int64Literal i)] <- args
#else
    , [Lit (IntLiteral Integer
i)] <- [Value]
args
#endif
    ->  let ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
intTcNm []) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
            (Just TyCon
intTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
intTcNm TyConMap
tcm
            [DataCon
intDc] = TyCon -> [DataCon]
tyConDataCons TyCon
intTc
#if MIN_VERSION_base(4,16,0)
        in  reduce (mkApps (Data intDc) [Left (Literal (Int64Literal i))])
#else
        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))])
#endif

  Text
"GHC.Word.W8#"
    | Bool
isSubj
#if MIN_VERSION_base(4,16,0)
    , [Lit (Word8Literal c)] <- args
#else
    , [Lit (WordLiteral Integer
c)] <- [Value]
args
#endif
    ->  let ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
wordTcNm []) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
            (Just TyCon
wordTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
wordTcNm TyConMap
tcm
            [DataCon
wordDc] = TyCon -> [DataCon]
tyConDataCons TyCon
wordTc
#if MIN_VERSION_base(4,16,0)
        in  reduce (mkApps (Data wordDc) [Left (Literal (Word8Literal c))])
#else
        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))])
#endif
  Text
"GHC.Word.W16#"
    | Bool
isSubj
#if MIN_VERSION_base(4,16,0)
    , [Lit (Word16Literal c)] <- args
#else
    , [Lit (WordLiteral Integer
c)] <- [Value]
args
#endif
    ->  let ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
wordTcNm []) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
            (Just TyCon
wordTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
wordTcNm TyConMap
tcm
            [DataCon
wordDc] = TyCon -> [DataCon]
tyConDataCons TyCon
wordTc
#if MIN_VERSION_base(4,16,0)
        in  reduce (mkApps (Data wordDc) [Left (Literal (Word16Literal c))])
#else
        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))])
#endif
  Text
"GHC.Word.W32#"
    | Bool
isSubj
#if MIN_VERSION_base(4,16,0)
    , [Lit (Word32Literal c)] <- args
#else
    , [Lit (WordLiteral Integer
c)] <- [Value]
args
#endif
    ->  let ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
wordTcNm []) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
            (Just TyCon
wordTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
wordTcNm TyConMap
tcm
            [DataCon
wordDc] = TyCon -> [DataCon]
tyConDataCons TyCon
wordTc
#if MIN_VERSION_base(4,16,0)
        in  reduce (mkApps (Data wordDc) [Left (Literal (Word32Literal c))])
#else
        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))])
#endif
  Text
"GHC.Word.W64#"
    | Bool
isSubj
#if MIN_VERSION_base(4,16,0)
    , [Lit (Word64Literal c)] <- args
#else
    , [Lit (WordLiteral Integer
c)] <- [Value]
args
#endif
    ->  let ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
wordTcNm []) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
            (Just TyCon
wordTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
wordTcNm TyConMap
tcm
            [DataCon
wordDc] = TyCon -> [DataCon]
tyConDataCons TyCon
wordTc
#if MIN_VERSION_base(4,16,0)
        in  reduce (mkApps (Data wordDc) [Left (Literal (Word64Literal c))])
#else
        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))])
#endif

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

  Text
"GHC.Float.$w$sfromRat''" -- XXX: Very fragile
    | [Lit (IntLiteral Integer
_minEx)
      ,Lit (IntLiteral Integer
matDigs)
      ,Value
nV
      ,Value
dV] <- [Value]
args
    , [Integer
n,Integer
d] <- [Value] -> [Integer]
integerLiterals' [Value
nV,Value
dV]
    -> case Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
matDigs of
          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 (Word32 -> Literal
FloatLiteral (Float -> Word32
floatToWord (Rational -> Float
forall a. Fractional a => Rational -> a
fromRational (Integer
n Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% Integer
d)))))
            | 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 (Word64 -> Literal
DoubleLiteral (Double -> Word64
doubleToWord (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Integer
n Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% Integer
d)))))
          Int
_ -> String -> Maybe Machine
forall a. HasCallStack => String -> a
error (String -> Maybe Machine) -> String -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"GHC.Float.$w$sfromRat'': Not a Float or Double"

  Text
"GHC.Float.$w$sfromRat''1" -- XXX: Very fragile
    | [Lit (IntLiteral Integer
_minEx)
      ,Lit (IntLiteral Integer
matDigs)
      ,Value
nV
      ,Value
dV] <- [Value]
args
    , [Integer
n,Integer
d] <- [Value] -> [Integer]
integerLiterals' [Value
nV,Value
dV]
    -> case Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
matDigs of
          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 (Word32 -> Literal
FloatLiteral (Float -> Word32
floatToWord (Rational -> Float
forall a. Fractional a => Rational -> a
fromRational (Integer
n Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% Integer
d)))))
            | 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 (Word64 -> Literal
DoubleLiteral (Double -> Word64
doubleToWord (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Integer
n Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% Integer
d)))))
          Int
_ -> String -> Maybe Machine
forall a. HasCallStack => String -> a
error (String -> Maybe Machine) -> String -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"GHC.Float.$w$sfromRat'': Not a Float or Double"

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Integer.integerSignum#"
#else
  Text
"GHC.Integer.Type.$wsignumInteger" -- XXX: Not super-fragile, but still..
#endif
    | [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)))

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Integer.integerSignum"
#else
  Text
"GHC.Integer.Type.signumInteger"
#endif
    | [Integer
i] <- [Value] -> [Integer]
integerLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Literal -> Term
Literal (Integer -> Literal
IntegerLiteral (Integer -> Integer
signumInteger Integer
i)))

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Integer.$wintegerSignum"
    | [i] <- integerLiterals' args
    -> reduce (Literal (IntLiteral (signum i)))
#endif

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Integer.integerAbs"
#else
  Text
"GHC.Integer.Type.absInteger"
#endif
    | [Integer
i] <- [Value] -> [Integer]
integerLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Literal -> Term
Literal (Integer -> Literal
IntegerLiteral (Integer -> Integer
absInteger Integer
i)))

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Integer.integerBit#"
    | [i] <- wordLiterals' args
#else
  Text
"GHC.Integer.Type.bitInteger"
    | [Integer
i] <- [Value] -> [Integer]
intLiterals' [Value]
args
#endif
    -> 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))))

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Integer.integerComplement"
#else
  Text
"GHC.Integer.Type.complementInteger"
#endif
    | [Integer
i] <- [Value] -> [Integer]
integerLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Literal -> Term
Literal (Integer -> Literal
IntegerLiteral (Integer -> Integer
complementInteger Integer
i)))

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Integer.integerOr"
#else
  Text
"GHC.Integer.Type.orInteger"
#endif
    | [Integer
i, 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)))

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Integer.integerXor"
#else
  Text
"GHC.Integer.Type.xorInteger"
#endif
    | [Integer
i, 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)))

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Integer.integerAnd"
#else
  Text
"GHC.Integer.Type.andInteger"
#endif
    | [Integer
i, 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)))

#if MIN_VERSION_base(4,15,0)
  "GHC.Num.Integer.integerToDouble#"
#else
  Text
"GHC.Integer.Type.doubleFromInteger"
#endif
    | [Integer
i] <- [Value] -> [Integer]
integerLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Literal -> Term
Literal (Word64 -> Literal
DoubleLiteral (Double -> Word64
doubleToWord (Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
i))))

#if MIN_VERSION_base(4,17,0)
  "GHC.Num.Integer.$wintegerFromInt64#"
    | [i] <- int64Literals' args
    -> reduce . Literal $ IntLiteral i
#endif

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

  Text
"GHC.Base.quotInt"
    | [ DC DataCon
intDc [Left (Literal (IntLiteral Integer
i))]
      , DC DataCon
_     [Left (Literal (IntLiteral Integer
j))]
      ] <- [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Term -> Term
App (DataCon -> Term
Data DataCon
intDc) (Literal -> Term
Literal (Integer -> Literal
IntLiteral (Integer
i Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
j))))

  Text
"GHC.Base.remInt"
    | [ DC DataCon
intDc [Left (Literal (IntLiteral Integer
i))]
      , DC DataCon
_     [Left (Literal (IntLiteral Integer
j))]
      ] <- [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Term -> Term
App (DataCon -> Term
Data DataCon
intDc) (Literal -> Term
Literal (Integer -> Literal
IntLiteral (Integer
i Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`rem` Integer
j))))

  Text
"GHC.Base.divInt"
    | [ DC DataCon
intDc [Left (Literal (IntLiteral Integer
i))]
      , DC DataCon
_     [Left (Literal (IntLiteral Integer
j))]
      ] <- [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Term -> Term
App (DataCon -> Term
Data DataCon
intDc) (Literal -> Term
Literal (Integer -> Literal
IntLiteral (Integer
i Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
j))))


  Text
"GHC.Base.modInt"
    | [ DC DataCon
intDc [Left (Literal (IntLiteral Integer
i))]
      , DC DataCon
_     [Left (Literal (IntLiteral Integer
j))]
      ] <- [Value]
args
    -> Term -> Maybe Machine
reduce (Term -> Term -> Term
App (DataCon -> Term
Data DataCon
intDc) (Literal -> Term
Literal (Integer -> Literal
IntLiteral (Integer
i Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
j))))

  Text
"Clash.Class.BitPack.Internal.packDouble#" -- :: Double -> BitVector 64
    | [DC DataCon
_ [Left Term
arg]] <- [Value]
args
    , Evaluator
eval <- Step -> Unwind -> PrimStep -> PrimUnwind -> Evaluator
Evaluator Step
ghcStep Unwind
ghcUnwind PrimStep
ghcPrimStep PrimUnwind
ghcPrimUnwind
    , mach2 :: Machine
mach2@Machine{mStack :: Machine -> Stack
mStack=[],mTerm :: Machine -> Term
mTerm=Literal (DoubleLiteral Word64
i)} <- Evaluator -> TyConMap -> Bool -> Machine -> Machine
whnf Evaluator
eval 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 Integer
0 (BitVector 64 -> Integer
forall a. Integral a => a -> Integer
toInteger (BitVector 64 -> Integer) -> BitVector 64 -> Integer
forall a b. (a -> b) -> a -> b
$ (Word64 -> BitVector 64
forall a. BitPack a => a -> BitVector (BitSize a)
pack :: Word64 -> BitVector 64) Word64
i)
             }

  Text
"Clash.Class.BitPack.Internal.packFloat#" -- :: Float -> BitVector 32
    | [DC DataCon
_ [Left Term
arg]] <- [Value]
args
    , Evaluator
eval <- Step -> Unwind -> PrimStep -> PrimUnwind -> Evaluator
Evaluator Step
ghcStep Unwind
ghcUnwind PrimStep
ghcPrimStep PrimUnwind
ghcPrimUnwind
    , mach2 :: Machine
mach2@Machine{mStack :: Machine -> Stack
mStack=[],mTerm :: Machine -> Term
mTerm=Literal (FloatLiteral Word32
i)} <- Evaluator -> TyConMap -> Bool -> Machine -> Machine
whnf Evaluator
eval 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 Integer
0 (BitVector 32 -> Integer
forall a. Integral a => a -> Integer
toInteger (BitVector 32 -> Integer) -> BitVector 32 -> Integer
forall a b. (a -> b) -> a -> b
$ (Word32 -> BitVector 32
forall a. BitPack a => a -> BitVector (BitSize a)
pack :: Word32 -> BitVector 32) Word32
i)
             }

  Text
"Clash.Class.BitPack.Internal.unpackFloat#"
    | [(Integer, Integer)
i] <- [Value] -> [(Integer, Integer)]
bitVectorLiterals' [Value]
args
    -> let resTy :: Type
resTy = TyConMap -> Type -> [Type] -> Type
getResultTy TyConMap
tcm Type
ty [Type]
tys
           val :: Word32
val = BitVector (BitSize Word32) -> Word32
forall a. BitPack a => BitVector (BitSize a) -> a
unpack ((Integer, Integer) -> BitVector 32
forall (n :: Nat). (Integer, Integer) -> BitVector n
toBV (Integer, Integer)
i :: BitVector 32)
        in Term -> Maybe Machine
reduce (TyConMap -> Word32 -> Type -> Term
mkFloatCLit TyConMap
tcm Word32
val Type
resTy)

  Text
"Clash.Class.BitPack.Internal.unpackDouble#"
    | [(Integer, Integer)
i] <- [Value] -> [(Integer, Integer)]
bitVectorLiterals' [Value]
args
    -> let resTy :: Type
resTy = TyConMap -> Type -> [Type] -> Type
getResultTy TyConMap
tcm Type
ty [Type]
tys
           val :: Word64
val = BitVector (BitSize Word64) -> Word64
forall a. BitPack a => BitVector (BitSize a) -> a
unpack ((Integer, Integer) -> BitVector 64
forall (n :: Nat). (Integer, Integer) -> BitVector n
toBV (Integer, Integer)
i :: BitVector 64)
        in Term -> Maybe Machine
reduce (TyConMap -> Word64 -> Type -> Term
mkDoubleCLit TyConMap
tcm Word64
val Type
resTy)

  Text
"Clash.Class.BitPack.Internal.xToBV"
    | Bool
isSubj
    , Just (Type
nTy, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    -- The second argument to `xToBV` is always going to be suspended.
    -- See Note [Lazy primitives]
    , [ Value
_, (Suspend Term
arg) ] <- [Value]
args
    , Evaluator
eval <- Step -> Unwind -> PrimStep -> PrimUnwind -> Evaluator
Evaluator Step
ghcStep Unwind
ghcUnwind PrimStep
ghcPrimStep PrimUnwind
ghcPrimUnwind
    , mach1 :: Machine
mach1@Machine{mStack :: Machine -> Stack
mStack=[],mTerm :: Machine -> Term
mTerm=Term
argWHNF} <-
        Evaluator -> TyConMap -> Bool -> Machine -> Machine
whnf Evaluator
eval TyConMap
tcm Bool
True (Term -> Machine -> Machine
setTerm Term
arg (Machine -> Machine
stackClear Machine
mach))
    , let undefBitVector :: Maybe Machine
undefBitVector =
            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
                 , mTerm :: Term
mTerm  = Type -> Type -> Integer -> Integer -> Integer -> Term
mkBitVectorLit Type
ty Type
nTy Integer
kn (Int -> Integer
forall a. Bits a => Int -> a
bit (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
kn)Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1) Integer
0
                 }
    -> case Term -> Either String Term
forall a. a -> Either String a
isX Term
argWHNF of
         Left String
_ -> Maybe Machine
undefBitVector
         Either String Term
_ -> case Term -> (Term, [Either Term Type])
collectArgs Term
argWHNF of
           (Prim PrimInfo
p,[Either Term Type]
_) | PrimInfo -> Text
primName PrimInfo
p Text -> [Text] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` [Text]
undefinedXPrims -> Maybe Machine
undefBitVector
           (Term, [Either Term Type])
_ -> 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
                     , mTerm :: Term
mTerm  = Term
argWHNF
                     }

  -- expIndex#
  --   :: KnownNat m
  --   => Index m
  --   -> SNat n
  --   -> Index (n^m)
  Text
"Clash.Class.Exp.expIndex#"
    | [Integer
b] <- [Value] -> [Integer]
indexLiterals' [Value]
args
    , [(Type
_mTy, Integer
km), (Type
_, 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)
  Text
"Clash.Class.Exp.expSigned#"
    | [Integer
b] <- [Value] -> [Integer]
signedLiterals' [Value]
args
    , [(Type
_mTy, Integer
km), (Type
_, 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
  Text
"Clash.Class.Exp.expUnsigned#"
    | [Integer
b] <- [Value] -> [Integer]
unsignedLiterals' [Value]
args
    , [(Type
_mTy, Integer
km), (Type
_, 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))

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

  Text
"Clash.Promoted.Nat.flogBaseSNat"
    | [Right Integer
a, Right Integer
b] <- (Type -> Either String Integer)
-> [Type] -> [Either String Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (Except String Integer -> Either String Integer)
-> (Type -> Except String Integer) -> Type -> Either String Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm) [Type]
tys
    , Just 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 ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
snatTcNm [Type]
_) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just TyCon
snatTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
snatTcNm TyConMap
tcm
           [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'))]

  Text
"Clash.Promoted.Nat.clogBaseSNat"
    | [Right Integer
a, Right Integer
b] <- (Type -> Either String Integer)
-> [Type] -> [Either String Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (Except String Integer -> Either String Integer)
-> (Type -> Except String Integer) -> Type -> Either String Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm) [Type]
tys
    , Just 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 ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
snatTcNm [Type]
_) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just TyCon
snatTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
snatTcNm TyConMap
tcm
           [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'))]
    | Bool
otherwise
    -> String -> Maybe Machine
forall a. HasCallStack => String -> a
error (String
"clogBaseSNat: args = " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Value] -> String
forall a. Show a => a -> String
show [Value]
args String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
", tys = " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Type] -> String
forall a. Show a => a -> String
show [Type]
tys)

  Text
"Clash.Promoted.Nat.logBaseSNat"
    | [Right Integer
a, Right Integer
b] <- (Type -> Either String Integer)
-> [Type] -> [Either String Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (Except String Integer -> Either String Integer)
-> (Type -> Except String Integer) -> Type -> Either String Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm) [Type]
tys
    , Just 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 ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
snatTcNm [Type]
_) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just TyCon
snatTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
snatTcNm TyConMap
tcm
           [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
  Text
"Clash.Sized.Internal.BitVector.BV"
    | [Right Integer
_] <- (Type -> Either String Integer)
-> [Type] -> [Either String Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (Except String Integer -> Either String Integer)
-> (Type -> Except String Integer) -> Type -> Either String Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm) [Type]
tys
    , Just (Integer
m,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)

  Text
"Clash.Sized.Internal.BitVector.Bit"
    | Just (Integer
m,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
  Text
"Clash.Sized.Internal.BitVector.size#"
    | Just (Type
_, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    -> let ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
intTcNm [Type]
_) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just TyCon
intTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
intTcNm TyConMap
tcm
           [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))])
  Text
"Clash.Sized.Internal.BitVector.maxIndex#"
    | Just (Type
_, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    -> let ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
intTcNm [Type]
_) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just TyCon
intTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
intTcNm TyConMap
tcm
           [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
-Integer
1)))])

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

  Text
"Clash.Sized.Internal.BitVector.undefined#"
    | Just (Type
_, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    -> let resTyInfo :: (Type, Type, Integer)
resTyInfo = TyConMap -> Type -> [Type] -> (Type, Type, Integer)
extractTySizeInfo TyConMap
tcm Type
ty [Type]
tys
           mask :: Integer
mask = Int -> Integer
forall a. Bits a => Int -> a
bit (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
kn) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1
       in Term -> Maybe Machine
reduce ((Type, Type, Integer) -> Integer -> Integer -> Term
mkBitVectorLit' (Type, Type, Integer)
resTyInfo Integer
mask Integer
0)

-- Eq
  Text
"Clash.Sized.Internal.BitVector.eq##" | [(Integer
0,Integer
i),(Integer
0,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))
  Text
"Clash.Sized.Internal.BitVector.neq##" | [(Integer
0,Integer
i),(Integer
0,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
  Text
"Clash.Sized.Internal.BitVector.lt##" | [(Integer
0,Integer
i),(Integer
0,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))
  Text
"Clash.Sized.Internal.BitVector.ge##" | [(Integer
0,Integer
i),(Integer
0,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))
  Text
"Clash.Sized.Internal.BitVector.gt##" | [(Integer
0,Integer
i),(Integer
0,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))
  Text
"Clash.Sized.Internal.BitVector.le##" | [(Integer
0,Integer
i),(Integer
0,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))

-- Enum
  Text
"Clash.Sized.Internal.BitVector.toEnum##"
    | [Integer
i] <- [Value] -> [Integer]
intCLiterals' [Value]
args
    -> let Bit Word
msk Word
val = Int -> Bit
BitVector.toEnum## (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i)
       in Term -> Maybe Machine
reduce (Type -> Integer -> Integer -> Term
mkBitLit Type
ty (Word -> Integer
forall a. Integral a => a -> Integer
toInteger Word
msk) (Word -> Integer
forall a. Integral a => a -> Integer
toInteger Word
val))

-- Bits
  Text
"Clash.Sized.Internal.BitVector.and##"
    | [(Integer, Integer)
i,(Integer, Integer)
j] <- [Value] -> [(Integer, Integer)]
bitLiterals [Value]
args
    -> let Bit Word
msk Word
val = Bit -> Bit -> Bit
BitVector.and## ((Integer, Integer) -> Bit
toBit (Integer, Integer)
i) ((Integer, Integer) -> Bit
toBit (Integer, Integer)
j)
       in Term -> Maybe Machine
reduce (Type -> Integer -> Integer -> Term
mkBitLit Type
ty (Word -> Integer
forall a. Integral a => a -> Integer
toInteger Word
msk) (Word -> Integer
forall a. Integral a => a -> Integer
toInteger Word
val))
  Text
"Clash.Sized.Internal.BitVector.or##"
    | [(Integer, Integer)
i,(Integer, Integer)
j] <- [Value] -> [(Integer, Integer)]
bitLiterals [Value]
args
    -> let Bit Word
msk Word
val = Bit -> Bit -> Bit
BitVector.or## ((Integer, Integer) -> Bit
toBit (Integer, Integer)
i) ((Integer, Integer) -> Bit
toBit (Integer, Integer)
j)
       in Term -> Maybe Machine
reduce (Type -> Integer -> Integer -> Term
mkBitLit Type
ty (Word -> Integer
forall a. Integral a => a -> Integer
toInteger Word
msk) (Word -> Integer
forall a. Integral a => a -> Integer
toInteger Word
val))
  Text
"Clash.Sized.Internal.BitVector.xor##"
    | [(Integer, Integer)
i,(Integer, Integer)
j] <- [Value] -> [(Integer, Integer)]
bitLiterals [Value]
args
    -> let Bit Word
msk Word
val = Bit -> Bit -> Bit
BitVector.xor## ((Integer, Integer) -> Bit
toBit (Integer, Integer)
i) ((Integer, Integer) -> Bit
toBit (Integer, Integer)
j)
       in Term -> Maybe Machine
reduce (Type -> Integer -> Integer -> Term
mkBitLit Type
ty (Word -> Integer
forall a. Integral a => a -> Integer
toInteger Word
msk) (Word -> Integer
forall a. Integral a => a -> Integer
toInteger Word
val))

  Text
"Clash.Sized.Internal.BitVector.complement##"
    | [(Integer, Integer)
i] <- [Value] -> [(Integer, Integer)]
bitLiterals [Value]
args
    -> let Bit Word
msk Word
val = Bit -> Bit
BitVector.complement## ((Integer, Integer) -> Bit
toBit (Integer, Integer)
i)
       in Term -> Maybe Machine
reduce (Type -> Integer -> Integer -> Term
mkBitLit Type
ty (Word -> Integer
forall a. Integral a => a -> Integer
toInteger Word
msk) (Word -> Integer
forall a. Integral a => a -> Integer
toInteger Word
val))

-- Pack
  Text
"Clash.Sized.Internal.BitVector.pack#"
    | [(Integer
msk,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)

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

-- Concatenation
  Text
"Clash.Sized.Internal.BitVector.++#" -- :: KnownNat m => BitVector n -> BitVector m -> BitVector (n + m)
    | Just (Type
_,Integer
m) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , [(Integer
mski,Integer
i),(Integer
mskj,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
  Text
"Clash.Sized.Internal.BitVector.reduceAnd#" -- :: KnownNat n => BitVector n -> Bit
    | [(Integer, Integer)
i] <- [Value] -> [(Integer, Integer)]
bitVectorLiterals' [Value]
args
    , Just (Type
_, 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 Integer
0 Integer
val)
    where
      op :: KnownNat n => BitVector n -> Proxy n -> Integer
      op :: BitVector n -> Proxy n -> Integer
op BitVector n
u Proxy n
_ = 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)
  Text
"Clash.Sized.Internal.BitVector.reduceOr#" -- :: KnownNat n => BitVector n -> Bit
    | [(Integer, Integer)
i] <- [Value] -> [(Integer, Integer)]
bitVectorLiterals' [Value]
args
    , Just (Type
_, 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 Integer
0 Integer
val)
    where
      op :: KnownNat n => BitVector n -> Proxy n -> Integer
      op :: BitVector n -> Proxy n -> Integer
op BitVector n
u Proxy n
_ = 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)
  Text
"Clash.Sized.Internal.BitVector.reduceXor#" -- :: KnownNat n => BitVector n -> Bit
    | [(Integer, Integer)
i] <- [Value] -> [(Integer, Integer)]
bitVectorLiterals' [Value]
args
    , Just (Type
_, 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 Integer
0 Integer
val)
    where
      op :: KnownNat n => BitVector n -> Proxy n -> Integer
      op :: BitVector n -> Proxy n -> Integer
op BitVector n
u Proxy n
_ = 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
  Text
"Clash.Sized.Internal.BitVector.index#" -- :: KnownNat n => BitVector n -> Int -> Bit
    | Just (Type
_,Integer
kn,(Integer, Integer)
i,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
             (Integer
msk,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 BitVector n
u Int
i Proxy n
_ = (Word -> Integer
forall a. Integral a => a -> Integer
toInteger Word
m, Word -> Integer
forall a. Integral a => a -> Integer
toInteger Word
v)
          where Bit Word
m Word
v = (BitVector n -> Int -> Bit
forall (n :: Nat). KnownNat n => BitVector n -> Int -> Bit
BitVector.index# BitVector n
u Int
i)
  Text
"Clash.Sized.Internal.BitVector.replaceBit#" -- :: :: KnownNat n => BitVector n -> Int -> Bit -> BitVector n
    | Just (Type
_, Integer
n) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , [ Value
_
      , PrimVal PrimInfo
bvP [Type]
_ [Value
_, Lit (NaturalLiteral Integer
mskBv), Lit (IntegerLiteral Integer
bv)]
      , Value -> Maybe [Term]
valArgs -> Just [Literal (IntLiteral Integer
i)]
      , PrimVal PrimInfo
bP [Type]
_ [Lit (WordLiteral Integer
mskB), Lit (IntegerLiteral Integer
b)]
      ] <- [Value]
args
    , PrimInfo -> Text
primName PrimInfo
bvP Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Clash.Sized.Internal.BitVector.fromInteger#"
    , PrimInfo -> Text
primName PrimInfo
bP  Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Clash.Sized.Internal.BitVector.fromInteger##"
      -> let resTyInfo :: (Type, Type, Integer)
resTyInfo = TyConMap -> Type -> [Type] -> (Type, Type, Integer)
extractTySizeInfo TyConMap
tcm Type
ty [Type]
tys
             (Integer
mskVal,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 (Natural -> Natural -> BitVector n
forall (n :: Nat). Natural -> Natural -> BitVector n
BV (Integer -> Natural
forall a. Num a => Integer -> a
fromInteger Integer
mskBv) (Integer -> Natural
forall a. Num a => Integer -> a
fromInteger Integer
bv))
                                           (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i)
                                           (Word -> Word -> Bit
Bit (Integer -> Word
forall a. Num a => Integer -> a
fromInteger Integer
mskB) (Integer -> Word
forall a. Num a => Integer -> a
fromInteger 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 BitVector n
bv Int
i Bit
b Proxy n
_ = 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)
  Text
"Clash.Sized.Internal.BitVector.setSlice#"
  -- :: SNat (m+1+i) -> BitVector (m + 1 + i) -> SNat m -> SNat n -> BitVector (m + 1 - n) -> BitVector (m + 1 + i)
    | Type
mTy : Type
iTy : Type
nTy : [Type]
_ <- [Type]
tys
    , Right Integer
m <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
mTy)
    , Right Integer
iN <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
iTy)
    , Right Integer
n <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
nTy)
    , [(Integer, Integer)
i,(Integer, Integer)
j] <- [Value] -> [(Integer, Integer)]
bitVectorLiterals' [Value]
args
    -> let BV Natural
msk Natural
val = SNat ((Any + 1) + Any)
-> BitVector ((Any + 1) + Any)
-> SNat Any
-> SNat Any
-> BitVector ((Any + 1) - Any)
-> BitVector ((Any + 1) + Any)
forall (m :: Nat) (i :: Nat) (n :: Nat).
SNat ((m + 1) + i)
-> BitVector ((m + 1) + i)
-> SNat m
-> SNat n
-> BitVector ((m + 1) - n)
-> BitVector ((m + 1) + i)
BitVector.setSlice# (Integer -> SNat ((Any + 1) + Any)
forall (k :: Nat). Integer -> SNat k
unsafeSNat (Integer
mInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
iN)) ((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 (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
msk) (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
val))
  Text
"Clash.Sized.Internal.BitVector.slice#"
  -- :: BitVector (m + 1 + i) -> SNat m -> SNat n -> BitVector (m + 1 - n)
    | Type
mTy : Type
_ : Type
nTy : [Type]
_ <- [Type]
tys
    , Right Integer
m <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
mTy)
    , Right Integer
n <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
nTy)
    , [(Integer, Integer)
i] <- [Value] -> [(Integer, Integer)]
bitVectorLiterals' [Value]
args
    -> let BV Natural
msk Natural
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 (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
msk) (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
val))
  Text
"Clash.Sized.Internal.BitVector.split#" -- :: forall n m. KnownNat n => BitVector (m + n) -> (BitVector m, BitVector n)
    | Type
nTy : Type
mTy : [Type]
_ <- [Type]
tys
    , Right Integer
n <-  Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
nTy)
    , Right Integer
m <-  Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
mTy)
    , [(Integer
mski,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
           ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
tupTcNm [Type]
tyArgs) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty'
           (Just TyCon
tupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
tupTcNm TyConMap
tcm
           [DataCon
tupDc] = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
           Type
bvTy : [Type]
_ = [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
- Integer
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)])

  Text
"Clash.Sized.Internal.BitVector.msb#" -- :: forall n. KnownNat n => BitVector n -> Bit
    | [(Integer, Integer)
i] <- [Value] -> [(Integer, Integer)]
bitVectorLiterals' [Value]
args
    , Just (Type
_, 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
           (Word
msk,Word
val) = Integer
-> (forall (n :: Nat). KnownNat n => Proxy n -> (Word, Word))
-> (Word, Word)
forall r.
Integer -> (forall (n :: Nat). KnownNat n => Proxy n -> r) -> r
reifyNat Integer
kn (BitVector n -> Proxy n -> (Word, Word)
forall (n :: Nat).
KnownNat n =>
BitVector n -> Proxy n -> (Word, Word)
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 (Word -> Integer
forall a. Integral a => a -> Integer
toInteger Word
msk) (Word -> Integer
forall a. Integral a => a -> Integer
toInteger Word
val))
    where
      op :: KnownNat n => BitVector n -> Proxy n -> (Word,Word)
      op :: BitVector n -> Proxy n -> (Word, Word)
op BitVector n
u Proxy n
_ = (Bit -> Word
unsafeMask# Bit
res, Bit -> Word
BitVector.unsafeToInteger# Bit
res)
        where
          res :: Bit
res = BitVector n -> Bit
forall (n :: Nat). KnownNat n => BitVector n -> Bit
BitVector.msb# BitVector n
u
  Text
"Clash.Sized.Internal.BitVector.lsb#" -- :: BitVector n -> Bit
    | [(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 Word
msk Word
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 (Word -> Integer
forall a. Integral a => a -> Integer
toInteger Word
msk) (Word -> Integer
forall a. Integral a => a -> Integer
toInteger Word
val))


-- Eq
  -- eq#, neq# :: KnownNat n => BitVector n -> BitVector n -> Bool
  Text
"Clash.Sized.Internal.BitVector.eq#"
    | Type
nTy : [Type]
_ <- [Type]
tys
    , Right Integer
0 <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty Bool
True)
    | Just (Type
_, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just 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

  Text
"Clash.Sized.Internal.BitVector.neq#"
    | Type
nTy : [Type]
_ <- [Type]
tys
    , Right Integer
0 <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty Bool
False)
    | Just (Type
_, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just 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
  Text
"Clash.Sized.Internal.BitVector.lt#"
    | Type
nTy : [Type]
_ <- [Type]
tys
    , Right Integer
0 <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty Bool
False)
    | Just (Type
_, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just 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
  Text
"Clash.Sized.Internal.BitVector.ge#"
    | Type
nTy : [Type]
_ <- [Type]
tys
    , Right Integer
0 <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty Bool
True)
    | Just (Type
_, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just 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
  Text
"Clash.Sized.Internal.BitVector.gt#"
    | Type
nTy : [Type]
_ <- [Type]
tys
    , Right Integer
0 <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty Bool
False)
    | Just (Type
_, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just 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
  Text
"Clash.Sized.Internal.BitVector.le#"
    | Type
nTy : [Type]
_ <- [Type]
tys
    , Right Integer
0 <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> Term -> Maybe Machine
reduce (TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty Bool
True)
    | Just (Type
_, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just 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

-- Enum

  Text
"Clash.Sized.Internal.BitVector.toEnum#"
    | let resTyInfo :: (Type, Type, Integer)
resTyInfo@(Type
_,Type
_,Integer
kn) = TyConMap -> Type -> [Type] -> (Type, Type, Integer)
extractTySizeInfo TyConMap
tcm Type
ty [Type]
tys
    , Just 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 ((Integer -> BitVector n)
-> (Type, Type, Integer) -> [Value] -> Proxy n -> Maybe Term
forall (n :: Nat).
KnownNat n =>
(Integer -> BitVector n)
-> (Type, Type, Integer) -> [Value] -> Proxy n -> Maybe Term
liftInteger2BitVector (Int -> BitVector n
forall (n :: Nat). KnownNat n => Int -> BitVector n
BitVector.toEnum# (Int -> BitVector n) -> (Integer -> Int) -> Integer -> BitVector n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a. Num a => Integer -> a
fromInteger) (Type, Type, Integer)
resTyInfo [Value]
args)
    -> Term -> Maybe Machine
reduce Term
val

  Text
"Clash.Sized.Internal.BitVector.fromEnum#"
    | Just (Type
_, 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
    , Just 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 (TyConMap
-> Type
-> (BitVector n -> Integer)
-> [Value]
-> Proxy n
-> Maybe Term
forall (n :: Nat).
KnownNat n =>
TyConMap
-> Type
-> (BitVector n -> Integer)
-> [Value]
-> Proxy n
-> Maybe Term
liftBitVector2CInt TyConMap
tcm Type
resTy (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> (BitVector n -> Int) -> BitVector n -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BitVector n -> Int
forall (n :: Nat). KnownNat n => BitVector n -> Int
BitVector.fromEnum#) [Value]
args)
    -> Term -> Maybe Machine
reduce Term
val

-- Bounded
  Text
"Clash.Sized.Internal.BitVector.minBound#"
    | Just (Type
nTy,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 Integer
0 Integer
0)
  Text
"Clash.Sized.Internal.BitVector.maxBound#"
    | Just (Type
litTy,Integer
mb) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    -> let maxB :: Integer
maxB = (Integer
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
- Integer
1
       in  Term -> Maybe Machine
reduce (Type -> Type -> Integer -> Integer -> Integer -> Term
mkBitVectorLit Type
ty Type
litTy Integer
mb Integer
0 Integer
maxB)

-- Num
  Text
"Clash.Sized.Internal.BitVector.+#"
    | Just (Type
_, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just 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
  Text
"Clash.Sized.Internal.BitVector.-#"
    | Just (Type
_, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just 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
  Text
"Clash.Sized.Internal.BitVector.*#"
    | Just (Type
_, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just 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
  Text
"Clash.Sized.Internal.BitVector.negate#"
    | Just (Type
nTy, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , [(Integer, Integer)
i] <- [Value] -> [(Integer, Integer)]
bitVectorLiterals' [Value]
args
    -> let (Integer
msk,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 BitVector n
u Proxy n
_ = 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
  Text
"Clash.Sized.Internal.BitVector.plus#" -- :: (KnownNat n, KnownNat m) => BitVector m -> BitVector n -> BitVector (Max m n + 1)
    | [(Integer
0,Integer
i),(Integer
0,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
           ([Either TyVar Type]
_,Type
resTy) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty'
           (TyConApp TyConName
_ [Type
resSizeTy]) = Type -> TypeView
tyView Type
resTy
           Right Integer
resSizeInt = Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
resSizeTy)
       in  Term -> Maybe Machine
reduce (Type -> Type -> Integer -> Integer -> Integer -> Term
mkBitVectorLit Type
resTy Type
resSizeTy Integer
resSizeInt Integer
0 (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
j))

  Text
"Clash.Sized.Internal.BitVector.minus#"
    | [(Integer
0,Integer
i),(Integer
0,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
           ([Either TyVar Type]
_,Type
resTy) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty'
           (TyConApp TyConName
_ [Type
resSizeTy]) = Type -> TypeView
tyView Type
resTy
           Right Integer
resSizeInt = Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String 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 Integer
0 Integer
val)

  Text
"Clash.Sized.Internal.BitVector.times#"
    | [(Integer
0,Integer
i),(Integer
0,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
           ([Either TyVar Type]
_,Type
resTy) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty'
           (TyConApp TyConName
_ [Type
resSizeTy]) = Type -> TypeView
tyView Type
resTy
           Right Integer
resSizeInt = Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
resSizeTy)
       in  Term -> Maybe Machine
reduce (Type -> Type -> Integer -> Integer -> Integer -> Term
mkBitVectorLit Type
resTy Type
resSizeTy Integer
resSizeInt Integer
0 (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
j))

-- Integral
  Text
"Clash.Sized.Internal.BitVector.quot#"
    | Just (Type
_, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just 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
  Text
"Clash.Sized.Internal.BitVector.rem#"
    | Just (Type
_, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just 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
  Text
"Clash.Sized.Internal.BitVector.toInteger#"
    | Just (Type
_, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , [(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 BitVector n
u Proxy n
_ = BitVector n -> Integer
forall (n :: Nat). KnownNat n => BitVector n -> Integer
BitVector.toInteger# BitVector n
u

-- Bits
  Text
"Clash.Sized.Internal.BitVector.and#"
    | Just (Type
_, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just 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.and#) Type
ty TyConMap
tcm [Type]
tys [Value]
args)
    -> Term -> Maybe Machine
reduce Term
val
  Text
"Clash.Sized.Internal.BitVector.or#"
    | Just (Type
_, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just 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.or#) Type
ty TyConMap
tcm [Type]
tys [Value]
args)
    -> Term -> Maybe Machine
reduce Term
val
  Text
"Clash.Sized.Internal.BitVector.xor#"
    | Just (Type
_, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just 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.xor#) Type
ty TyConMap
tcm [Type]
tys [Value]
args)
    -> Term -> Maybe Machine
reduce Term
val

  Text
"Clash.Sized.Internal.BitVector.complement#"
    | [(Integer, Integer)
i] <- [Value] -> [(Integer, Integer)]
bitVectorLiterals' [Value]
args
    , Just (Type
nTy, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    -> let (Integer
msk,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 BitVector n
u Proxy n
_ = 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

  Text
"Clash.Sized.Internal.BitVector.shiftL#"
    | Just (Type
nTy,Integer
kn,(Integer, Integer)
i,Integer
j) <- TyConMap
-> [Type]
-> [Value]
-> Maybe (Type, Integer, (Integer, Integer), Integer)
bitVectorLitIntLit TyConMap
tcm [Type]
tys [Value]
args
      -> let (Integer
msk,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 BitVector n
u Int
i Proxy n
_ = 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)
  Text
"Clash.Sized.Internal.BitVector.shiftR#"
    | Just (Type
nTy,Integer
kn,(Integer, Integer)
i,Integer
j) <- TyConMap
-> [Type]
-> [Value]
-> Maybe (Type, Integer, (Integer, Integer), Integer)
bitVectorLitIntLit TyConMap
tcm [Type]
tys [Value]
args
      -> let (Integer
msk,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 BitVector n
u Int
i Proxy n
_ = 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)
  Text
"Clash.Sized.Internal.BitVector.rotateL#"
    | Just (Type
nTy,Integer
kn,(Integer, Integer)
i,Integer
j) <- TyConMap
-> [Type]
-> [Value]
-> Maybe (Type, Integer, (Integer, Integer), Integer)
bitVectorLitIntLit TyConMap
tcm [Type]
tys [Value]
args
      -> let (Integer
msk,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 BitVector n
u Int
i Proxy n
_ = 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)
  Text
"Clash.Sized.Internal.BitVector.rotateR#"
    | Just (Type
nTy,Integer
kn,(Integer, Integer)
i,Integer
j) <- TyConMap
-> [Type]
-> [Value]
-> Maybe (Type, Integer, (Integer, Integer), Integer)
bitVectorLitIntLit TyConMap
tcm [Type]
tys [Value]
args
      -> let (Integer
msk,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 BitVector n
u Int
i Proxy n
_ = 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
  Text
"Clash.Sized.Internal.BitVector.truncateB#" -- forall a b . KnownNat a => BitVector (a + b) -> BitVector a
    | Type
aTy  : [Type]
_ <- [Type]
tys
    , Right Integer
ka <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
aTy)
    , [(Integer
mski,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
- Integer
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
  Text
"Clash.Sized.Internal.Index.pack#"
    | Type
nTy : [Type]
_ <- [Type]
tys
    , Right Integer
_ <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
nTy)
    , [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 Integer
0 Integer
i)
  Text
"Clash.Sized.Internal.Index.unpack#"
    | Just (Type
nTy,Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , [(Integer
0,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
  Text
"Clash.Sized.Internal.Index.eq#" | Just (Integer
i,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))
  Text
"Clash.Sized.Internal.Index.neq#" | Just (Integer
i,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
  Text
"Clash.Sized.Internal.Index.lt#"
    | Just (Integer
i,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))
  Text
"Clash.Sized.Internal.Index.ge#"
    | Just (Integer
i,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))
  Text
"Clash.Sized.Internal.Index.gt#"
    | Just (Integer
i,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))
  Text
"Clash.Sized.Internal.Index.le#"
    | Just (Integer
i,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))

-- Enum
  Text
"Clash.Sized.Internal.Index.toEnum#"
    | [Integer
i] <- [Value] -> [Integer]
intCLiterals' [Value]
args
    , Just (Type
nTy, 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
i)

  Text
"Clash.Sized.Internal.Index.fromEnum#"
    | [Integer
i] <- [Value] -> [Integer]
indexLiterals' [Value]
args
    -> let resTy :: Type
resTy = TyConMap -> Type -> [Type] -> Type
getResultTy TyConMap
tcm Type
ty [Type]
tys
        in Term -> Maybe Machine
reduce (TyConMap -> Integer -> Type -> Term
mkIntCLit TyConMap
tcm Integer
i Type
resTy)

-- Bounded
  Text
"Clash.Sized.Internal.Index.maxBound#"
    | Just (Type
nTy,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
- Integer
1))

-- Num
  Text
"Clash.Sized.Internal.Index.+#"
    | Just (Type
nTy,Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , [Integer
i,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))
  Text
"Clash.Sized.Internal.Index.-#"
    | Just (Type
nTy,Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , [Integer
i,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))
  Text
"Clash.Sized.Internal.Index.*#"
    | Just (Type
nTy,Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , [Integer
i,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
  Text
"Clash.Sized.Internal.Index.plus#"
    | Type
mTy : Type
nTy : [Type]
_ <- [Type]
tys
    , Right Integer
_ <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
mTy)
    , Right Integer
_ <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
nTy)
    , Just (Integer
i,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))
  Text
"Clash.Sized.Internal.Index.minus#"
    | Type
mTy : Type
nTy : [Type]
_ <- [Type]
tys
    , Right Integer
_ <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
mTy)
    , Right Integer
_ <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
nTy)
    , Just (Integer
i,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))
  Text
"Clash.Sized.Internal.Index.times#"
    | Type
mTy : Type
nTy : [Type]
_ <- [Type]
tys
    , Right Integer
_ <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
mTy)
    , Right Integer
_ <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
nTy)
    , Just (Integer
i,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
  Text
"Clash.Sized.Internal.Index.quot#"
    | Just (Type
nTy,Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just (Integer
i,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))
  Text
"Clash.Sized.Internal.Index.rem#"
    | Just (Type
nTy,Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just (Integer
i,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))
  Text
"Clash.Sized.Internal.Index.toInteger#"
    | [PrimVal PrimInfo
p [Type]
_ [Value
_, Lit (IntegerLiteral Integer
i)]] <- [Value]
args
    , PrimInfo -> Text
primName PrimInfo
p Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Clash.Sized.Internal.Index.fromInteger#"
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToIntegerLiteral Integer
i)

-- Resize
  Text
"Clash.Sized.Internal.Index.resize#"
    | Just (Type
mTy,Integer
m) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , [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
---------
  Text
"Clash.Sized.Internal.Signed.size#"
    | Just (Type
_, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    -> let ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
intTcNm [Type]
_) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just TyCon
intTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
intTcNm TyConMap
tcm
           [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
  Text
"Clash.Sized.Internal.Signed.pack#"
    | Just (Type
nTy, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , [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 Integer
0 Integer
val)
    where
        op :: KnownNat n => Signed n -> Proxy n -> Integer
        op :: Signed n -> Proxy n -> Integer
op Signed n
s Proxy n
_ = 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)
  Text
"Clash.Sized.Internal.Signed.unpack#"
    | Just (Type
nTy, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , [(Integer
0,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 BitVector n
s Proxy n
_ = 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
  Text
"Clash.Sized.Internal.Signed.eq#" | Just (Integer
i,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))
  Text
"Clash.Sized.Internal.Signed.neq#" | Just (Integer
i,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
  Text
"Clash.Sized.Internal.Signed.lt#" | Just (Integer
i,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))
  Text
"Clash.Sized.Internal.Signed.ge#" | Just (Integer
i,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))
  Text
"Clash.Sized.Internal.Signed.gt#" | Just (Integer
i,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))
  Text
"Clash.Sized.Internal.Signed.le#" | Just (Integer
i,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))

-- Enum
  Text
"Clash.Sized.Internal.Signed.toEnum#"
    | [Integer
i] <- [Value] -> [Integer]
intCLiterals' [Value]
args
    , Just (Type
litTy, Integer
mb) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    -> Term -> Maybe Machine
reduce (Type -> Type -> Integer -> Integer -> Term
mkSignedLit Type
ty Type
litTy Integer
mb Integer
i)

  Text
"Clash.Sized.Internal.Signed.fromEnum#"
    | [Integer
i] <- [Value] -> [Integer]
signedLiterals' [Value]
args
    -> let resTy :: Type
resTy = TyConMap -> Type -> [Type] -> Type
getResultTy TyConMap
tcm Type
ty [Type]
tys
        in Term -> Maybe Machine
reduce (TyConMap -> Integer -> Type -> Term
mkIntCLit TyConMap
tcm Integer
i Type
resTy)

-- Bounded
  Text
"Clash.Sized.Internal.Signed.minBound#"
    | Just (Type
litTy,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 (Integer
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
- Integer
1))
       in  Term -> Maybe Machine
reduce (Type -> Type -> Integer -> Integer -> Term
mkSignedLit Type
ty Type
litTy Integer
mb Integer
minB)
  Text
"Clash.Sized.Internal.Signed.maxBound#"
    | Just (Type
litTy,Integer
mb) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    -> let maxB :: Integer
maxB = (Integer
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
- Integer
1)) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1
       in Term -> Maybe Machine
reduce (Type -> Type -> Integer -> Integer -> Term
mkSignedLit Type
ty Type
litTy Integer
mb Integer
maxB)

-- Num
  Text
"Clash.Sized.Internal.Signed.+#"
    | Just (Type
_, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just 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)
  Text
"Clash.Sized.Internal.Signed.-#"
    | Just (Type
_, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just 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)
  Text
"Clash.Sized.Internal.Signed.*#"
    | Just (Type
_, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just 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)
  Text
"Clash.Sized.Internal.Signed.negate#"
    | Just (Type
nTy, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , [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 Signed n
s Proxy n
_ = 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)
  Text
"Clash.Sized.Internal.Signed.abs#"
    | Just (Type
nTy, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , [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 Signed n
s Proxy n
_ = 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
  Text
"Clash.Sized.Internal.Signed.plus#"
    | Just (Integer
i,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
           ([Either TyVar Type]
_,Type
resTy) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty'
           (TyConApp TyConName
_ [Type
resSizeTy]) = Type -> TypeView
tyView Type
resTy
           Right Integer
resSizeInt = Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String 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))

  Text
"Clash.Sized.Internal.Signed.minus#"
    | Just (Integer
i,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
           ([Either TyVar Type]
_,Type
resTy) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty'
           (TyConApp TyConName
_ [Type
resSizeTy]) = Type -> TypeView
tyView Type
resTy
           Right Integer
resSizeInt = Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String 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))

  Text
"Clash.Sized.Internal.Signed.times#"
    | Just (Integer
i,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
           ([Either TyVar Type]
_,Type
resTy) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty'
           (TyConApp TyConName
_ [Type
resSizeTy]) = Type -> TypeView
tyView Type
resTy
           Right Integer
resSizeInt = Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String 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
  Text
"Clash.Sized.Internal.Signed.quot#"
    | Just (Type
_, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just 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.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
  Text
"Clash.Sized.Internal.Signed.rem#"
    | Just (Type
_, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just 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
  Text
"Clash.Sized.Internal.Signed.div#"
    | Just (Type
_, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just 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.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
  Text
"Clash.Sized.Internal.Signed.mod#"
    | Just (Type
_, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just 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
  Text
"Clash.Sized.Internal.Signed.toInteger#"
    | [PrimVal PrimInfo
p [Type]
_ [Value
_, Lit (IntegerLiteral Integer
i)]] <- [Value]
args
    , PrimInfo -> Text
primName PrimInfo
p Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Clash.Sized.Internal.Signed.fromInteger#"
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToIntegerLiteral Integer
i)

-- Bits
  Text
"Clash.Sized.Internal.Signed.and#"
    | [Integer
i,Integer
j] <- [Value] -> [Integer]
signedLiterals' [Value]
args
    , Just (Type
nTy, 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))
  Text
"Clash.Sized.Internal.Signed.or#"
    | [Integer
i,Integer
j] <- [Value] -> [Integer]
signedLiterals' [Value]
args
    , Just (Type
nTy, 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))
  Text
"Clash.Sized.Internal.Signed.xor#"
    | [Integer
i,Integer
j] <- [Value] -> [Integer]
signedLiterals' [Value]
args
    , Just (Type
nTy, 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))

  Text
"Clash.Sized.Internal.Signed.complement#"
    | [Integer
i] <- [Value] -> [Integer]
signedLiterals' [Value]
args
    , Just (Type
nTy, 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 Signed n
u Proxy n
_ = 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)

  Text
"Clash.Sized.Internal.Signed.shiftL#"
    | Just (Type
nTy,Integer
kn,Integer
i,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 Signed n
u Int
i Proxy n
_ = 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)
  Text
"Clash.Sized.Internal.Signed.shiftR#"
    | Just (Type
nTy,Integer
kn,Integer
i,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 Signed n
u Int
i Proxy n
_ = 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)
  Text
"Clash.Sized.Internal.Signed.rotateL#"
    | Just (Type
nTy,Integer
kn,Integer
i,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 Signed n
u Int
i Proxy n
_ = 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)
  Text
"Clash.Sized.Internal.Signed.rotateR#"
    | Just (Type
nTy,Integer
kn,Integer
i,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 Signed n
u Int
i Proxy n
_ = 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
  Text
"Clash.Sized.Internal.Signed.resize#" -- forall m n. (KnownNat n, KnownNat m) => Signed n -> Signed m
    | Type
mTy : Type
nTy : [Type]
_ <- [Type]
tys
    , Right Integer
mInt <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
mTy)
    , Right Integer
nInt <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
nTy)
    , [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      = Integer
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
- Integer
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
- Int
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)
  Text
"Clash.Sized.Internal.Signed.truncateB#" -- KnownNat m => Signed (m + n) -> Signed m
    | Just (Type
mTy, Integer
km) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , [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
- Integer
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
-----------
  Text
"Clash.Sized.Internal.Unsigned.size#"
    | Just (Type
_, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    -> let ([Either TyVar Type]
_,Type
ty') = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (TyConApp TyConName
intTcNm [Type]
_) = Type -> TypeView
tyView Type
ty'
           (Just TyCon
intTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
intTcNm TyConMap
tcm
           [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
  Text
"Clash.Sized.Internal.Unsigned.pack#"
    | Just (Type
nTy, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , [Integer
i] <- [Value] -> [Integer]
unsignedLiterals' [Value]
args
    -> Term -> Maybe Machine
reduce (Type -> Type -> Integer -> Integer -> Integer -> Term
mkBitVectorLit Type
ty Type
nTy Integer
kn Integer
0 Integer
i)
  Text
"Clash.Sized.Internal.Unsigned.unpack#"
    | Just (Type
nTy, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , [(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 BitVector n
u Proxy n
_ = 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
  Text
"Clash.Sized.Internal.Unsigned.eq#" | Just (Integer
i,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))
  Text
"Clash.Sized.Internal.Unsigned.neq#" | Just (Integer
i,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
  Text
"Clash.Sized.Internal.Unsigned.lt#" | Just (Integer
i,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))
  Text
"Clash.Sized.Internal.Unsigned.ge#" | Just (Integer
i,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))
  Text
"Clash.Sized.Internal.Unsigned.gt#" | Just (Integer
i,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))
  Text
"Clash.Sized.Internal.Unsigned.le#" | Just (Integer
i,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))

-- Enum
  Text
"Clash.Sized.Internal.Unsigned.toEnum#"
    | [Integer
i] <- [Value] -> [Integer]
intCLiterals' [Value]
args
    , Just (Type
litTy, Integer
mb) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    -> Term -> Maybe Machine
reduce (Type -> Type -> Integer -> Integer -> Term
mkUnsignedLit Type
ty Type
litTy Integer
mb Integer
i)

  Text
"Clash.Sized.Internal.Unsigned.fromEnum#"
    | [Integer
i] <- [Value] -> [Integer]
unsignedLiterals' [Value]
args
    -> let resTy :: Type
resTy = TyConMap -> Type -> [Type] -> Type
getResultTy TyConMap
tcm Type
ty [Type]
tys
        in Term -> Maybe Machine
reduce (TyConMap -> Integer -> Type -> Term
mkIntCLit TyConMap
tcm Integer
i Type
resTy)

-- Bounded
  Text
"Clash.Sized.Internal.Unsigned.minBound#"
    | Just (Type
nTy,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 Integer
0)
  Text
"Clash.Sized.Internal.Unsigned.maxBound#"
    | Just (Type
litTy,Integer
mb) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    -> let maxB :: Integer
maxB = (Integer
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
- Integer
1
       in  Term -> Maybe Machine
reduce (Type -> Type -> Integer -> Integer -> Term
mkUnsignedLit Type
ty Type
litTy Integer
mb Integer
maxB)

-- Num
  Text
"Clash.Sized.Internal.Unsigned.+#"
    | Just (Type
_, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just 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
  Text
"Clash.Sized.Internal.Unsigned.-#"
    | Just (Type
_, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just 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
  Text
"Clash.Sized.Internal.Unsigned.*#"
    | Just (Type
_, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just 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
  Text
"Clash.Sized.Internal.Unsigned.negate#"
    | Just (Type
nTy, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , [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 Unsigned n
u Proxy n
_ = 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
  Text
"Clash.Sized.Internal.Unsigned.plus#" -- :: Unsigned m -> Unsigned n -> Unsigned (Max m n + 1)
    | Just (Integer
i,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
           ([Either TyVar Type]
_,Type
resTy) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty'
           (TyConApp TyConName
_ [Type
resSizeTy]) = Type -> TypeView
tyView Type
resTy
           Right Integer
resSizeInt = Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String 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))

  Text
"Clash.Sized.Internal.Unsigned.minus#"
    | [Integer
i,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
           ([Either TyVar Type]
_,Type
resTy) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty'
           (TyConApp TyConName
_ [Type
resSizeTy]) = Type -> TypeView
tyView Type
resTy
           Right Integer
resSizeInt = Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String 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)

  Text
"Clash.Sized.Internal.Unsigned.times#"
    | Just (Integer
i,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
           ([Either TyVar Type]
_,Type
resTy) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty'
           (TyConApp TyConName
_ [Type
resSizeTy]) = Type -> TypeView
tyView Type
resTy
           Right Integer
resSizeInt = Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String 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
  Text
"Clash.Sized.Internal.Unsigned.quot#"
    | Just (Type
_, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just 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
  Text
"Clash.Sized.Internal.Unsigned.rem#"
    | Just (Type
_, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
    , Just 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
  Text
"Clash.Sized.Internal.Unsigned.toInteger#"
    | [PrimVal PrimInfo
p [Type]
_ [Value
_, Lit (IntegerLiteral Integer
i)]] <- [Value]
args
    , PrimInfo -> Text
primName PrimInfo
p Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Clash.Sized.Internal.Unsigned.fromInteger#"
    -> Term -> Maybe Machine
reduce (Integer -> Term
integerToIntegerLiteral Integer
i)

-- Bits
  Text
"Clash.Sized.Internal.Unsigned.and#"
    | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
unsignedLiterals [Value]
args
    , Just (Type
nTy, 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))
  Text
"Clash.Sized.Internal.Unsigned.or#"
    | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
unsignedLiterals [Value]
args
    , Just (Type
nTy, 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))
  Text
"Clash.Sized.Internal.Unsigned.xor#"
    | Just (Integer
i,Integer
j) <- [Value] -> Maybe (Integer, Integer)
unsignedLiterals [Value]
args
    , Just (Type
nTy, 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))

  Text
"Clash.Sized.Internal.Unsigned.complement#"
    | [Integer
i] <- [Value] -> [Integer]
unsignedLiterals' [Value]
args
    , Just (Type
nTy, 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 Unsigned n
u Proxy n
_ = 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)

  Text
"Clash.Sized.Internal.Unsigned.shiftL#" -- :: forall n. KnownNat n => Unsigned n -> Int -> Unsigned n
    | Just (Type
nTy,Integer
kn,Integer
i,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 Unsigned n
u Int
i Proxy n
_ = 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)
  Text
"Clash.Sized.Internal.Unsigned.shiftR#" -- :: forall n. KnownNat n => Unsigned n -> Int -> Unsigned n
    | Just (Type
nTy,Integer
kn,Integer
i,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 Unsigned n
u Int
i Proxy n
_ = 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)
  Text
"Clash.Sized.Internal.Unsigned.rotateL#" -- :: forall n. KnownNat n => Unsigned n -> Int -> Unsigned n
    | Just (Type
nTy,Integer
kn,Integer
i,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 Unsigned n
u Int
i Proxy n
_ = 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)
  Text
"Clash.Sized.Internal.Unsigned.rotateR#" -- :: forall n. KnownNat n => Unsigned n -> Int -> Unsigned n
    | Just (Type
nTy,Integer
kn,Integer
i,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 Unsigned n
u Int
i Proxy n
_ = 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
  Text
"Clash.Sized.Internal.Unsigned.resize#" -- forall n m . KnownNat m => Unsigned n -> Unsigned m
    | Type
_ : Type
mTy : [Type]
_ <- [Type]
tys
    , Right Integer
km <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
mTy)
    , [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
- Integer
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)

-- Conversions
  Text
"Clash.Sized.Internal.Unsigned.unsignedToWord"
    | Bool
isSubj
    , [Integer
a] <- [Value] -> [Integer]
unsignedLiterals' [Value]
args
    -> let b :: Word
b = Unsigned 64 -> Word
Unsigned.unsignedToWord (Natural -> Unsigned 64
forall (n :: Nat). Natural -> Unsigned n
U (Integer -> Natural
forall a. Num a => Integer -> a
fromInteger Integer
a))
           ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
wordTcNm []) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just TyCon
wordTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
wordTcNm TyConMap
tcm
           [DataCon
wordDc] = TyCon -> [DataCon]
tyConDataCons TyCon
wordTc
       in  Term -> Maybe Machine
reduce (Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
wordDc) [Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
WordLiteral (Word -> Integer
forall a. Integral a => a -> Integer
toInteger Word
b)))])

  Text
"Clash.Sized.Internal.Unsigned.unsigned8toWord8"
    | Bool
isSubj
    , [Integer
a] <- [Value] -> [Integer]
unsignedLiterals' [Value]
args
    -> let b :: Word8
b = Unsigned 8 -> Word8
Unsigned.unsigned8toWord8 (Natural -> Unsigned 8
forall (n :: Nat). Natural -> Unsigned n
U (Integer -> Natural
forall a. Num a => Integer -> a
fromInteger Integer
a))
           ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
wordTcNm []) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just TyCon
wordTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
wordTcNm TyConMap
tcm
           [DataCon
wordDc] = TyCon -> [DataCon]
tyConDataCons TyCon
wordTc
       in  Term -> Maybe Machine
reduce (Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
wordDc) [Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
WordLiteral (Word8 -> Integer
forall a. Integral a => a -> Integer
toInteger Word8
b)))])

  Text
"Clash.Sized.Internal.Unsigned.unsigned16toWord16"
    | Bool
isSubj
    , [Integer
a] <- [Value] -> [Integer]
unsignedLiterals' [Value]
args
    -> let b :: Word16
b = Unsigned 16 -> Word16
Unsigned.unsigned16toWord16 (Natural -> Unsigned 16
forall (n :: Nat). Natural -> Unsigned n
U (Integer -> Natural
forall a. Num a => Integer -> a
fromInteger Integer
a))
           ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
wordTcNm []) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just TyCon
wordTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
wordTcNm TyConMap
tcm
           [DataCon
wordDc] = TyCon -> [DataCon]
tyConDataCons TyCon
wordTc
       in  Term -> Maybe Machine
reduce (Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
wordDc) [Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
WordLiteral (Word16 -> Integer
forall a. Integral a => a -> Integer
toInteger Word16
b)))])

  Text
"Clash.Sized.Internal.Unsigned.unsigned32toWord32"
    | Bool
isSubj
    , [Integer
a] <- [Value] -> [Integer]
unsignedLiterals' [Value]
args
    -> let b :: Word32
b = Unsigned 32 -> Word32
Unsigned.unsigned32toWord32 (Natural -> Unsigned 32
forall (n :: Nat). Natural -> Unsigned n
U (Integer -> Natural
forall a. Num a => Integer -> a
fromInteger Integer
a))
           ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
wordTcNm []) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just TyCon
wordTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
wordTcNm TyConMap
tcm
           [DataCon
wordDc] = TyCon -> [DataCon]
tyConDataCons TyCon
wordTc
       in  Term -> Maybe Machine
reduce (Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
wordDc) [Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
WordLiteral (Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger Word32
b)))])

  Text
"Clash.Annotations.BitRepresentation.Deriving.dontApplyInHDL"
    | Bool
isSubj
    , Value
f : Value
a : [Value]
_ <- [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
--------
  Text
"Clash.Sized.RTree.textract"
    | Bool
isSubj
    , [DC DataCon
_ [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
!! Int
1)

  Text
"Clash.Sized.RTree.tsplit"
    | Bool
isSubj
    , Type
dTy : Type
aTy : [Type]
_ <- [Type]
tys
    , [DC DataCon
_ [Either Term Type]
tArgs] <- [Value]
args
    , ([Either TyVar Type]
tyArgs,Type -> TypeView
tyView -> TyConApp TyConName
tupTcNm [Type]
_) <- Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
    , TyConApp TyConName
treeTcNm [Type]
_ <- 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
!! Int
0)
    -> let (Just TyCon
tupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
tupTcNm TyConMap
tcm
           [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
!! Int
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
!! Int
2)
                  ]

  Text
"Clash.Sized.RTree.tdfold"
    | Bool
isSubj
    , Type
pTy : Type
kTy : Type
aTy : [Type]
_ <- [Type]
tys
    , Value
_ : Value
p : Value
f : Value
g : Value
ts : [Value]
_ <- [Value]
args
    , DC DataCon
_ [Either Term Type]
tArgs <- Value
ts
    , Right Integer
k' <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
kTy)
    -> case Integer
k' of
         Integer
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
!! Int
1)])
         Integer
_ -> let k'ty :: Type
k'ty = LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
k'Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1))
                  ([Either TyVar Type]
tyArgs,Type
_)  = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
                  ([Either TyVar Type]
tyArgs',Type
_) = 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
!! Int
3)
                  TyConApp TyConName
snatTcNm [Type]
_ = 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
!! Int
0)
                  Just TyCon
snatTc = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
snatTcNm TyConMap
tcm
                  [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
-Integer
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
-Integer
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
!! Int
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
-Integer
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
!! Int
2)
                                       ])
                         ]

  Text
"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
    , ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
treeTcNm [Type
lenTy,Type
argTy]) <- Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty'
    , Right Integer
len <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
lenTy)
    -> let (Just TyCon
treeTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
treeTcNm TyConMap
tcm
           [DataCon
lrCon,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 (Int
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
---------
  Text
"Clash.Sized.Vector.length" -- :: KnownNat n => Vec n a -> Int
    | Bool
isSubj
    , [Type
nTy, Type
_] <- [Type]
tys
    , Right Integer
n <-Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> let ([Either TyVar Type]
_, Type -> TypeView
tyView -> TyConApp TyConName
intTcNm [Type]
_) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just TyCon
intTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
intTcNm TyConMap
tcm
           [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)))])

  Text
"Clash.Sized.Vector.maxIndex"
    | Bool
isSubj
    , [Type
nTy, Type
_] <- [Type]
tys
    , Right Integer
n <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> let ([Either TyVar Type]
_, Type -> TypeView
tyView -> TyConApp TyConName
intTcNm [Type]
_) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           (Just TyCon
intTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
intTcNm TyConMap
tcm
           [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
- Integer
1))))])

-- Indexing
  Text
"Clash.Sized.Vector.index_int" -- :: KnownNat n => Vec n a -> Int
    | Type
nTy : Type
aTy : [Type]
_  <- [Type]
tys
    , Value
_ : Value
xs : Value
i : [Value]
_ <- [Value]
args
    , DC DataCon
intDc [Left (Literal (IntLiteral Integer
i'))] <- Value
i
    -> if Integer
i' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0
          then Maybe Machine
forall a. Maybe a
Nothing
          else case Value
xs of
                 DC DataCon
_ [Either Term Type]
vArgs  -> case Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
nTy) of
                    Right Integer
0  -> Maybe Machine
forall a. Maybe a
Nothing
                    Right Integer
n' ->
                      if Integer
i' Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
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
!! Int
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
-Integer
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
-Integer
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
!! Int
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
-Integer
1)))])
                                     ]
                    Either String Integer
_ -> Maybe Machine
forall a. Maybe a
Nothing
                 Value
_ -> Maybe Machine
forall a. Maybe a
Nothing
  Text
"Clash.Sized.Vector.head" -- :: Vec (n+1) a -> a
    | Bool
isSubj
    , [DC DataCon
_ [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
!! Int
1)
  Text
"Clash.Sized.Vector.last" -- :: Vec (n+1) a -> a
    | Bool
isSubj
    , [DC DataCon
_ [Either Term Type]
vArgs] <- [Value]
args
    , (Right Type
_ : Right Type
aTy : Right Type
nTy : [Either Term Type]
_) <- [Either Term Type]
vArgs
    , Right Integer
n <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> if Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
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
!! Int
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
-Integer
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
!! Int
2)
                                     ])
-- - Sub-vectors
  Text
"Clash.Sized.Vector.tail" -- :: Vec (n+1) a -> Vec n a
    | Bool
isSubj
    , [DC DataCon
_ [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
!! Int
2)
  Text
"Clash.Sized.Vector.init" -- :: Vec (n+1) a -> Vec n a
    | Bool
isSubj
    , [DC DataCon
consCon [Either Term Type]
vArgs] <- [Value]
args
    , (Right Type
_ : Right Type
aTy : Right Type
nTy : [Either Term Type]
_) <- [Either Term Type]
vArgs
    , Right Integer
n <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> if Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
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
!! Int
2)
          else Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
               HasCallStack => DataCon -> Type -> Integer -> Term -> Term -> Term
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
!! Int
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
-Integer
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
!! Int
2)])
  Text
"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
    , Type
iTy : Type
sTy : Type
nTy : Type
fTy : Type
aTy : [Type]
_ <- [Type]
tys
    , Value
eq : Value
f : Value
s : Value
n : Value
xs : [Value]
_ <- [Value]
args
    , Right Integer
n' <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
nTy)
    , Right Integer
f' <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
fTy)
    , Right Integer
i' <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
iTy)
    , Right Integer
s' <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
sTy)
    , DC DataCon
_ [Either Term Type]
vArgs <- Value
xs
    -> case Integer
n' of
         Integer
0 -> Term -> Maybe Machine
reduce (DataCon -> Type -> Term
mkVecNil DataCon
nilCon Type
aTy)
         Integer
_ -> case Integer
f' of
          Integer
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 Text
"fxs" Int
0
                   iNm :: Name a
iNm    = Text -> Int -> Name a
forall a. Text -> Int -> Name a
mkUnsafeSystemName Text
"ixs" Int
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
$
                   HasCallStack => DataCon -> Type -> Integer -> Term -> Term -> Term
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
!! Int
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
-Integer
1)))
                          ,Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy Integer
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 Integer
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
-Integer
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])
                          ]
          Integer
_ -> 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 Text
"fxs" Int
0
                   iNm :: Name a
iNm    = Text -> Int -> Name a
forall a. Text -> Int -> Name a
mkUnsafeSystemName Text
"ixs" Int
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 Integer
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 Integer
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
      ([Either TyVar Type]
tyArgs,Type -> TypeView
tyView -> TyConApp TyConName
vecTcNm [Type]
_) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
      Just TyCon
vecTc          = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
vecTcNm TyConMap
tcm
      [DataCon
nilCon,DataCon
consCon]    = TyCon -> [DataCon]
tyConDataCons TyCon
vecTc
      TyConApp TyConName
snatTcNm [Type]
_ = 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
!! Int
1)
      tupTcNm :: TyConName
tupTcNm            = TyCon -> TyConName
ghcTyconToTyConName (Boxity -> Int -> TyCon
tupleTyCon Boxity
Boxed Int
2)
      (Just TyCon
tupTc)       = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
tupTcNm TyConMap
tcm
      [DataCon
tupDc]            = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
-- - Splitting
  Text
"Clash.Sized.Vector.splitAt" -- :: SNat m -> Vec (m + n) a -> (Vec m a, Vec n a)
    | Bool
isSubj
    , (DC DataCon
snatDc (Right Type
mTy:[Either Term Type]
_)):[Value]
_ <- [Value]
args
    , Right Integer
m <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
mTy)
    -> let Type
_:Type
nTy:Type
aTy:[Type]
_ = [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
           ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
tupTcNm tyArgs :: [Type]
tyArgs@(Type
tyArg:[Type]
_)) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty1
           (Just TyCon
tupTc)       = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
tupTcNm TyConMap
tcm
           [DataCon
tupDc]            = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
           -- Get the vector data-constructors
           TyConApp TyConName
vecTcNm [Type]
_ = Type -> TypeView
tyView Type
tyArg
           Just TyCon
vecTc         = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
vecTcNm TyConMap
tcm
           [DataCon
nilCon,DataCon
consCon]   = TyCon -> [DataCon]
tyConDataCons TyCon
vecTc
           -- Recursive call to @splitAt@
           splitAtRec :: Term -> Term
splitAtRec 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
-Integer
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
-Integer
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
-Integer
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 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
-Integer
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 Text
"l" Int
0
           rNm :: Name a
rNm     = Text -> Int -> Name a
forall a. Text -> Int -> Name a
mkUnsafeSystemName Text
"r" Int
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)
         Integer
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
         Integer
m' | DC DataCon
_ [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 (HasCallStack => DataCon -> Type -> Integer -> Term -> Term -> Term
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
!! Int
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
!! Int
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
!! Int
2) Type
nVecTy [(Pat, Term)
rAlt])
                 ]
         -- v doesn't reduce to a data-constructor
         Integer
_  -> Maybe Machine
forall a. Maybe a
Nothing

  Text
"Clash.Sized.Vector.unconcat" -- :: KnownNat n => SNamt m -> Vec (n * m) a -> Vec n (Vec m a)
    | Bool
isSubj
    , Value
kn : Value
snat : Value
v : [Value]
_  <- [Value]
args
    , Type
nTy : Type
mTy : Type
aTy :[Type]
_ <- [Type]
tys
    , Lit (NaturalLiteral Integer
n) <- Value
kn
    -> let ( [Either TyVar Type] -> [Type]
forall a b. [Either a b] -> [b]
Either.rights -> [Type]
argTys, Type -> TypeView
tyView -> TyConApp TyConName
vecTcNm [Type]
_) =
              Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           Just TyCon
vecTc = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
vecTcNm TyConMap
tcm
           [DataCon
nilCon,DataCon
consCon]   = TyCon -> [DataCon]
tyConDataCons TyCon
vecTc
           tupTcNm :: TyConName
tupTcNm            = TyCon -> TyConName
ghcTyconToTyConName (Boxity -> Int -> TyCon
tupleTyCon Boxity
Boxed Int
2)
           (Just TyCon
tupTc)       = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
tupTcNm TyConMap
tcm
           [DataCon
tupDc]            = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
           TyConApp TyConName
snatTcNm [Type]
_ = Type -> TypeView
tyView ([Type]
argTys [Type] -> Int -> Type
forall a. [a] -> Int -> a
!! Int
1)
           n1mTy :: Type
n1mTy  = TyConName -> [Type] -> Type
mkTyConApp TyConName
typeNatMul
                        [TyConName -> [Type] -> Type
mkTyConApp TyConName
typeNatSub [Type
nTy,LitTy -> Type
LitTy (Integer -> LitTy
NumTy Integer
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 Text
"as" Int
0
           bsNm :: Name a
bsNm     = Text -> Int -> Name a
forall a. Text -> Int -> Name a
mkUnsafeSystemName Text
"bs" Int
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
         Integer
0 -> Term -> Maybe Machine
reduce (DataCon -> Type -> Term
mkVecNil DataCon
nilCon Type
mVecTy)
         Integer
_ -> Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
              HasCallStack => DataCon -> Type -> Integer -> Term -> Term -> Term
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
-Integer
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
-Integer
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
  Text
"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 ([Either TyVar Type]
_,Type
resTy) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty'
    , (TyConApp TyConName
vecTcNm [Type
lenTy,Type
argTy]) <- Type -> TypeView
tyView Type
resTy
    , Right Integer
len <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
lenTy)
    -> let (Just TyCon
vecTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
vecTcNm TyConMap
tcm
           [DataCon
nilCon,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
  Text
"Clash.Sized.Vector.++" -- :: Vec n a -> Vec m a -> Vec (n + m) a
    | Bool
isSubj
    , (DC DataCon
dc [Either Term Type]
vArgs):[Value]
_ <- [Value]
args
    , Right Type
nTy : Right Type
aTy : [Either Term Type]
_ <- [Either Term Type]
vArgs
    , Right Integer
n <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> case Integer
n of
         Integer
0  -> Term -> Maybe Machine
reduce (Value -> Term
valToTerm ([Value] -> Value
forall a. [a] -> a
last [Value]
args))
         Integer
n' | (Type
_ : Type
_ : Type
mTy : [Type]
_) <- [Type]
tys
            , Right Integer
m <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String 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
$
               HasCallStack => DataCon -> Type -> Integer -> Term -> Term -> Term
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
!! Int
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
-Integer
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
!! Int
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))
                                      ])
         Integer
_ -> Maybe Machine
forall a. Maybe a
Nothing
  Text
"Clash.Sized.Vector.concat" -- :: Vec n (Vec m a) -> Vec (n * m) a
    | Bool
isSubj
    , (Type
nTy : Type
mTy : Type
aTy : [Type]
_)  <- [Type]
tys
    , (Value
xs : [Value]
_)               <- [Value]
args
    , DC DataCon
dc [Either Term Type]
vArgs <- Value
xs
    , Right Integer
n <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> case Integer
n of
        Integer
0 -> Term -> Maybe Machine
reduce (DataCon -> Type -> Term
mkVecNil DataCon
dc Type
aTy)
        Integer
_ | Term
_ : Term
h' : Term
t : [Term]
_ <- [Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
Either.lefts  [Either Term Type]
vArgs
          , ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
vecTcNm [Type]
_) <- 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 Integer
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
-Integer
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
                      ]
                    ]
        Integer
_ -> Maybe Machine
forall a. Maybe a
Nothing

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

-- - specialized permutations
  Text
"Clash.Sized.Vector.reverse" -- :: Vec n a -> Vec n a
    | Bool
isSubj
    , Type
nTy : Type
aTy : [Type]
_  <- [Type]
tys
    , [DC DataCon
vecDc [Either Term Type]
vArgs] <- [Value]
args
    -> case Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
nTy) of
         Right Integer
0 -> Term -> Maybe Machine
reduce (DataCon -> Type -> Term
mkVecNil DataCon
vecDc Type
aTy)
         Right Integer
n
           | ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
vecTcNm [Type]
_) <- Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
           , let (Just TyCon
vecTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
vecTcNm TyConMap
tcm
           , let [DataCon
nilCon,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
-Integer
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 Integer
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
-Integer
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
!! Int
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 Integer
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
!! Int
1])
                ]
         Either String Integer
_ -> Maybe Machine
forall a. Maybe a
Nothing
  Text
"Clash.Sized.Vector.transpose" -- :: KnownNat n => Vec m (Vec n a) -> Vec n (Vec m a)
    | Bool
isSubj
    , Type
nTy : Type
mTy : Type
aTy : [Type]
_ <- [Type]
tys
    , Value
kn : Value
xss : [Value]
_ <- [Value]
args
    , ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
vecTcNm [Type]
_) <- Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
    , DC DataCon
_ [Either Term Type]
vArgs <- Value
xss
    , Right Integer
n <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
nTy)
    , Right Integer
m <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
mTy)
    -> case Integer
m of
      Integer
0 -> let (Just TyCon
vecTc)     = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
vecTcNm TyConMap
tcm
               [DataCon
nilCon,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 Integer
0 []))
      Integer
m' -> let (Just TyCon
vecTc)     = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
vecTcNm TyConMap
tcm
                [DataCon
_,DataCon
consCon] = TyCon -> [DataCon]
tyConDataCons TyCon
vecTc
                Just (Type
consCoTy : [Type]
_) = 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
-Integer
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
-Integer
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
-Integer
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
!! Int
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
-Integer
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
!! Int
2)
                                       ])
                       ]

  Text
"Clash.Sized.Vector.rotateLeftS" -- :: KnownNat n => Vec n a -> SNat d -> Vec n a
    | Type
nTy : Type
aTy : Type
_ : [Type]
_ <- [Type]
tys
    , Value
kn : Value
xs : Value
d : [Value]
_ <- [Value]
args
    , DC DataCon
dc [Either Term Type]
vArgs <- Value
xs
    , Right Integer
n <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> case Integer
n of
         Integer
0  -> Term -> Maybe Machine
reduce (DataCon -> Type -> Term
mkVecNil DataCon
dc Type
aTy)
         Integer
n' | DC DataCon
snatDc [Either Term Type
_,Left Term
d'] <- Value
d
            , Evaluator
eval <- Step -> Unwind -> PrimStep -> PrimUnwind -> Evaluator
Evaluator Step
ghcStep Unwind
ghcUnwind PrimStep
ghcPrimStep PrimUnwind
ghcPrimUnwind
            , mach2 :: Machine
mach2@Machine{mStack :: Machine -> Stack
mStack=[],mTerm :: Machine -> Term
mTerm=Literal (NaturalLiteral Integer
d2)} <- Evaluator -> TyConMap -> Bool -> Machine -> Machine
whnf Evaluator
eval 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
                 Integer
0  -> Term -> Maybe Machine
reduce (Value -> Term
valToTerm Value
xs)
                 Integer
d3 -> let ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
vecTcNm [Type]
_) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
                           (Just TyCon
vecTc)     = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
vecTcNm TyConMap
tcm
                           [DataCon
nilCon,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
-Integer
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
-Integer
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 Integer
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
!! Int
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 Integer
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
!! Int
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
-Integer
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
-Integer
1)))])
                                  ]
         Integer
_  -> Maybe Machine
forall a. Maybe a
Nothing

  Text
"Clash.Sized.Vector.rotateRightS" -- :: KnownNat n => Vec n a -> SNat d -> Vec n a
    | Bool
isSubj
    , Type
nTy : Type
aTy : Type
_ : [Type]
_ <- [Type]
tys
    , Value
kn : Value
xs : Value
d : [Value]
_ <- [Value]
args
    , DC DataCon
dc [Either Term Type]
_ <- Value
xs
    , Right Integer
n <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> case Integer
n of
         Integer
0  -> Term -> Maybe Machine
reduce (DataCon -> Type -> Term
mkVecNil DataCon
dc Type
aTy)
         Integer
n' | DC DataCon
snatDc [Either Term Type
_,Left Term
d'] <- Value
d
            , Evaluator
eval <- Step -> Unwind -> PrimStep -> PrimUnwind -> Evaluator
Evaluator Step
ghcStep Unwind
ghcUnwind PrimStep
ghcPrimStep PrimUnwind
ghcPrimUnwind
            , mach2 :: Machine
mach2@Machine{mStack :: Machine -> Stack
mStack=[],mTerm :: Machine -> Term
mTerm=Literal (NaturalLiteral Integer
d2)} <- Evaluator -> TyConMap -> Bool -> Machine -> Machine
whnf Evaluator
eval 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
                 Integer
0  -> Term -> Maybe Machine
reduce (Value -> Term
valToTerm Value
xs)
                 Integer
d3 -> let ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
vecTcNm [Type]
_) = 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
-Integer
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 (HasCallStack => DataCon -> Type -> Integer -> Term -> Term -> Term
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
-Integer
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
-Integer
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
-Integer
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
-Integer
1)))])
                                  ]
         Integer
_  -> Maybe Machine
forall a. Maybe a
Nothing
-- Element-wise operations
-- - mapping
  Text
"Clash.Sized.Vector.map" -- :: (a -> b) -> Vec n a -> Vec n b
    | Bool
isSubj
    , DC DataCon
dc [Either Term Type]
vArgs <- [Value]
args [Value] -> Int -> Value
forall a. [a] -> Int -> a
!! Int
1
    , Type
aTy : Type
bTy : Type
nTy : [Type]
_ <- [Type]
tys
    , Right Integer
n <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> case Integer
n of
         Integer
0  -> Term -> Maybe Machine
reduce (DataCon -> Type -> Term
mkVecNil DataCon
dc Type
bTy)
         Integer
n' -> Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
               HasCallStack => DataCon -> Type -> Integer -> Term -> Term -> Term
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
!! Int
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
!! Int
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
- Integer
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
!! Int
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
!! Int
2)])
  Text
"Clash.Sized.Vector.imap" -- :: forall n a b . KnownNat n => (Index n -> a -> b) -> Vec n a -> Vec n b
    | Bool
isSubj
    , Type
nTy : Type
aTy : Type
bTy : [Type]
_ <- [Type]
tys
    , ([Either TyVar Type]
tyArgs,Type -> TypeView
tyView -> TyConApp TyConName
vecTcNm [Type]
_) <- Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
    , let ([Either TyVar Type]
tyArgs',Type
_) = 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
!! Int
1)
    , TyConApp TyConName
indexTcNm [Type]
_ <- 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
!! Int
0)
    , Right Integer
n <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String 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
!! Int
0) Type
nTy Integer
n Integer
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 -> IsMultiPrim -> PrimUnfolding -> PrimInfo
PrimInfo Text
"Clash.Sized.Vector.imap_go" (TyConName -> TyConName -> Type
vecImapGoTy TyConName
vecTcNm TyConName
indexTcNm) WorkInfo
WorkNever IsMultiPrim
SingleResult PrimUnfolding
NoUnfolding))
              [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 (Value -> Term
valToTerm ([Value]
args [Value] -> Int -> Value
forall a. [a] -> Int -> a
!! Int
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
!! Int
2))
              ,Term -> Either Term Type
forall a b. a -> Either a b
Left Term
iLit
              ]

  Text
"Clash.Sized.Vector.imap_go"
    | Bool
isSubj
    , Type
nTy : Type
mTy : Type
aTy : Type
bTy : [Type]
_ <- [Type]
tys
    , Value
f : Value
xs : (Suspend Term
nArg) : [Value]
_ <- [Value]
args
    , DC DataCon
dc [Either Term Type]
vArgs <- Value
xs
    , Right Integer
n' <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
nTy)
    , Right Integer
m <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
mTy)
    -> case Integer
m of
         Integer
0  -> Term -> Maybe Machine
reduce (DataCon -> Type -> Term
mkVecNil DataCon
dc Type
bTy)
         Integer
m'
          | Evaluator
eval <- Step -> Unwind -> PrimStep -> PrimUnwind -> Evaluator
Evaluator Step
ghcStep Unwind
ghcUnwind PrimStep
ghcPrimStep PrimUnwind
ghcPrimUnwind
          , mach1 :: Machine
mach1@Machine{mStack :: Machine -> Stack
mStack=[],mTerm :: Machine -> Term
mTerm=Term
n} <-
              Evaluator -> TyConMap -> Bool -> Machine -> Machine
whnf Evaluator
eval TyConMap
tcm Bool
True (Term -> Machine -> Machine
setTerm Term
nArg (Machine -> Machine
stackClear Machine
mach))
          ->  let ([Either TyVar Type]
tyArgs,Type
_) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
                  TyConApp TyConName
indexTcNm [Type]
_ = 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
!! Int
2)
                  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
!! Int
2) Type
nTy Integer
n' Integer
1
               in Machine -> Maybe Machine
forall a. a -> Maybe a
Just (Machine -> Maybe Machine) -> Machine -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ (Term -> Machine -> Machine) -> Machine -> Term -> Machine
forall a b c. (a -> b -> c) -> b -> a -> c
flip Term -> Machine -> Machine
setTerm (Machine
mach1 {mStack :: Stack
mStack = Machine -> Stack
mStack Machine
mach}) (Term -> Machine) -> Term -> Machine
forall a b. (a -> b) -> a -> b
$ HasCallStack => DataCon -> Type -> Integer -> Term -> Term -> Term
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 Term
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
!! Int
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
-Integer
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 (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
!! Int
2)
                         ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Term -> [Either Term Type] -> Term
mkApps (PrimInfo -> Term
Prim (Text
-> Type -> WorkInfo -> IsMultiPrim -> PrimUnfolding -> PrimInfo
PrimInfo Text
"Clash.Sized.Internal.Index.+#" (TyConName -> Type
indexAddTy TyConName
indexTcNm) WorkInfo
WorkVariable IsMultiPrim
SingleResult PrimUnfolding
NoUnfolding))
                                       [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 Term
n
                                       ,Term -> Either Term Type
forall a b. a -> Either a b
Left Term
iLit
                                       ])
                         ])
          | Bool
otherwise
          -> Maybe Machine
forall a. Maybe a
Nothing

  -- :: forall n a. KnownNat n => (a -> a) -> a -> Vec n a
  Text
"Clash.Sized.Vector.iterateI"
    | Bool
isSubj
    , [Type
nTy, Type
aTy] <- [Type]
tys
    , [Value
_n, Value
f, Value
a] <- [Value]
args
    , Right Integer
n <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
nTy)
    ->
      let
        TyConApp TyConName
vecTcNm [Type]
_ = Type -> TypeView
tyView (TyConMap -> Type -> [Type] -> Type
getResultTy TyConMap
tcm Type
ty [Type]
tys)
        Just TyCon
vecTc = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
vecTcNm TyConMap
tcm
        [DataCon
nilCon, DataCon
consCon] = TyCon -> [DataCon]
tyConDataCons TyCon
vecTc
      in case Integer
n of
         Integer
0 -> Term -> Maybe Machine
reduce (DataCon -> Type -> Term
mkVecNil DataCon
nilCon Type
aTy)
         Integer
_ -> Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$
          HasCallStack => DataCon -> Type -> Integer -> Term -> Term -> Term
DataCon -> Type -> Integer -> Term -> Term -> Term
mkVecCons DataCon
consCon Type
aTy Integer
n
            (Value -> Term
valToTerm Value
a)
            (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
- Integer
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 (Literal -> Value
Lit (Integer -> Literal
NaturalLiteral (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
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 (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)])
              ])

-- - Zipping
  Text
"Clash.Sized.Vector.zipWith" -- :: (a -> b -> c) -> Vec n a -> Vec n b -> Vec n c
    | Bool
isSubj
    , Type
aTy : Type
bTy : Type
cTy : Type
nTy : [Type]
_ <- [Type]
tys
    , Value
f : Value
xs : Value
ys : [Value]
_   <- [Value]
args
    , DC DataCon
dc [Either Term Type]
vArgs <- Value
xs
    , ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
vecTcNm [Type]
_) <- Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
    , Right Integer
n <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> case Integer
n of
         Integer
0  -> Term -> Maybe Machine
reduce (DataCon -> Type -> Term
mkVecNil DataCon
dc Type
cTy)
         Integer
n' -> Term -> Maybe Machine
reduce (Term -> Maybe Machine) -> Term -> Maybe Machine
forall a b. (a -> b) -> a -> b
$ HasCallStack => DataCon -> Type -> Integer -> Term -> Term -> Term
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
!! Int
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
-Integer
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
- Integer
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
!! Int
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
-Integer
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
  Text
"Clash.Sized.Vector.foldr" -- :: (a -> b -> b) -> b -> Vec n a -> b
    | Bool
isSubj
    , Type
aTy : Type
bTy : Type
nTy : [Type]
_ <- [Type]
tys
    , Value
f : Value
z : Value
xs : [Value]
_ <- [Value]
args
    , DC DataCon
_ [Either Term Type]
vArgs <- Value
xs
    , Right Integer
n <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> case Integer
n of
         Integer
0 -> Term -> Maybe Machine
reduce (Value -> Term
valToTerm Value
z)
         Integer
_ -> 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
!! Int
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
-Integer
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
!! Int
2)
                                   ])
                     ]
  Text
"Clash.Sized.Vector.fold" -- :: (a -> a -> a) -> Vec (n + 1) a -> a
    | Bool
isSubj
    , Type
nTy : Type
aTy :  [Type]
_ <- [Type]
tys
    , Value
f : Value
vs : [Value]
_ <- [Value]
args
    , DC DataCon
_ [Either Term Type]
vArgs <- Value
vs
    , Right Integer
n <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> case Integer
n of
         Integer
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
!! Int
1)
         Integer
_ -> let ([Either TyVar Type]
tyArgs,Type
_)         = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
                  TyConApp TyConName
vecTcNm [Type]
_ = 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
!! Int
1)
                  tupTcNm :: TyConName
tupTcNm      = TyCon -> TyConName
ghcTyconToTyConName (Boxity -> Int -> TyCon
tupleTyCon Boxity
Boxed Int
2)
                  (Just TyCon
tupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
tupTcNm TyConMap
tcm
                  [DataCon
tupDc]      = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
                  n' :: Integer
n'     = Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1
                  m :: Integer
m      = Integer
n' Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
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
-Integer
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
-Integer
1))
                  splitAtCall :: Term
splitAtCall =
                   Term -> [Either Term Type] -> Term
mkApps (PrimInfo -> Term
Prim (Text
-> Type -> WorkInfo -> IsMultiPrim -> PrimUnfolding -> PrimInfo
PrimInfo Text
"Clash.Sized.Vector.fold_split" (TyConName -> Type
foldSplitAtTy TyConName
vecTcNm) WorkInfo
WorkNever IsMultiPrim
SingleResult PrimUnfolding
NoUnfolding))
                          [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 Text
"as" Int
0
                  bsNm :: Name a
bsNm     = Text -> Int -> Name a
forall a. Text -> Int -> Name a
mkUnsafeSystemName Text
"bs" Int
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
m'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 (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
n1m'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  (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])
                                       ])
                         ]


  Text
"Clash.Sized.Vector.fold_split" -- :: Natural -> Vec (m + n) a -> (Vec m a, Vec n a)
    | Bool
isSubj
    , Type
mTy : Type
nTy : Type
aTy : [Type]
_ <- [Type]
tys
    , Right Integer
m <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String 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
           ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
tupTcNm tyArgs :: [Type]
tyArgs@(Type
tyArg:[Type]
_)) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty1
           (Just TyCon
tupTc)       = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
tupTcNm TyConMap
tcm
           [DataCon
tupDc]            = TyCon -> [DataCon]
tyConDataCons TyCon
tupTc
           -- Get the vector data-constructors
           TyConApp TyConName
vecTcNm [Type]
_ = Type -> TypeView
tyView Type
tyArg
           Just TyCon
vecTc         = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
vecTcNm TyConMap
tcm
           [DataCon
nilCon,DataCon
consCon]   = TyCon -> [DataCon]
tyConDataCons TyCon
vecTc
           -- Recursive call to @splitAt@
           splitAtRec :: Term -> Term
splitAtRec 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
-Integer
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
-Integer
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 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
-Integer
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 Text
"l" Int
0
           rNm :: Name a
rNm     = Text -> Int -> Name a
forall a. Text -> Int -> Name a
mkUnsafeSystemName Text
"r" Int
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)
         Integer
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
         Integer
m' | DC DataCon
_ [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 (HasCallStack => DataCon -> Type -> Integer -> Term -> Term -> Term
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
!! Int
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
!! Int
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
!! Int
2) Type
nVecTy [(Pat, Term)
rAlt])
                 ]
         -- v doesn't reduce to a data-constructor
         Integer
_  -> Maybe Machine
forall a. Maybe a
Nothing
-- - Specialised folds
  Text
"Clash.Sized.Vector.dfold"
    | Bool
isSubj
    , Type
pTy : Type
kTy : Type
aTy : [Type]
_ <- [Type]
tys
    , Value
_ : Value
p : Value
f : Value
z : Value
xs : [Value]
_ <- [Value]
args
    , DC DataCon
_ [Either Term Type]
vArgs <- Value
xs
    , Right Integer
k' <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
kTy)
    -> case Integer
k'  of
         Integer
0 -> Term -> Maybe Machine
reduce (Value -> Term
valToTerm Value
z)
         Integer
_ -> let ([Either TyVar Type]
tyArgs,Type
_)  = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
                  ([Either TyVar Type]
tyArgs',Type
_) = 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
!! Int
2)
                  TyConApp TyConName
snatTcNm [Type]
_ = 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
!! Int
0)
                  Just TyCon
snatTc = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
snatTcNm TyConMap
tcm
                  [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
-Integer
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
-Integer
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
!! Int
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
-Integer
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
!! Int
2)
                                       ])
                         ]
  Text
"Clash.Sized.Vector.dtfold"
    | Bool
isSubj
    , Type
pTy : Type
kTy : Type
aTy : [Type]
_ <- [Type]
tys
    , Value
_ : Value
p : Value
f : Value
g : Value
xs : [Value]
_ <- [Value]
args
    , DC DataCon
_ [Either Term Type]
vArgs <- Value
xs
    , Right Integer
k' <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
kTy)
    -> case Integer
k' of
         Integer
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
!! Int
1)])
         Integer
_ -> let ([Either TyVar Type]
tyArgs,Type
_)  = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
                  TyConApp TyConName
vecTcNm [Type]
_ = 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
!! Int
4)
                  ([Either TyVar Type]
tyArgs',Type
_) = 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
!! Int
3)
                  TyConApp TyConName
snatTcNm [Type]
_ = 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
!! Int
0)
                  Just TyCon
snatTc = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
snatTcNm TyConMap
tcm
                  [DataCon
snatDc]    = TyCon -> [DataCon]
tyConDataCons TyCon
snatTc
                  tupTcNm :: TyConName
tupTcNm     = TyCon -> TyConName
ghcTyconToTyConName (Boxity -> Int -> TyCon
tupleTyCon Boxity
Boxed Int
2)
                  (Just TyCon
tupTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
tupTcNm TyConMap
tcm
                  [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
-Integer
1))
                  k2ty :: Type
k2ty        = LitTy -> Type
LitTy (Integer -> LitTy
NumTy (Integer
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
-Integer
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 (Integer
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
-Integer
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 Text
"xsL" Int
0
                  xsRNm :: Name a
xsRNm    = Text -> Int -> Name a
forall a. Text -> Int -> Name a
mkUnsafeSystemName Text
"xsR" Int
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
-Integer
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
-Integer
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
-Integer
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
  Text
"Clash.Sized.Vector.lazyV"
    | Bool
isSubj
    , Type
nTy : Type
aTy : [Type]
_ <- [Type]
tys
    , Value
_ : Value
xs : [Value]
_ <- [Value]
args
    , ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
vecTcNm [Type]
_) <- Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
    , Right Integer
n <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> case Integer
n of
         Integer
0  -> let (Just TyCon
vecTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
vecTcNm TyConMap
tcm
                   [DataCon
nilCon,DataCon
_]   = TyCon -> [DataCon]
tyConDataCons TyCon
vecTc
               in  Term -> Maybe Machine
reduce (DataCon -> Type -> Term
mkVecNil DataCon
nilCon Type
aTy)
         Integer
n' -> let (Just TyCon
vecTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
vecTcNm TyConMap
tcm
                   [DataCon
_,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
$ HasCallStack => DataCon -> Type -> Integer -> Term -> Term -> Term
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
- Integer
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
- Integer
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
-Integer
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
-Integer
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
  Text
"Clash.Sized.Vector.traverse#"
    | Bool
isSubj
    , Type
aTy : Type
fTy : Type
bTy : Type
nTy : [Type]
_ <- [Type]
tys
    , Value
apDict : Value
f : Value
xs : [Value]
_ <- [Value]
args
    , DC DataCon
dc [Either Term Type]
vArgs <- Value
xs
    , Right Integer
n <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> case Integer
n of
         Integer
0 -> let (Term
pureF,Supply
ids') = PrimEvalMonad Term -> Supply -> (Term, Supply)
forall a. PrimEvalMonad a -> Supply -> (a, Supply)
runPEM (String
-> InScopeSet
-> TyConMap
-> Term
-> Int
-> Int
-> PrimEvalMonad Term
forall (m :: Type -> Type).
(HasCallStack, MonadUnique m) =>
String -> InScopeSet -> TyConMap -> Term -> Int -> Int -> m Term
mkSelectorCase $(String
curLoc) InScopeSet
is0 TyConMap
tcm (Value -> Term
valToTerm Value
apDict) Int
1 Int
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)]
         Integer
_ -> let ((Term
fmapF,Term
apF),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  <- String
-> InScopeSet
-> TyConMap
-> Term
-> Int
-> Int
-> PrimEvalMonad Term
forall (m :: Type -> Type).
(HasCallStack, MonadUnique m) =>
String -> InScopeSet -> TyConMap -> Term -> Int -> Int -> m Term
mkSelectorCase $(String
curLoc) InScopeSet
is0 TyConMap
tcm (Value -> Term
valToTerm Value
apDict) Int
1 Int
0
                    Term
fmapF' <- String
-> InScopeSet
-> TyConMap
-> Term
-> Int
-> Int
-> PrimEvalMonad Term
forall (m :: Type -> Type).
(HasCallStack, MonadUnique m) =>
String -> InScopeSet -> TyConMap -> Term -> Int -> Int -> m Term
mkSelectorCase $(String
curLoc) InScopeSet
is0 TyConMap
tcm Term
fDict Int
1 Int
0
                    Term
apF'   <- String
-> InScopeSet
-> TyConMap
-> Term
-> Int
-> Int
-> PrimEvalMonad Term
forall (m :: Type -> Type).
(HasCallStack, MonadUnique m) =>
String -> InScopeSet -> TyConMap -> Term -> Int -> Int -> m Term
mkSelectorCase $(String
curLoc) InScopeSet
is0 TyConMap
tcm (Value -> Term
valToTerm Value
apDict) Int
1 Int
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
-Integer
1))
                  Just (Type
consCoTy : [Type]
_) = 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
!! Int
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
!! Int
2)
                                       ])
                         ]
    where
      ([Either TyVar Type]
tyArgs,Type
_)         = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
      TyConApp TyConName
vecTcNm [Type]
_ = 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
!! Int
2)
      (Supply
ids, InScopeSet
is0) = (Machine -> Supply
mSupply Machine
mach, Machine -> InScopeSet
mScopeNames Machine
mach)

-- BitPack
  Text
"Clash.Sized.Vector.concatBitVector#"
    | Bool
isSubj
    , Type
nTy : Type
mTy : [Type]
_ <- [Type]
tys
    , Value
_  : Value
km  : Value
v : [Value]
_ <- [Value]
args
    , DC DataCon
_ [Either Term Type]
vArgs <- Value
v
    , Right Integer
n <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> case Integer
n of
         Integer
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 Integer
0 Integer
0)
         Integer
n' | Right Integer
m <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
mTy)
            , ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
bvTcNm [Type]
_) <- 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
-Integer
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
-Integer
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
!! Int
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
-Integer
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
-Integer
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
!! Int
2)
                                ])
                 ]
         Integer
_ -> Maybe Machine
forall a. Maybe a
Nothing
  Text
"Clash.Sized.Vector.unconcatBitVector#"
    | Bool
isSubj
    , Type
nTy : Type
mTy : [Type]
_  <- [Type]
tys
    , Value
_  : Value
km  : Value
bv : [Value]
_ <- [Value]
args
    , ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
vecTcNm [Type
_,Type
bvMTy]) <- Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
    , TyConApp TyConName
bvTcNm [Type]
_ <- Type -> TypeView
tyView Type
bvMTy
    , Right Integer
n <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> case Integer
n of
         Integer
0 ->
          let (Just TyCon
vecTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
vecTcNm TyConMap
tcm
              [DataCon
nilCon,DataCon
_] = TyCon -> [DataCon]
tyConDataCons TyCon
vecTc
          in  Term -> Maybe Machine
reduce (DataCon -> Type -> Term
mkVecNil DataCon
nilCon (TyConName -> [Type] -> Type
mkTyConApp TyConName
bvTcNm [Type
mTy]))
         Integer
n' | Right Integer
m <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
mTy) ->
          let Just TyCon
vecTc  = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
vecTcNm TyConMap
tcm
              [DataCon
_,DataCon
consCon] = TyCon -> [DataCon]
tyConDataCons TyCon
vecTc
              tupTcNm :: TyConName
tupTcNm     = TyCon -> TyConName
ghcTyconToTyConName (Boxity -> Int -> TyCon
tupleTyCon Boxity
Boxed Int
2)
              Just TyCon
tupTc  = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
tupTcNm TyConMap
tcm
              [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
-Integer
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
-Integer
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
-Integer
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 Text
"x" Int
0
              bvNm :: Name a
bvNm        = Text -> Int -> Name a
forall a. Text -> Int -> Name a
mkUnsafeSystemName Text
"bv'" Int
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
$ HasCallStack => DataCon -> Type -> Integer -> Term -> Term -> Term
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
-Integer
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
-Integer
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])
                        ])
         Integer
_ -> Maybe Machine
forall a. Maybe a
Nothing
#if MIN_VERSION_ghc(9,4,0)
  "Data.Text.Show.$wunpackCStringAscii#"
    | [Lit (StringLiteral addr)] <- args
    , Text.Text (Text.ByteArray ba) _off len <- Text.pack addr
    -> let (_,tyView -> TyConApp tupTcNm tyArgs) = splitFunForallTy ty
           (Just tupTc) = UniqMap.lookup tupTcNm tcm
           [tupDc] = tyConDataCons tupTc
           ret     = mkApps (Data tupDc) (map Right tyArgs ++
                    [ Left (Literal (ByteArrayLiteral (BA.ByteArray ba)))
                    , Left (Literal (IntLiteral 0))
                    , Left (Literal (IntLiteral (toInteger len)))])
        in reduce ret
  "GHC.Magic.noinlineConstraint"
    | [arg] <- args
    -> reduce (valToTerm arg)
  "GHC.TypeNats.withSomeSNat"
    | Lit (NaturalLiteral n) : fun : _ <- args
    , _ : funTy : _ <- Either.rights (fst (splitFunForallTy ty))
    , (tyView -> TyConApp snatTcNm _) : _ <- Either.rights (fst (splitFunForallTy funTy))
    , Just snatTc <- UniqMap.lookup snatTcNm tcm
    , [snatDc] <- tyConDataCons snatTc
    -> let nTy = LitTy (NumTy n)
           snat = mkApps (Data snatDc) [Right nTy, Left (Literal (NaturalLiteral n))]
           ret = mkApps (valToTerm fun) [Right nTy, Left snat]
        in reduce ret
  "GHC.Magic.nospec"
    | [arg] <- args
    -> reduce (valToTerm arg)
  "GHC.Float.$wproperFractionDouble"
    | _ : Lit (DoubleLiteral d) : _ <- args
    , [sty@(tyView -> TyConApp signedTcNm [nTy@(LitTy (NumTy kn))])] <- tys
    , nameOcc signedTcNm == "Clash.Sized.Internal.Signed.Signed"
    , (_, tyView -> TyConApp tupTcNm tyArgs) <- splitFunForallTy ty
    , Just tupTc <- UniqMap.lookup tupTcNm tcm
    , [tupDc] <- tyConDataCons tupTc
    -> let (sn, d1) = reifyNat kn (\p -> first toInteger (op p (wordToDouble d)))
           ret = mkApps (Data tupDc) (map Right tyArgs ++
                  [ Left (mkSignedLit sty nTy kn sn)
                  , Left (mkDoubleCLit tcm (doubleToWord d1) (last tyArgs))
                  ])
        in reduce ret
    where
      op :: KnownNat n => Proxy n -> Double -> (Signed n, Double)
      op _ = properFraction
#endif
  Text
_ -> Maybe Machine
forall a. Maybe a
Nothing
  where
    ty :: Type
ty = PrimInfo -> Type
primType PrimInfo
pInfo

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

    checkNaturalRange2 :: Type
-> Integer -> Integer -> (Natural -> Natural -> Natural) -> Term
checkNaturalRange2 Type
nTy Integer
i Integer
j Natural -> Natural -> Natural
f =
      Type -> [Integer] -> ([Natural] -> Term) -> Term
checkNaturalRange Type
nTy [Integer
i, Integer
j]
        (\[Natural
i', 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 Type
nTy [Integer]
natsAsInts [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
<Integer
0) [Integer]
natsAsInts then
        Term -> Type -> Term
TyApp (PrimInfo -> Term
Prim PrimInfo
NP.undefined) 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 Term
e = case Term -> Either String Term
forall a. a -> Either String a
isX Term
e of
      Left String
msg -> String -> Maybe Machine -> Maybe Machine
forall a. String -> a -> a
trace ([String] -> String
unlines [String
"Warning: Not evaluating constant expression:", Text -> String
forall a. Show a => a -> String
show (PrimInfo -> Text
primName PrimInfo
pInfo), String
"Because doing so generates an XException:", String
msg]) Maybe Machine
forall a. Maybe a
Nothing
      Right Term
e' -> Machine -> Maybe Machine
forall a. a -> Maybe a
Just (Term -> Machine -> Machine
setTerm Term
e' Machine
mach)

    reduceWHNF :: Term -> Maybe Machine
reduceWHNF Term
e =
      let eval :: Evaluator
eval = Step -> Unwind -> PrimStep -> PrimUnwind -> Evaluator
Evaluator Step
ghcStep Unwind
ghcUnwind PrimStep
ghcPrimStep PrimUnwind
ghcPrimUnwind
          mach1 :: Machine
mach1@Machine{mStack :: Machine -> Stack
mStack=[]} = Evaluator -> TyConMap -> Bool -> Machine -> Machine
whnf Evaluator
eval 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' Machine
mach1 Term
e =
      let eval :: Evaluator
eval = Step -> Unwind -> PrimStep -> PrimUnwind -> Evaluator
Evaluator Step
ghcStep Unwind
ghcUnwind PrimStep
ghcPrimStep PrimUnwind
ghcPrimUnwind
          mach2 :: Machine
mach2@Machine{mStack :: Machine -> Stack
mStack=[]} = Evaluator -> TyConMap -> Bool -> Machine -> Machine
whnf Evaluator
eval 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 e -> Bool
wantToHandle 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 Term
b -> Term
b
        Left e
e -> String -> Term -> Term
forall a. String -> a -> a
trace (e -> String
forall a. Show a => a -> String
msg e
e) (Term -> Type -> Term
TyApp (PrimInfo -> Term
Prim PrimInfo
NP.undefined) 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 -> 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 -> String
msg a
e = [String] -> String
unlines [String
"Warning: caught exception: \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\" while trying to evaluate: "
                        , Term -> String
forall p. PrettyPrec p => p -> String
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 Value -> Maybe a
f [Value
x, 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 Value -> Maybe a
_ [Value]
_ = 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 Integer
n Integer
i = Integer
i Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
sz
 where
  sz :: Integer
sz = Integer
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 Integer
n Integer
i = if Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then Integer
0 else Integer
res
 where
  mask :: Integer
mask = Integer
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
- Integer
1)
  res :: Integer
res  = case Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
divMod Integer
i Integer
mask of
           (Integer
s,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] -> [Word64]
doubleLiterals' :: [Value] -> [Word64]
doubleLiterals' = (Value -> Maybe Word64) -> [Value] -> [Word64]
forall a. (Value -> Maybe a) -> [Value] -> [a]
listOf Value -> Maybe Word64
doubleLiteral

doubleLiteral :: Value -> Maybe Word64
doubleLiteral :: Value -> Maybe Word64
doubleLiteral Value
v = case Value
v of
  Lit (DoubleLiteral Word64
i) -> Word64 -> Maybe Word64
forall a. a -> Maybe a
Just Word64
i
  Value
_ -> Maybe Word64
forall a. Maybe a
Nothing

floatLiterals' :: [Value] -> [Word32]
floatLiterals' :: [Value] -> [Word32]
floatLiterals' = (Value -> Maybe Word32) -> [Value] -> [Word32]
forall a. (Value -> Maybe a) -> [Value] -> [a]
listOf Value -> Maybe Word32
floatLiteral

floatLiteral :: Value -> Maybe Word32
floatLiteral :: Value -> Maybe Word32
floatLiteral Value
v = case Value
v of
  Lit (FloatLiteral Word32
i) -> Word32 -> Maybe Word32
forall a. a -> Maybe a
Just Word32
i
  Value
_ -> Maybe Word32
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 Value
v =
  case Value
v of
    Lit (IntegerLiteral Integer
i) -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i
    DC DataCon
dc [Left (Literal (IntLiteral Integer
i))]
      | DataCon -> Int
dcTag DataCon
dc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
      -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i
    DC DataCon
dc [Left (Literal (ByteArrayLiteral (BA.ByteArray ByteArray#
ba)))]
      | DataCon -> Int
dcTag DataCon
dc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2
#if MIN_VERSION_base(4,15,0)
      -> Just (IP ba)
#else
      -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just (BigNat -> Integer
Jp# (ByteArray# -> BigNat
BN# ByteArray#
ba))
#endif
      | DataCon -> Int
dcTag DataCon
dc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3
#if MIN_VERSION_base(4,15,0)
      -> Just (IN ba)
#else
      -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just (BigNat -> Integer
Jn# (ByteArray# -> BigNat
BN# ByteArray#
ba))
#endif
    Value
_ -> 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 Value
v =
  case Value
v of
    Lit (NaturalLiteral Integer
i) -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i
    DC DataCon
dc [Left (Literal (WordLiteral Integer
i))]
      | DataCon -> Int
dcTag DataCon
dc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
      -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i
    DC DataCon
dc [Left (Literal (ByteArrayLiteral (BA.ByteArray ByteArray#
ba)))]
      | DataCon -> Int
dcTag DataCon
dc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2
#if MIN_VERSION_base(4,15,0)
      -> Just (IP ba)
#else
      -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just (BigNat -> Integer
Jp# (ByteArray# -> BigNat
BN# ByteArray#
ba))
#endif
    Value
_ -> 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

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

intLiteral :: Value -> Maybe Integer
intLiteral :: Value -> Maybe Integer
intLiteral Value
x = case Value
x of
  Lit (IntLiteral Integer
i) -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i
  Value
_ -> Maybe Integer
forall a. Maybe a
Nothing

#if MIN_VERSION_base(4,16,0)
int8Literals' :: [Value] -> [Integer]
int8Literals' = listOf int8Literal

int8Literal :: Value -> Maybe Integer
int8Literal x = case x of
  Lit (Int8Literal i) -> Just i
  _ -> Nothing

int16Literals' :: [Value] -> [Integer]
int16Literals' = listOf int16Literal

int16Literal :: Value -> Maybe Integer
int16Literal x = case x of
  Lit (Int16Literal i) -> Just i
  _ -> Nothing

int32Literals' :: [Value] -> [Integer]
int32Literals' = listOf int32Literal

int32Literal :: Value -> Maybe Integer
int32Literal x = case x of
  Lit (Int32Literal i) -> Just i
  _ -> Nothing

#if MIN_VERSION_base(4,17,0)
int64Literals' :: [Value] -> [Integer]
int64Literals' = listOf int64Literal

int64Literal :: Value -> Maybe Integer
int64Literal x = case x of
  Lit (Int64Literal i) -> Just i
  _ -> Nothing
#endif
#endif

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

#if MIN_VERSION_base(4,16,0)
word8Literals' :: [Value] -> [Integer]
word8Literals' = listOf word8Literal

word8Literal :: Value -> Maybe Integer
word8Literal x = case x of
  Lit (Word8Literal i) -> Just i
  _ -> Nothing

word16Literals' :: [Value] -> [Integer]
word16Literals' = listOf word16Literal

word16Literal :: Value -> Maybe Integer
word16Literal x = case x of
  Lit (Word16Literal i) -> Just i
  _ -> Nothing

word32Literals' :: [Value] -> [Integer]
word32Literals' = listOf word32Literal

word32Literal :: Value -> Maybe Integer
word32Literal x = case x of
  Lit (Word32Literal i) -> Just i
  _ -> Nothing

#if MIN_VERSION_base(4,17,0)
word64Literals' :: [Value] -> [Integer]
word64Literals' = listOf word64Literal

word64Literal :: Value -> Maybe Integer
word64Literal x = case x of
  Lit (Word64Literal i) -> Just i
  _ -> Nothing
#endif
#endif

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] -> String
charLiterals' = (Value -> Maybe Char) -> [Value] -> String
forall a. (Value -> Maybe a) -> [Value] -> [a]
listOf Value -> Maybe Char
charLiteral

charLiteral :: Value -> Maybe Char
charLiteral :: Value -> Maybe Char
charLiteral Value
x = case Value
x of
  Lit (CharLiteral Char
c) -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c
  Value
_ -> Maybe Char
forall a. Maybe a
Nothing

sizedLiterals :: Text -> [Value] -> Maybe (Integer,Integer)
sizedLiterals :: Text -> [Value] -> Maybe (Integer, Integer)
sizedLiterals 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' 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 Text
szCon Value
val = case Value
val of
  PrimVal PrimInfo
p [Type]
_ [Value
_, Lit (IntegerLiteral 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
  Value
_ -> 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 (a
msk,b
v) = (a
msk a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
1, b
v b -> b -> b
forall a. Bits a => a -> a -> a
.&. b
1)
  go :: Value -> Maybe (Integer, Integer)
go Value
val = case Value
val of
    PrimVal PrimInfo
p [Type]
_ [Lit (WordLiteral Integer
m), Lit (IntegerLiteral Integer
i)]
      | PrimInfo -> Text
primName PrimInfo
p Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Clash.Sized.Internal.BitVector.fromInteger##"
      -> (Integer, Integer) -> Maybe (Integer, Integer)
forall a. a -> Maybe a
Just (Integer
m,Integer
i)
    Value
_ -> 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 Text
"Clash.Sized.Internal.Index.fromInteger#"
signedLiterals :: [Value] -> Maybe (Integer, Integer)
signedLiterals    = Text -> [Value] -> Maybe (Integer, Integer)
sizedLiterals Text
"Clash.Sized.Internal.Signed.fromInteger#"
unsignedLiterals :: [Value] -> Maybe (Integer, Integer)
unsignedLiterals  = Text -> [Value] -> Maybe (Integer, Integer)
sizedLiterals Text
"Clash.Sized.Internal.Unsigned.fromInteger#"

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

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 Value
val = case Value
val of
  (PrimVal PrimInfo
p [Type]
_ [Value
_, Lit (NaturalLiteral Integer
m), Lit (IntegerLiteral Integer
i)])
    | PrimInfo -> Text
primName PrimInfo
p Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Clash.Sized.Internal.BitVector.fromInteger#" -> (Integer, Integer) -> Maybe (Integer, Integer)
forall a. a -> Maybe a
Just (Integer
m, Integer
i)
  Value
_ -> Maybe (Integer, Integer)
forall a. Maybe a
Nothing

toBV :: (Integer,Integer) -> BitVector n
toBV :: (Integer, Integer) -> BitVector n
toBV (Integer
mask,Integer
val) = Natural -> Natural -> BitVector n
forall (n :: Nat). Natural -> Natural -> BitVector n
BV (Integer -> Natural
forall a. Num a => Integer -> a
fromInteger Integer
mask) (Integer -> Natural
forall a. Num a => Integer -> a
fromInteger Integer
val)

splitBV :: BitVector n -> (Integer,Integer)
splitBV :: BitVector n -> (Integer, Integer)
splitBV (BV Natural
msk Natural
val) = (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
msk, Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
val)

toBit :: (Integer,Integer) -> Bit
toBit :: (Integer, Integer) -> Bit
toBit (Integer
mask,Integer
val) = Word -> Word -> Bit
Bit (Integer -> Word
forall a. Num a => Integer -> a
fromInteger Integer
mask) (Integer -> Word
forall a. Num a => Integer -> a
fromInteger Integer
val)

valArgs
  :: Value
  -> Maybe [Term]
valArgs :: Value -> Maybe [Term]
valArgs Value
v =
  case Value
v of
    PrimVal PrimInfo
_ [Type]
_ [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 DataCon
_ [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)
    Value
_ -> 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 Text
szCon TyConMap
tcm [Type]
tys [Value]
args
  | Just (Type
nTy,Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
  , [Value
_
    ,PrimVal PrimInfo
p [Type]
_ [Value
_,Lit (IntegerLiteral Integer
i)]
    ,Value -> Maybe [Term]
valArgs -> Just [Literal (IntLiteral 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 Text
"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 Text
"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 TyConMap
tcm [Type]
tys [Value]
args
  | Just (Type
nTy,Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
  , [Value
_
    ,PrimVal PrimInfo
p [Type]
_ [Value
_,Lit (NaturalLiteral Integer
m),Lit (IntegerLiteral Integer
i)]
    ,Value -> Maybe [Term]
valArgs -> Just [Literal (IntLiteral Integer
j)]
    ] <- [Value]
args
  , PrimInfo -> Text
primName PrimInfo
p Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"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

mkIntCLit :: TyConMap -> Integer -> Type -> Term
mkIntCLit :: TyConMap -> Integer -> Type -> Term
mkIntCLit TyConMap
tcm Integer
lit Type
resTy =
  Term -> Term -> Term
App (DataCon -> Term
Data DataCon
intDc) (Literal -> Term
Literal (Integer -> Literal
IntLiteral Integer
lit))
 where
  ([Either TyVar Type]
_, Type -> TypeView
tyView -> TyConApp TyConName
intTcNm []) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
resTy
  Just TyCon
intTc = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
intTcNm TyConMap
tcm
  [DataCon
intDc] = TyCon -> [DataCon]
tyConDataCons TyCon
intTc

mkFloatCLit :: TyConMap -> Word32 -> Type -> Term
mkFloatCLit :: TyConMap -> Word32 -> Type -> Term
mkFloatCLit TyConMap
tcm Word32
lit Type
resTy =
  Term -> Term -> Term
App (DataCon -> Term
Data DataCon
floatDc) (Literal -> Term
Literal (Word32 -> Literal
FloatLiteral Word32
lit))
 where
  ([Either TyVar Type]
_, Type -> TypeView
tyView -> TyConApp TyConName
floatTcNm []) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
resTy
  (Just TyCon
floatTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
floatTcNm TyConMap
tcm
  [DataCon
floatDc] = TyCon -> [DataCon]
tyConDataCons TyCon
floatTc

mkDoubleCLit :: TyConMap -> Word64 -> Type -> Term
mkDoubleCLit :: TyConMap -> Word64 -> Type -> Term
mkDoubleCLit TyConMap
tcm Word64
lit Type
resTy =
  Term -> Term -> Term
App (DataCon -> Term
Data DataCon
doubleDc) (Literal -> Term
Literal (Word64 -> Literal
DoubleLiteral Word64
lit))
 where
  ([Either TyVar Type]
_, Type -> TypeView
tyView -> TyConApp TyConName
doubleTcNm []) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
resTy
  (Just TyCon
doubleTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
doubleTcNm TyConMap
tcm
  [DataCon
doubleDc] = TyCon -> [DataCon]
tyConDataCons TyCon
doubleTc

mkSomeNat :: TyConMap -> Integer -> Type -> Term
mkSomeNat :: TyConMap -> Integer -> Type -> Term
mkSomeNat TyConMap
tcm Integer
lit Type
resTy =
  Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
someNatDc)
         [ Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy Integer
lit))
         , Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
NaturalLiteral Integer
lit))
         , Term -> Either Term Type
forall a b. a -> Either a b
Left Term
proxy
         ]
 where
  -- Get the SomeNat data constructor
  TyConApp TyConName
someNatTcNm [] = Type -> TypeView
tyView Type
resTy
  (Just TyCon
someNatTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
someNatTcNm TyConMap
tcm
  [DataCon
someNatDc] = TyCon -> [DataCon]
tyConDataCons TyCon
someNatTc

  -- Get the Proxy data constructor
  (Either TyVar Type
_:Either TyVar Type
_:Right (Type -> TypeView
tyView -> TyConApp TyConName
proxyTcNm [Type
natTy,Type
_]):[Either TyVar Type]
_,Type
_) =
    Type -> ([Either TyVar Type], Type)
splitFunForallTy (DataCon -> Type
dcType DataCon
someNatDc)
  (Just TyCon
proxyTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
proxyTcNm TyConMap
tcm
  [DataCon
proxyDc] = TyCon -> [DataCon]
tyConDataCons TyCon
proxyTc

  -- Build the Proxy argument
  proxy :: Term
proxy = Term -> [Either Term Type] -> Term
mkApps (DataCon -> Term
Data DataCon
proxyDc)
                 [ Type -> Either Term Type
forall a b. b -> Either a b
Right Type
natTy
                 , Type -> Either Term Type
forall a b. b -> Either a b
Right (LitTy -> Type
LitTy (Integer -> LitTy
NumTy Integer
lit))
                 ]

-- 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 TyConMap
tcm [Type]
tys = case [Type]
tys of
  Type
nTy : [Type]
_ | Right Integer
nInt <- Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
nTy)
    -> (Type, Integer) -> Maybe (Type, Integer)
forall a. a -> Maybe a
Just (Type
nTy, Integer
nInt)
  [Type]
_ -> 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 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 Type -> Term
conPrim Type
ty Type
nTy Integer
kn 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
    ([Either TyVar Type]
_,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 Type
ty Integer
msk 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
WordLiteral (Integer
msk Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
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
.&. Integer
1)))]
  where
    ([Either TyVar Type]
_,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 Type
ty Type
nTy Integer
kn Integer
mask 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
NaturalLiteral Integer
mask))
           ,Term -> Either Term Type
forall a b. a -> Either a b
Left (Literal -> Term
Literal (Integer -> Literal
IntegerLiteral Integer
val))]
  where
    ([Either TyVar Type]
_,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 Type
rTy Type
nTy Integer
kn Integer
val
  | Integer
val Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
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 (Term -> Type -> Term
TyApp (PrimInfo -> Term
Prim PrimInfo
NP.undefined) (TyConName -> [Type] -> Type
mkTyConApp TyConName
indexTcNm [Type
nTy]))
  where
    TyConApp TyConName
indexTcNm [Type]
_ = 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 Type
rTy Type
nTy Integer
kn 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' (Type
ty,Type
nTy,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' (Type
rTy,Type
nTy,Integer
kn) = Type -> Type -> Integer -> Integer -> Term
mkIndexLit Type
rTy Type
nTy Integer
kn

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

boolToBoolLiteral :: TyConMap -> Type -> Bool -> Term
boolToBoolLiteral :: TyConMap -> Type -> Bool -> Term
boolToBoolLiteral TyConMap
tcm Type
ty Bool
b =
 let ([Either TyVar Type]
_,Type -> TypeView
tyView -> TyConApp TyConName
boolTcNm []) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty
     (Just TyCon
boolTc) = TyConName -> TyConMap -> Maybe TyCon
forall a b. Uniquable a => a -> UniqMap b -> Maybe b
UniqMap.lookup TyConName
boolTcNm TyConMap
tcm
     [DataCon
falseDc,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

integerToInt64Literal :: Integer -> Term
integerToInt64Literal :: Integer -> Term
integerToInt64Literal = Literal -> Term
Literal (Literal -> Term) -> (Integer -> Literal) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
Int64Literal (Integer -> Literal) -> (Integer -> Integer) -> Integer -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int64 -> Integer) -> (Integer -> Int64) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Int64
forall a. Num a => Integer -> a
fromInteger :: Integer -> Int64) -- for overflow behavior

integerToWord64Literal :: Integer -> Term
integerToWord64Literal :: Integer -> Term
integerToWord64Literal = Literal -> Term
Literal (Literal -> Term) -> (Integer -> Literal) -> Integer -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
Word64Literal (Integer -> Literal) -> (Integer -> Integer) -> Integer -> Literal
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
. (Integer -> Word64
forall a. Num a => Integer -> a
fromInteger :: Integer -> Word64) -- 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 TyConName
bTcNm [Type]
_)
  = PrimInfo -> Term
Prim (Text
-> Type -> WorkInfo -> IsMultiPrim -> PrimUnfolding -> PrimInfo
PrimInfo Text
"Clash.Sized.Internal.BitVector.fromInteger##" Type
funTy WorkInfo
WorkNever IsMultiPrim
SingleResult PrimUnfolding
NoUnfolding)
  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
wordPrimTy,Type
integerPrimTy,TyConName -> [Type] -> Type
mkTyConApp TyConName
bTcNm []]
bConPrim Type
_ = String -> Term
forall a. HasCallStack => String -> a
error (String -> Term) -> String -> Term
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"called with incorrect type"

bvConPrim :: Type -> Term
bvConPrim :: Type -> Term
bvConPrim (Type -> TypeView
tyView -> TyConApp TyConName
bvTcNm [Type]
_)
  = PrimInfo -> Term
Prim (Text
-> Type -> WorkInfo -> IsMultiPrim -> PrimUnfolding -> PrimInfo
PrimInfo Text
"Clash.Sized.Internal.BitVector.fromInteger#" (TyVar -> Type -> Type
ForAllTy TyVar
nTV Type
funTy) WorkInfo
WorkNever IsMultiPrim
SingleResult PrimUnfolding
NoUnfolding)
  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
naturalPrimTy,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 Text
"n" Int
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 Type
_ = String -> Term
forall a. HasCallStack => String -> a
error (String -> Term) -> String -> Term
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"called with incorrect type"

indexConPrim :: Type -> Term
indexConPrim :: Type -> Term
indexConPrim (Type -> TypeView
tyView -> TyConApp TyConName
indexTcNm [Type]
_)
  = PrimInfo -> Term
Prim (Text
-> Type -> WorkInfo -> IsMultiPrim -> PrimUnfolding -> PrimInfo
PrimInfo Text
"Clash.Sized.Internal.Index.fromInteger#" (TyVar -> Type -> Type
ForAllTy TyVar
nTV Type
funTy) WorkInfo
WorkNever IsMultiPrim
SingleResult PrimUnfolding
NoUnfolding)
  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 Text
"n" Int
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 Type
_ = String -> Term
forall a. HasCallStack => String -> a
error (String -> Term) -> String -> Term
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"called with incorrect type"

signedConPrim :: Type -> Term
signedConPrim :: Type -> Term
signedConPrim (Type -> TypeView
tyView -> TyConApp TyConName
signedTcNm [Type]
_)
  = PrimInfo -> Term
Prim (Text
-> Type -> WorkInfo -> IsMultiPrim -> PrimUnfolding -> PrimInfo
PrimInfo Text
"Clash.Sized.Internal.Signed.fromInteger#" (TyVar -> Type -> Type
ForAllTy TyVar
nTV Type
funTy) WorkInfo
WorkNever IsMultiPrim
SingleResult PrimUnfolding
NoUnfolding)
  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 Text
"n" Int
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 Type
_ = String -> Term
forall a. HasCallStack => String -> a
error (String -> Term) -> String -> Term
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"called with incorrect type"

unsignedConPrim :: Type -> Term
unsignedConPrim :: Type -> Term
unsignedConPrim (Type -> TypeView
tyView -> TyConApp TyConName
unsignedTcNm [Type]
_)
  = PrimInfo -> Term
Prim (Text
-> Type -> WorkInfo -> IsMultiPrim -> PrimUnfolding -> PrimInfo
PrimInfo Text
"Clash.Sized.Internal.Unsigned.fromInteger#" (TyVar -> Type -> Type
ForAllTy TyVar
nTV Type
funTy) WorkInfo
WorkNever IsMultiPrim
SingleResult PrimUnfolding
NoUnfolding)
  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 Text
"n" Int
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 Type
_ = String -> Term
forall a. HasCallStack => String -> a
error (String -> Term) -> String -> Term
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"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  BitVector n -> BitVector n -> BitVector n
f Type
ty TyConMap
tcm [Type]
tys [Value]
args Proxy n
_p
  | Just (Type
nTy, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
  , [(Integer, Integer)
i,(Integer, Integer)
j] <- [Value] -> [(Integer, Integer)]
bitVectorLiterals' [Value]
args
  = let BV Natural
mask Natural
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 (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
mask) (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
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  BitVector n -> BitVector n -> Bool
f Type
ty TyConMap
tcm [Value]
args Proxy n
_p
  | [(Integer, Integer)
i,(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

liftInteger2BitVector
  :: KnownNat n
  => (Integer -> BitVector n)
  -> (Type, Type, Integer)
  -> [Value]
  -> (Proxy n -> Maybe Term)
liftInteger2BitVector :: (Integer -> BitVector n)
-> (Type, Type, Integer) -> [Value] -> Proxy n -> Maybe Term
liftInteger2BitVector Integer -> BitVector n
f (Type, Type, Integer)
resTyInfo [Value]
args Proxy n
_p
  | [Integer
i] <- [Value] -> [Integer]
intCLiterals' [Value]
args
  = let BV Natural
msk Natural
val = Integer -> BitVector n
f Integer
i
     in Term -> Maybe Term
forall a. a -> Maybe a
Just ((Type, Type, Integer) -> Integer -> Integer -> Term
mkBitVectorLit' (Type, Type, Integer)
resTyInfo (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
msk) (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
val))

  | Bool
otherwise
  = Maybe Term
forall a. Maybe a
Nothing

liftBitVector2CInt
  :: KnownNat n
  => TyConMap
  -> Type
  -> (BitVector n -> Integer)
  -> [Value]
  -> (Proxy n -> Maybe Term)
liftBitVector2CInt :: TyConMap
-> Type
-> (BitVector n -> Integer)
-> [Value]
-> Proxy n
-> Maybe Term
liftBitVector2CInt TyConMap
tcm Type
resTy BitVector n -> Integer
f [Value]
args Proxy n
_p
  | [(Integer, Integer)
i] <- [Value] -> [(Integer, Integer)]
bitVectorLiterals' [Value]
args
  = let val :: Integer
val = BitVector n -> Integer
f ((Integer, Integer) -> BitVector n
forall (n :: Nat). (Integer, Integer) -> BitVector n
toBV (Integer, Integer)
i)
     in Term -> Maybe Term
forall a. a -> Maybe a
Just (Term -> Maybe Term) -> Term -> Maybe Term
forall a b. (a -> b) -> a -> b
$ TyConMap -> Integer -> Type -> Term
mkIntCLit TyConMap
tcm Integer
val Type
resTy
  | 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 [Value] -> [Integer]
extractLitArgs Type -> Type -> Integer -> Integer -> Term
mkLit sized n -> sized n -> sized n
f Type
ty TyConMap
tcm [Type]
tys [Value]
args Proxy n
p
  | Just (Type
nTy, Integer
kn) <- TyConMap -> [Type] -> Maybe (Type, Integer)
extractKnownNat TyConMap
tcm [Type]
tys
  , [Integer
i,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 sized n -> sized n -> sized n
f Integer
i Integer
j Proxy n
_ = 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 TyConMap
tcm Type
ty [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
    ([Either TyVar Type]
_,Type
resTy) = Type -> ([Either TyVar Type], Type)
splitFunForallTy Type
ty'
    TyConApp TyConName
_ [Type
resSizeTy] = Type -> TypeView
tyView Type
resTy
    Right Integer
resSize = Except String Integer -> Either String Integer
forall e a. Except e a -> Either e a
runExcept (TyConMap -> Type -> Except String Integer
tyNatSize TyConMap
tcm Type
resSizeTy)

getResultTy
  :: TyConMap
  -> Type
  -> [Type]
  -> Type
getResultTy :: TyConMap -> Type -> [Type] -> Type
getResultTy TyConMap
tcm Type
ty [Type]
tys = Type
resTy
 where
  ty' :: Type
ty' = HasCallStack => TyConMap -> Type -> [Type] -> Type
TyConMap -> Type -> [Type] -> Type
piResultTys TyConMap
tcm Type
ty [Type]
tys
  ([Either TyVar Type]
_,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 Double# -> Double# -> Int#
f [Value]
args = case [Value] -> [Word64]
doubleLiterals' [Value]
args of
  [Word64
i,Word64
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#) -> Word64 -> Word64 -> Term
runDDI Double# -> Double# -> Int#
f Word64
i Word64
j
  [Word64]
_     -> Maybe Term
forall a. Maybe a
Nothing
liftDDD :: (Double# -> Double# -> Double#) -> [Value] -> Maybe Term
liftDDD :: (Double# -> Double# -> Double#) -> [Value] -> Maybe Term
liftDDD Double# -> Double# -> Double#
f [Value]
args = case [Value] -> [Word64]
doubleLiterals' [Value]
args of
  [Word64
i,Word64
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#) -> Word64 -> Word64 -> Term
runDDD Double# -> Double# -> Double#
f Word64
i Word64
j
  [Word64]
_     -> Maybe Term
forall a. Maybe a
Nothing
liftDD  :: (Double# -> Double#) -> [Value] -> Maybe Term
liftDD :: (Double# -> Double#) -> [Value] -> Maybe Term
liftDD  Double# -> Double#
f [Value]
args = case [Value] -> [Word64]
doubleLiterals' [Value]
args of
  [Word64
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#) -> Word64 -> Term
runDD Double# -> Double#
f Word64
i
  [Word64]
_     -> Maybe Term
forall a. Maybe a
Nothing
runDDI :: (Double# -> Double# -> Int#) -> Word64 -> Word64 -> Term
runDDI :: (Double# -> Double# -> Int#) -> Word64 -> Word64 -> Term
runDDI Double# -> Double# -> Int#
f Word64
i Word64
j
  = let !(D# Double#
a) = Word64 -> Double
wordToDouble Word64
i
        !(D# Double#
b) = Word64 -> Double
wordToDouble Word64
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#) -> Word64 -> Word64 -> Term
runDDD :: (Double# -> Double# -> Double#) -> Word64 -> Word64 -> Term
runDDD Double# -> Double# -> Double#
f Word64
i Word64
j
  = let !(D# Double#
a) = Word64 -> Double
wordToDouble Word64
i
        !(D# Double#
b) = Word64 -> Double
wordToDouble Word64
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
. Word64 -> Literal
DoubleLiteral (Word64 -> Literal) -> (Double -> Word64) -> Double -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Word64
doubleToWord (Double -> Term) -> Double -> Term
forall a b. (a -> b) -> a -> b
$ Double# -> Double
D# Double#
r
runDD :: (Double# -> Double#) -> Word64 -> Term
runDD :: (Double# -> Double#) -> Word64 -> Term
runDD Double# -> Double#
f Word64
i
  = let !(D# Double#
a) = Word64 -> Double
wordToDouble Word64
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
. Word64 -> Literal
DoubleLiteral (Word64 -> Literal) -> (Double -> Word64) -> Double -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Word64
doubleToWord (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 Float# -> Float# -> Int#
f [Value]
args = case [Value] -> [Word32]
floatLiterals' [Value]
args of
  [Word32
i,Word32
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#) -> Word32 -> Word32 -> Term
runFFI Float# -> Float# -> Int#
f Word32
i Word32
j
  [Word32]
_     -> Maybe Term
forall a. Maybe a
Nothing
liftFFF :: (Float# -> Float# -> Float#) -> [Value] -> Maybe Term
liftFFF :: (Float# -> Float# -> Float#) -> [Value] -> Maybe Term
liftFFF Float# -> Float# -> Float#
f [Value]
args = case [Value] -> [Word32]
floatLiterals' [Value]
args of
  [Word32
i,Word32
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#) -> Word32 -> Word32 -> Term
runFFF Float# -> Float# -> Float#
f Word32
i Word32
j
  [Word32]
_     -> Maybe Term
forall a. Maybe a
Nothing
liftFF  :: (Float# -> Float#) -> [Value] -> Maybe Term
liftFF :: (Float# -> Float#) -> [Value] -> Maybe Term
liftFF  Float# -> Float#
f [Value]
args = case [Value] -> [Word32]
floatLiterals' [Value]
args of
  [Word32
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#) -> Word32 -> Term
runFF Float# -> Float#
f Word32
i
  [Word32]
_     -> Maybe Term
forall a. Maybe a
Nothing
runFFI :: (Float# -> Float# -> Int#) -> Word32 -> Word32 -> Term
runFFI :: (Float# -> Float# -> Int#) -> Word32 -> Word32 -> Term
runFFI Float# -> Float# -> Int#
f Word32
i Word32
j
  = let !(F# Float#
a) = Word32 -> Float
wordToFloat Word32
i
        !(F# Float#
b) = Word32 -> Float
wordToFloat Word32
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#) -> Word32 -> Word32 -> Term
runFFF :: (Float# -> Float# -> Float#) -> Word32 -> Word32 -> Term
runFFF Float# -> Float# -> Float#
f Word32
i Word32
j
  = let !(F# Float#
a) = Word32 -> Float
wordToFloat Word32
i
        !(F# Float#
b) = Word32 -> Float
wordToFloat Word32
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
. Word32 -> Literal
FloatLiteral (Word32 -> Literal) -> (Float -> Word32) -> Float -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Word32
floatToWord (Float -> Term) -> Float -> Term
forall a b. (a -> b) -> a -> b
$ Float# -> Float
F# Float#
r
runFF :: (Float# -> Float#) -> Word32 -> Term
runFF :: (Float# -> Float#) -> Word32 -> Term
runFF Float# -> Float#
f Word32
i
  = let !(F# Float#
a) = Word32 -> Float
wordToFloat Word32
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
. Word32 -> Literal
FloatLiteral (Word32 -> Literal) -> (Float -> Word32) -> Float -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Word32
floatToWord (Float -> Term) -> Float -> Term
forall a b. (a -> b) -> a -> b
$ Float# -> Float
F# Float#
r

#if MIN_VERSION_base(4,16,0)
liftI8 :: (Int8# -> Int8# -> Int8#) -> [Value] -> Maybe Term
liftI8 f args = case int8Literals' args of
  [i,j] ->
    let !(I8# a) = fromInteger i
        !(I8# b) = fromInteger j
     in Just (Literal (Int8Literal (toInteger (I8# (f a b)))))
  _ -> Nothing

liftI8I :: (Int8# -> Int# -> Int8#) -> [Value] -> Maybe Term
liftI8I f args = case args of
  [Lit (Int8Literal i),Lit (IntLiteral j)] ->
    let !(I8# a) = fromInteger i
        !(I# b) = fromInteger j
     in Just (Literal (Int8Literal (toInteger (I8# (f a b)))))
  _ -> Nothing

liftI8RI :: (Int8# -> Int8# -> Int#) -> [Value] -> Maybe Term
liftI8RI f args = case int8Literals' args of
  [i,j] ->
    let !(I8# a) = fromInteger i
        !(I8# b) = fromInteger j
     in Just (Literal (IntLiteral (toInteger (I# (f a b)))))
  _ -> Nothing

liftI16 :: (Int16# -> Int16# -> Int16#) -> [Value] -> Maybe Term
liftI16 f args = case int16Literals' args of
  [i,j] ->
    let !(I16# a) = fromInteger i
        !(I16# b) = fromInteger j
     in Just (Literal (Int16Literal (toInteger (I16# (f a b)))))
  _ -> Nothing

liftI16I :: (Int16# -> Int# -> Int16#) -> [Value] -> Maybe Term
liftI16I f args = case args of
  [Lit (Int16Literal i),Lit (IntLiteral j)] ->
    let !(I16# a) = fromInteger i
        !(I# b) = fromInteger j
     in Just (Literal (Int16Literal (toInteger (I16# (f a b)))))
  _ -> Nothing

liftI16RI :: (Int16# -> Int16# -> Int#) -> [Value] -> Maybe Term
liftI16RI f args = case int16Literals' args of
  [i,j] ->
    let !(I16# a) = fromInteger i
        !(I16# b) = fromInteger j
     in Just (Literal (IntLiteral (toInteger (I# (f a b)))))
  _ -> Nothing

liftI32 :: (Int32# -> Int32# -> Int32#) -> [Value] -> Maybe Term
liftI32 f args = case int32Literals' args of
  [i,j] ->
    let !(I32# a) = fromInteger i
        !(I32# b) = fromInteger j
     in Just (Literal (Int32Literal (toInteger (I32# (f a b)))))
  _ -> Nothing

liftI32I :: (Int32# -> Int# -> Int32#) -> [Value] -> Maybe Term
liftI32I f args = case args of
  [Lit (Int32Literal i),Lit (IntLiteral j)] ->
    let !(I32# a) = fromInteger i
        !(I# b) = fromInteger j
     in Just (Literal (Int32Literal (toInteger (I32# (f a b)))))
  _ -> Nothing

liftI32RI :: (Int32# -> Int32# -> Int#) -> [Value] -> Maybe Term
liftI32RI f args = case int32Literals' args of
  [i,j] ->
    let !(I32# a) = fromInteger i
        !(I32# b) = fromInteger j
     in Just (Literal (IntLiteral (toInteger (I# (f a b)))))
  _ -> Nothing

#if MIN_VERSION_base(4,17,0)
liftI64 :: (Int64# -> Int64# -> Int64#) -> [Value] -> Maybe Term
liftI64 f args = case int64Literals' args of
  [i,j] ->
    let !(I64# a) = fromInteger i
        !(I64# b) = fromInteger j
     in Just (Literal (Int64Literal (toInteger (I64# (f a b)))))
  _ -> Nothing

liftI64I :: (Int64# -> Int# -> Int64#) -> [Value] -> Maybe Term
liftI64I f args = case args of
  [Lit (Int64Literal i),Lit (IntLiteral j)] ->
    let !(I64# a) = fromInteger i
        !(I# b) = fromInteger j
     in Just (Literal (Int64Literal (toInteger (I64# (f a b)))))
  _ -> Nothing

liftI64RI :: (Int64# -> Int64# -> Int#) -> [Value] -> Maybe Term
liftI64RI f args = case int64Literals' args of
  [i,j] ->
    let !(I64# a) = fromInteger i
        !(I64# b) = fromInteger j
     in Just (Literal (IntLiteral (toInteger (I# (f a b)))))
  _ -> Nothing
#endif

liftW8 :: (Word8# -> Word8# -> Word8#) -> [Value] -> Maybe Term
liftW8 f args = case word8Literals' args of
  [i,j] ->
    let !(W8# a) = fromInteger i
        !(W8# b) = fromInteger j
     in Just (Literal (Word8Literal (toInteger (W8# (f a b)))))
  _ -> Nothing

liftW8I :: (Word8# -> Int# -> Word8#) -> [Value] -> Maybe Term
liftW8I f args = case args of
  [Lit (Word8Literal i),Lit (IntLiteral j)] ->
    let !(W8# a) = fromInteger i
        !(I# b) = fromInteger j
     in Just (Literal (Word8Literal (toInteger (W8# (f a b)))))
  _ -> Nothing

liftW8RI :: (Word8# -> Word8# -> Int#) -> [Value] -> Maybe Term
liftW8RI f args = case word8Literals' args of
  [i,j] ->
    let !(W8# a) = fromInteger i
        !(W8# b) = fromInteger j
     in Just (Literal (IntLiteral (toInteger (I# (f a b)))))
  _ -> Nothing

liftW16 :: (Word16# -> Word16# -> Word16#) -> [Value] -> Maybe Term
liftW16 f args = case word16Literals' args of
  [i,j] -> let !(W16# a) = fromInteger i
               !(W16# b) = fromInteger j
            in Just (Literal (Word16Literal (toInteger (W16# (f a b)))))
  _ -> Nothing

liftW16I :: (Word16# -> Int# -> Word16#) -> [Value] -> Maybe Term
liftW16I f args = case args of
  [Lit (Word16Literal i),Lit (IntLiteral j)] ->
    let !(W16# a) = fromInteger i
        !(I# b) = fromInteger j
     in Just (Literal (Word16Literal (toInteger (W16# (f a b)))))
  _ -> Nothing

liftW16RI :: (Word16# -> Word16# -> Int#) -> [Value] -> Maybe Term
liftW16RI f args = case word16Literals' args of
  [i,j] ->
    let !(W16# a) = fromInteger i
        !(W16# b) = fromInteger j
     in Just (Literal (IntLiteral (toInteger (I# (f a b)))))
  _ -> Nothing

liftW32 :: (Word32# -> Word32# -> Word32#) -> [Value] -> Maybe Term
liftW32 f args = case word32Literals' args of
  [i,j] -> let !(W32# a) = fromInteger i
               !(W32# b) = fromInteger j
            in Just (Literal (Word32Literal (toInteger (W32# (f a b)))))
  _ -> Nothing

liftW32I :: (Word32# -> Int# -> Word32#) -> [Value] -> Maybe Term
liftW32I f args = case args of
  [Lit (Word32Literal i),Lit (IntLiteral j)] ->
    let !(W32# a) = fromInteger i
        !(I# b) = fromInteger j
     in Just (Literal (Word32Literal (toInteger (W32# (f a b)))))
  _ -> Nothing

liftW32RI :: (Word32# -> Word32# -> Int#) -> [Value] -> Maybe Term
liftW32RI f args = case word32Literals' args of
  [i,j] ->
    let !(W32# a) = fromInteger i
        !(W32# b) = fromInteger j
     in Just (Literal (IntLiteral (toInteger (I# (f a b)))))
  _ -> Nothing

#if MIN_VERSION_base(4,17,0)
liftW64 :: (Word64# -> Word64# -> Word64#) -> [Value] -> Maybe Term
liftW64 f args = case word64Literals' args of
  [i,j] -> let !(W64# a) = fromInteger i
               !(W64# b) = fromInteger j
            in Just (Literal (Word64Literal (toInteger (W64# (f a b)))))
  _ -> Nothing

liftW64I :: (Word64# -> Int# -> Word64#) -> [Value] -> Maybe Term
liftW64I f args = case args of
  [Lit (Word64Literal i),Lit (IntLiteral j)] ->
    let !(W64# a) = fromInteger i
        !(I# b) = fromInteger j
     in Just (Literal (Word64Literal (toInteger (W64# (f a b)))))
  _ -> Nothing

liftW64RI :: (Word64# -> Word64# -> Int#) -> [Value] -> Maybe Term
liftW64RI f args = case word64Literals' args of
  [i,j] ->
    let !(W64# a) = fromInteger i
        !(W64# b) = fromInteger j
     in Just (Literal (IntLiteral (toInteger (I# (f a b)))))
  _ -> Nothing
#endif
#endif

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

splitAtTy
  :: TyConName
  -- ^ SNat TyCon name
  -> TyConName
  -- ^ Vec TyCon name
  -> Type
splitAtTy :: TyConName -> TyConName -> Type
splitAtTy TyConName
snatNm 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 Text
"m" Int
0)
    nTV :: TyVar
nTV   = Type -> TyName -> TyVar
mkTyVar Type
typeNatKind (Text -> Int -> TyName
forall a. Text -> Int -> Name a
mkUnsafeSystemName Text
"n" Int
1)
    aTV :: TyVar
aTV   = Type -> TyName -> TyVar
mkTyVar Type
liftedTypeKind (Text -> Int -> TyName
forall a. Text -> Int -> Name a
mkUnsafeSystemName Text
"a" Int
2)
    tupNm :: TyConName
tupNm = TyCon -> TyConName
ghcTyconToTyConName (Boxity -> Int -> TyCon
tupleTyCon Boxity
Boxed Int
2)

foldSplitAtTy
  :: TyConName
  -- ^ Vec TyCon name
  -> Type
foldSplitAtTy :: TyConName -> Type
foldSplitAtTy 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 Text
"m" Int
0)
    nTV :: TyVar
nTV   = Type -> TyName -> TyVar
mkTyVar Type
typeNatKind (Text -> Int -> TyName
forall a. Text -> Int -> Name a
mkUnsafeSystemName Text
"n" Int
1)
    aTV :: TyVar
aTV   = Type -> TyName -> TyVar
mkTyVar Type
liftedTypeKind (Text -> Int -> TyName
forall a. Text -> Int -> Name a
mkUnsafeSystemName Text
"a" Int
2)
    tupNm :: TyConName
tupNm = TyCon -> TyConName
ghcTyconToTyConName (Boxity -> Int -> TyCon
tupleTyCon Boxity
Boxed Int
2)

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

vecAppendTy
  :: TyConName
  -- ^ Vec TyCon name
  -> Type
vecAppendTy :: TyConName -> Type
vecAppendTy 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 Text
"n" Int
0)
    aTV :: TyVar
aTV = Type -> TyName -> TyVar
mkTyVar Type
liftedTypeKind (Text -> Int -> TyName
forall a. Text -> Int -> Name a
mkUnsafeSystemName Text
"a" Int
1)
    mTV :: TyVar
mTV = Type -> TyName -> TyVar
mkTyVar Type
typeNatKind (Text -> Int -> TyName
forall a. Text -> Int -> Name a
mkUnsafeSystemName Text
"m" Int
2)

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

vecZipWithTy
  :: TyConName
  -- ^ Vec TyCon name
  -> Type
vecZipWithTy :: TyConName -> Type
vecZipWithTy 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 Text
"a" Int
0)
    bTV :: TyVar
bTV = Type -> TyName -> TyVar
mkTyVar Type
liftedTypeKind (Text -> Int -> TyName
forall a. Text -> Int -> Name a
mkUnsafeSystemName Text
"b" Int
1)
    cTV :: TyVar
cTV = Type -> TyName -> TyVar
mkTyVar Type
liftedTypeKind (Text -> Int -> TyName
forall a. Text -> Int -> Name a
mkUnsafeSystemName Text
"c" Int
2)
    nTV :: TyVar
nTV = Type -> TyName -> TyVar
mkTyVar Type
typeNatKind (Text -> Int -> TyName
forall a. Text -> Int -> Name a
mkUnsafeSystemName Text
"n" Int
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 TyConName
vecTcNm 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
fTy
       (Type -> Type -> Type
mkFunTy Type
vecATy (Type -> Type -> Type
mkFunTy Type
indexTy Type
vecBTy))))))
  where
    nTV :: TyVar
nTV = Type -> TyName -> TyVar
mkTyVar Type
typeNatKind (Text -> Int -> TyName
forall a. Text -> Int -> Name a
mkUnsafeSystemName Text
"n" Int
0)
    mTV :: TyVar
mTV = Type -> TyName -> TyVar
mkTyVar Type
typeNatKind (Text -> Int -> TyName
forall a. Text -> Int -> Name a
mkUnsafeSystemName Text
"m" Int
1)
    aTV :: TyVar
aTV = Type -> TyName -> TyVar
mkTyVar Type
liftedTypeKind (Text -> Int -> TyName
forall a. Text -> Int -> Name a
mkUnsafeSystemName Text
"a" Int
2)
    bTV :: TyVar
bTV = Type -> TyName -> TyVar
mkTyVar Type
liftedTypeKind (Text -> Int -> TyName
forall a. Text -> Int -> Name a
mkUnsafeSystemName Text
"b" Int
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 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 Text
"n" Int
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 TyConName
bvTcNm =
  PrimInfo -> Term
Prim (Text
-> Type -> WorkInfo -> IsMultiPrim -> PrimUnfolding -> PrimInfo
PrimInfo Text
"Clash.Sized.Internal.BitVector.++#" (TyConName -> Type
bvAppendTy TyConName
bvTcNm) WorkInfo
WorkNever IsMultiPrim
SingleResult PrimUnfolding
NoUnfolding)

bvAppendTy
  :: TyConName
  -- ^ BitVector TyCon Name
  -> Type
bvAppendTy :: TyConName -> Type
bvAppendTy 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 Text
"m" Int
0)
    nTV :: TyVar
nTV = Type -> TyName -> TyVar
mkTyVar Type
typeNatKind (Text -> Int -> TyName
forall a. Text -> Int -> Name a
mkUnsafeSystemName Text
"n" Int
1)

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

bvSplitTy
  :: TyConName
  -- ^ BitVector TyCon Name
  -> Type
bvSplitTy :: TyConName -> Type
bvSplitTy 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 Text
"n" Int
0)
    mTV :: TyVar
mTV   = Type -> TyName -> TyVar
mkTyVar Type
typeNatKind (Text -> Int -> TyName
forall a. Text -> Int -> Name a
mkUnsafeSystemName Text
"m" Int
1)
    tupNm :: TyConName
tupNm = TyCon -> TyConName
ghcTyconToTyConName (Boxity -> Int -> TyCon
tupleTyCon Boxity
Boxed Int
2)

ghcTyconToTyConName
  :: TyCon.TyCon
  -> TyConName
ghcTyconToTyConName :: TyCon -> TyConName
ghcTyconToTyConName 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 Text
"_INTERNAL_" (Name -> Maybe Text
modNameM Name
n) Text -> Text -> Text
`Text.append`
              (Char
'.' Char -> Text -> Text
`Text.cons` String -> Text
Text.pack String
occName)
    occName :: String
occName = OccName -> String
occNameString (OccName -> String) -> OccName -> String
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 State# RealWorld -> State# RealWorld
m0 = (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO (\State# RealWorld
s -> case State# RealWorld -> State# RealWorld
m0 State# RealWorld
s of State# RealWorld
s' -> (# State# RealWorld
s', () #))

isTrueDC,isFalseDC :: DataCon -> Bool
isTrueDC :: DataCon -> Bool
isTrueDC 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 DataCon
dc = DataCon -> Int
dcUniq DataCon
dc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Unique -> Int
getKey Unique
falseDataConKey