{-|
Module      : Htcc.Asm.Intrinsic.Register
Description : Types and classes of the x86_64 operands
Copyright   : (c) roki, 2019
License     : MIT
Maintainer  : falgon53@yahoo.co.jp
Stability   : experimental
Portability : POSIX

Types and classes of the x86_64 operands
-}
{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-}

module Htcc.Asm.Intrinsic.Operand (
    -- * The operand classes and types.
    IsOperand (..),
    Operand (..),
    Ref (..)
) where

import           Control.Monad               (liftM2)
import           Control.Monad.Fix           (MonadFix (..), fix)
import           Control.Monad.Zip           (MonadZip (..))
import           Data.Bits                   (Bits, FiniteBits)
import           Data.Tuple.Extra            ((***))
import           Foreign.Storable            (Storable)
import           GHC.Arr                     (Ix)
import           GHC.Generics                (Generic, Generic1)
import           Htcc.Asm.Intrinsic.Register (Register (..))

-- | The operand type.
newtype Operand = Operand String -- ^ The constructor of `Operand`.
    deriving (Operand -> Operand -> Bool
(Operand -> Operand -> Bool)
-> (Operand -> Operand -> Bool) -> Eq Operand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Operand -> Operand -> Bool
$c/= :: Operand -> Operand -> Bool
== :: Operand -> Operand -> Bool
$c== :: Operand -> Operand -> Bool
Eq, (forall x. Operand -> Rep Operand x)
-> (forall x. Rep Operand x -> Operand) -> Generic Operand
forall x. Rep Operand x -> Operand
forall x. Operand -> Rep Operand x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Operand x -> Operand
$cfrom :: forall x. Operand -> Rep Operand x
Generic, b -> Operand -> Operand
NonEmpty Operand -> Operand
Operand -> Operand -> Operand
(Operand -> Operand -> Operand)
-> (NonEmpty Operand -> Operand)
-> (forall b. Integral b => b -> Operand -> Operand)
-> Semigroup Operand
forall b. Integral b => b -> Operand -> Operand
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Operand -> Operand
$cstimes :: forall b. Integral b => b -> Operand -> Operand
sconcat :: NonEmpty Operand -> Operand
$csconcat :: NonEmpty Operand -> Operand
<> :: Operand -> Operand -> Operand
$c<> :: Operand -> Operand -> Operand
Semigroup, Semigroup Operand
Operand
Semigroup Operand =>
Operand
-> (Operand -> Operand -> Operand)
-> ([Operand] -> Operand)
-> Monoid Operand
[Operand] -> Operand
Operand -> Operand -> Operand
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Operand] -> Operand
$cmconcat :: [Operand] -> Operand
mappend :: Operand -> Operand -> Operand
$cmappend :: Operand -> Operand -> Operand
mempty :: Operand
$cmempty :: Operand
$cp1Monoid :: Semigroup Operand
Monoid, Eq Operand
Eq Operand =>
(Operand -> Operand -> Ordering)
-> (Operand -> Operand -> Bool)
-> (Operand -> Operand -> Bool)
-> (Operand -> Operand -> Bool)
-> (Operand -> Operand -> Bool)
-> (Operand -> Operand -> Operand)
-> (Operand -> Operand -> Operand)
-> Ord Operand
Operand -> Operand -> Bool
Operand -> Operand -> Ordering
Operand -> Operand -> Operand
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Operand -> Operand -> Operand
$cmin :: Operand -> Operand -> Operand
max :: Operand -> Operand -> Operand
$cmax :: Operand -> Operand -> Operand
>= :: Operand -> Operand -> Bool
$c>= :: Operand -> Operand -> Bool
> :: Operand -> Operand -> Bool
$c> :: Operand -> Operand -> Bool
<= :: Operand -> Operand -> Bool
$c<= :: Operand -> Operand -> Bool
< :: Operand -> Operand -> Bool
$c< :: Operand -> Operand -> Bool
compare :: Operand -> Operand -> Ordering
$ccompare :: Operand -> Operand -> Ordering
$cp1Ord :: Eq Operand
Ord)

instance Show Operand where
    show :: Operand -> String
show (Operand x :: String
x) = String
x

-- | `IsOperand` class has an operand type as instances.
class Show a => IsOperand a where
    -- | The operation of add.
    oadd :: IsOperand b => a -> b -> Operand
    oadd x :: a
x y :: b
y = String -> Operand
Operand (String -> Operand) -> String -> Operand
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ "+" String -> ShowS
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. Show a => a -> String
show b
y
    -- | The operation of sub.
    osub :: IsOperand b => a -> b -> Operand
    osub x :: a
x y :: b
y = String -> Operand
Operand (String -> Operand) -> String -> Operand
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ "-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. Show a => a -> String
show b
y
    -- | The operation of mul.
    omul :: IsOperand b => a -> b -> Operand
    omul x :: a
x y :: b
y = String -> Operand
Operand (String -> Operand) -> String -> Operand
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ "*" String -> ShowS
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. Show a => a -> String
show b
y

instance IsOperand Operand
instance IsOperand Int
instance IsOperand Integer
instance IsOperand Register

-- | The type that specifies that register values are considered address values.
-- e.g.:
--
-- >>> Ref rax
-- [rax]
-- >>> Ref rsp
-- [rsp]
-- >>> import qualified Data.Text as T
-- >>> T.putStr $ mov rax (Ref rsp) <> add rsp 8
--      mov rax, [rsp]
--      add rsp, 8
newtype Ref a = Ref -- ^ The constructor of `Ref`.
    {
        Ref a -> a
runRef :: a
    } deriving (
        Eq (Ref a)
Ref a
Eq (Ref a) =>
(Ref a -> Ref a -> Ref a)
-> (Ref a -> Ref a -> Ref a)
-> (Ref a -> Ref a -> Ref a)
-> (Ref a -> Ref a)
-> (Ref a -> Int -> Ref a)
-> (Ref a -> Int -> Ref a)
-> Ref a
-> (Int -> Ref a)
-> (Ref a -> Int -> Ref a)
-> (Ref a -> Int -> Ref a)
-> (Ref a -> Int -> Ref a)
-> (Ref a -> Int -> Bool)
-> (Ref a -> Maybe Int)
-> (Ref a -> Int)
-> (Ref a -> Bool)
-> (Ref a -> Int -> Ref a)
-> (Ref a -> Int -> Ref a)
-> (Ref a -> Int -> Ref a)
-> (Ref a -> Int -> Ref a)
-> (Ref a -> Int -> Ref a)
-> (Ref a -> Int -> Ref a)
-> (Ref a -> Int)
-> Bits (Ref a)
Int -> Ref a
Ref a -> Bool
Ref a -> Int
Ref a -> Maybe Int
Ref a -> Ref a
Ref a -> Int -> Bool
Ref a -> Int -> Ref a
Ref a -> Ref a -> Ref a
forall a.
Eq a =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
forall a. Bits a => Eq (Ref a)
forall a. Bits a => Ref a
forall a. Bits a => Int -> Ref a
forall a. Bits a => Ref a -> Bool
forall a. Bits a => Ref a -> Int
forall a. Bits a => Ref a -> Maybe Int
forall a. Bits a => Ref a -> Ref a
forall a. Bits a => Ref a -> Int -> Bool
forall a. Bits a => Ref a -> Int -> Ref a
forall a. Bits a => Ref a -> Ref a -> Ref a
popCount :: Ref a -> Int
$cpopCount :: forall a. Bits a => Ref a -> Int
rotateR :: Ref a -> Int -> Ref a
$crotateR :: forall a. Bits a => Ref a -> Int -> Ref a
rotateL :: Ref a -> Int -> Ref a
$crotateL :: forall a. Bits a => Ref a -> Int -> Ref a
unsafeShiftR :: Ref a -> Int -> Ref a
$cunsafeShiftR :: forall a. Bits a => Ref a -> Int -> Ref a
shiftR :: Ref a -> Int -> Ref a
$cshiftR :: forall a. Bits a => Ref a -> Int -> Ref a
unsafeShiftL :: Ref a -> Int -> Ref a
$cunsafeShiftL :: forall a. Bits a => Ref a -> Int -> Ref a
shiftL :: Ref a -> Int -> Ref a
$cshiftL :: forall a. Bits a => Ref a -> Int -> Ref a
isSigned :: Ref a -> Bool
$cisSigned :: forall a. Bits a => Ref a -> Bool
bitSize :: Ref a -> Int
$cbitSize :: forall a. Bits a => Ref a -> Int
bitSizeMaybe :: Ref a -> Maybe Int
$cbitSizeMaybe :: forall a. Bits a => Ref a -> Maybe Int
testBit :: Ref a -> Int -> Bool
$ctestBit :: forall a. Bits a => Ref a -> Int -> Bool
complementBit :: Ref a -> Int -> Ref a
$ccomplementBit :: forall a. Bits a => Ref a -> Int -> Ref a
clearBit :: Ref a -> Int -> Ref a
$cclearBit :: forall a. Bits a => Ref a -> Int -> Ref a
setBit :: Ref a -> Int -> Ref a
$csetBit :: forall a. Bits a => Ref a -> Int -> Ref a
bit :: Int -> Ref a
$cbit :: forall a. Bits a => Int -> Ref a
zeroBits :: Ref a
$czeroBits :: forall a. Bits a => Ref a
rotate :: Ref a -> Int -> Ref a
$crotate :: forall a. Bits a => Ref a -> Int -> Ref a
shift :: Ref a -> Int -> Ref a
$cshift :: forall a. Bits a => Ref a -> Int -> Ref a
complement :: Ref a -> Ref a
$ccomplement :: forall a. Bits a => Ref a -> Ref a
xor :: Ref a -> Ref a -> Ref a
$cxor :: forall a. Bits a => Ref a -> Ref a -> Ref a
.|. :: Ref a -> Ref a -> Ref a
$c.|. :: forall a. Bits a => Ref a -> Ref a -> Ref a
.&. :: Ref a -> Ref a -> Ref a
$c.&. :: forall a. Bits a => Ref a -> Ref a -> Ref a
$cp1Bits :: forall a. Bits a => Eq (Ref a)
Bits
        , Ref a
Ref a -> Ref a -> Bounded (Ref a)
forall a. a -> a -> Bounded a
forall a. Bounded a => Ref a
maxBound :: Ref a
$cmaxBound :: forall a. Bounded a => Ref a
minBound :: Ref a
$cminBound :: forall a. Bounded a => Ref a
Bounded
        , Int -> Ref a
Ref a -> Int
Ref a -> [Ref a]
Ref a -> Ref a
Ref a -> Ref a -> [Ref a]
Ref a -> Ref a -> Ref a -> [Ref a]
(Ref a -> Ref a)
-> (Ref a -> Ref a)
-> (Int -> Ref a)
-> (Ref a -> Int)
-> (Ref a -> [Ref a])
-> (Ref a -> Ref a -> [Ref a])
-> (Ref a -> Ref a -> [Ref a])
-> (Ref a -> Ref a -> Ref a -> [Ref a])
-> Enum (Ref a)
forall a. Enum a => Int -> Ref a
forall a. Enum a => Ref a -> Int
forall a. Enum a => Ref a -> [Ref a]
forall a. Enum a => Ref a -> Ref a
forall a. Enum a => Ref a -> Ref a -> [Ref a]
forall a. Enum a => Ref a -> Ref a -> Ref a -> [Ref a]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Ref a -> Ref a -> Ref a -> [Ref a]
$cenumFromThenTo :: forall a. Enum a => Ref a -> Ref a -> Ref a -> [Ref a]
enumFromTo :: Ref a -> Ref a -> [Ref a]
$cenumFromTo :: forall a. Enum a => Ref a -> Ref a -> [Ref a]
enumFromThen :: Ref a -> Ref a -> [Ref a]
$cenumFromThen :: forall a. Enum a => Ref a -> Ref a -> [Ref a]
enumFrom :: Ref a -> [Ref a]
$cenumFrom :: forall a. Enum a => Ref a -> [Ref a]
fromEnum :: Ref a -> Int
$cfromEnum :: forall a. Enum a => Ref a -> Int
toEnum :: Int -> Ref a
$ctoEnum :: forall a. Enum a => Int -> Ref a
pred :: Ref a -> Ref a
$cpred :: forall a. Enum a => Ref a -> Ref a
succ :: Ref a -> Ref a
$csucc :: forall a. Enum a => Ref a -> Ref a
Enum
        , Ref a -> Ref a -> Bool
(Ref a -> Ref a -> Bool) -> (Ref a -> Ref a -> Bool) -> Eq (Ref a)
forall a. Eq a => Ref a -> Ref a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ref a -> Ref a -> Bool
$c/= :: forall a. Eq a => Ref a -> Ref a -> Bool
== :: Ref a -> Ref a -> Bool
$c== :: forall a. Eq a => Ref a -> Ref a -> Bool
Eq
        , Bits (Ref a)
Bits (Ref a) =>
(Ref a -> Int)
-> (Ref a -> Int) -> (Ref a -> Int) -> FiniteBits (Ref a)
Ref a -> Int
forall b.
Bits b =>
(b -> Int) -> (b -> Int) -> (b -> Int) -> FiniteBits b
forall a. FiniteBits a => Bits (Ref a)
forall a. FiniteBits a => Ref a -> Int
countTrailingZeros :: Ref a -> Int
$ccountTrailingZeros :: forall a. FiniteBits a => Ref a -> Int
countLeadingZeros :: Ref a -> Int
$ccountLeadingZeros :: forall a. FiniteBits a => Ref a -> Int
finiteBitSize :: Ref a -> Int
$cfiniteBitSize :: forall a. FiniteBits a => Ref a -> Int
$cp1FiniteBits :: forall a. FiniteBits a => Bits (Ref a)
FiniteBits
        , Fractional (Ref a)
Ref a
Fractional (Ref a) =>
Ref a
-> (Ref a -> Ref a)
-> (Ref a -> Ref a)
-> (Ref a -> Ref a)
-> (Ref a -> Ref a -> Ref a)
-> (Ref a -> Ref a -> Ref a)
-> (Ref a -> Ref a)
-> (Ref a -> Ref a)
-> (Ref a -> Ref a)
-> (Ref a -> Ref a)
-> (Ref a -> Ref a)
-> (Ref a -> Ref a)
-> (Ref a -> Ref a)
-> (Ref a -> Ref a)
-> (Ref a -> Ref a)
-> (Ref a -> Ref a)
-> (Ref a -> Ref a)
-> (Ref a -> Ref a)
-> (Ref a -> Ref a)
-> (Ref a -> Ref a)
-> (Ref a -> Ref a)
-> (Ref a -> Ref a)
-> Floating (Ref a)
Ref a -> Ref a
Ref a -> Ref a -> Ref a
forall a. Floating a => Fractional (Ref a)
forall a. Floating a => Ref a
forall a. Floating a => Ref a -> Ref a
forall a. Floating a => Ref a -> Ref a -> Ref a
forall a.
Fractional a =>
a
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> Floating a
log1mexp :: Ref a -> Ref a
$clog1mexp :: forall a. Floating a => Ref a -> Ref a
log1pexp :: Ref a -> Ref a
$clog1pexp :: forall a. Floating a => Ref a -> Ref a
expm1 :: Ref a -> Ref a
$cexpm1 :: forall a. Floating a => Ref a -> Ref a
log1p :: Ref a -> Ref a
$clog1p :: forall a. Floating a => Ref a -> Ref a
atanh :: Ref a -> Ref a
$catanh :: forall a. Floating a => Ref a -> Ref a
acosh :: Ref a -> Ref a
$cacosh :: forall a. Floating a => Ref a -> Ref a
asinh :: Ref a -> Ref a
$casinh :: forall a. Floating a => Ref a -> Ref a
tanh :: Ref a -> Ref a
$ctanh :: forall a. Floating a => Ref a -> Ref a
cosh :: Ref a -> Ref a
$ccosh :: forall a. Floating a => Ref a -> Ref a
sinh :: Ref a -> Ref a
$csinh :: forall a. Floating a => Ref a -> Ref a
atan :: Ref a -> Ref a
$catan :: forall a. Floating a => Ref a -> Ref a
acos :: Ref a -> Ref a
$cacos :: forall a. Floating a => Ref a -> Ref a
asin :: Ref a -> Ref a
$casin :: forall a. Floating a => Ref a -> Ref a
tan :: Ref a -> Ref a
$ctan :: forall a. Floating a => Ref a -> Ref a
cos :: Ref a -> Ref a
$ccos :: forall a. Floating a => Ref a -> Ref a
sin :: Ref a -> Ref a
$csin :: forall a. Floating a => Ref a -> Ref a
logBase :: Ref a -> Ref a -> Ref a
$clogBase :: forall a. Floating a => Ref a -> Ref a -> Ref a
** :: Ref a -> Ref a -> Ref a
$c** :: forall a. Floating a => Ref a -> Ref a -> Ref a
sqrt :: Ref a -> Ref a
$csqrt :: forall a. Floating a => Ref a -> Ref a
log :: Ref a -> Ref a
$clog :: forall a. Floating a => Ref a -> Ref a
exp :: Ref a -> Ref a
$cexp :: forall a. Floating a => Ref a -> Ref a
pi :: Ref a
$cpi :: forall a. Floating a => Ref a
$cp1Floating :: forall a. Floating a => Fractional (Ref a)
Floating
        , Num (Ref a)
Num (Ref a) =>
(Ref a -> Ref a -> Ref a)
-> (Ref a -> Ref a) -> (Rational -> Ref a) -> Fractional (Ref a)
Rational -> Ref a
Ref a -> Ref a
Ref a -> Ref a -> Ref a
forall a. Fractional a => Num (Ref a)
forall a. Fractional a => Rational -> Ref a
forall a. Fractional a => Ref a -> Ref a
forall a. Fractional a => Ref a -> Ref a -> Ref a
forall a.
Num a =>
(a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
fromRational :: Rational -> Ref a
$cfromRational :: forall a. Fractional a => Rational -> Ref a
recip :: Ref a -> Ref a
$crecip :: forall a. Fractional a => Ref a -> Ref a
/ :: Ref a -> Ref a -> Ref a
$c/ :: forall a. Fractional a => Ref a -> Ref a -> Ref a
$cp1Fractional :: forall a. Fractional a => Num (Ref a)
Fractional
        , (forall x. Ref a -> Rep (Ref a) x)
-> (forall x. Rep (Ref a) x -> Ref a) -> Generic (Ref a)
forall x. Rep (Ref a) x -> Ref a
forall x. Ref a -> Rep (Ref a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Ref a) x -> Ref a
forall a x. Ref a -> Rep (Ref a) x
$cto :: forall a x. Rep (Ref a) x -> Ref a
$cfrom :: forall a x. Ref a -> Rep (Ref a) x
Generic
        , (forall a. Ref a -> Rep1 Ref a)
-> (forall a. Rep1 Ref a -> Ref a) -> Generic1 Ref
forall a. Rep1 Ref a -> Ref a
forall a. Ref a -> Rep1 Ref a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall a. Rep1 Ref a -> Ref a
$cfrom1 :: forall a. Ref a -> Rep1 Ref a
Generic1
        , Enum (Ref a)
Real (Ref a)
(Real (Ref a), Enum (Ref a)) =>
(Ref a -> Ref a -> Ref a)
-> (Ref a -> Ref a -> Ref a)
-> (Ref a -> Ref a -> Ref a)
-> (Ref a -> Ref a -> Ref a)
-> (Ref a -> Ref a -> (Ref a, Ref a))
-> (Ref a -> Ref a -> (Ref a, Ref a))
-> (Ref a -> Integer)
-> Integral (Ref a)
Ref a -> Integer
Ref a -> Ref a -> (Ref a, Ref a)
Ref a -> Ref a -> Ref a
forall a. Integral a => Enum (Ref a)
forall a. Integral a => Real (Ref a)
forall a. Integral a => Ref a -> Integer
forall a. Integral a => Ref a -> Ref a -> (Ref a, Ref a)
forall a. Integral a => Ref a -> Ref a -> Ref a
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Ref a -> Integer
$ctoInteger :: forall a. Integral a => Ref a -> Integer
divMod :: Ref a -> Ref a -> (Ref a, Ref a)
$cdivMod :: forall a. Integral a => Ref a -> Ref a -> (Ref a, Ref a)
quotRem :: Ref a -> Ref a -> (Ref a, Ref a)
$cquotRem :: forall a. Integral a => Ref a -> Ref a -> (Ref a, Ref a)
mod :: Ref a -> Ref a -> Ref a
$cmod :: forall a. Integral a => Ref a -> Ref a -> Ref a
div :: Ref a -> Ref a -> Ref a
$cdiv :: forall a. Integral a => Ref a -> Ref a -> Ref a
rem :: Ref a -> Ref a -> Ref a
$crem :: forall a. Integral a => Ref a -> Ref a -> Ref a
quot :: Ref a -> Ref a -> Ref a
$cquot :: forall a. Integral a => Ref a -> Ref a -> Ref a
$cp2Integral :: forall a. Integral a => Enum (Ref a)
$cp1Integral :: forall a. Integral a => Real (Ref a)
Integral
        , Ord (Ref a)
Ord (Ref a) =>
((Ref a, Ref a) -> [Ref a])
-> ((Ref a, Ref a) -> Ref a -> Int)
-> ((Ref a, Ref a) -> Ref a -> Int)
-> ((Ref a, Ref a) -> Ref a -> Bool)
-> ((Ref a, Ref a) -> Int)
-> ((Ref a, Ref a) -> Int)
-> Ix (Ref a)
(Ref a, Ref a) -> Int
(Ref a, Ref a) -> [Ref a]
(Ref a, Ref a) -> Ref a -> Bool
(Ref a, Ref a) -> Ref a -> Int
forall a.
Ord a =>
((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
forall a. Ix a => Ord (Ref a)
forall a. Ix a => (Ref a, Ref a) -> Int
forall a. Ix a => (Ref a, Ref a) -> [Ref a]
forall a. Ix a => (Ref a, Ref a) -> Ref a -> Bool
forall a. Ix a => (Ref a, Ref a) -> Ref a -> Int
unsafeRangeSize :: (Ref a, Ref a) -> Int
$cunsafeRangeSize :: forall a. Ix a => (Ref a, Ref a) -> Int
rangeSize :: (Ref a, Ref a) -> Int
$crangeSize :: forall a. Ix a => (Ref a, Ref a) -> Int
inRange :: (Ref a, Ref a) -> Ref a -> Bool
$cinRange :: forall a. Ix a => (Ref a, Ref a) -> Ref a -> Bool
unsafeIndex :: (Ref a, Ref a) -> Ref a -> Int
$cunsafeIndex :: forall a. Ix a => (Ref a, Ref a) -> Ref a -> Int
index :: (Ref a, Ref a) -> Ref a -> Int
$cindex :: forall a. Ix a => (Ref a, Ref a) -> Ref a -> Int
range :: (Ref a, Ref a) -> [Ref a]
$crange :: forall a. Ix a => (Ref a, Ref a) -> [Ref a]
$cp1Ix :: forall a. Ix a => Ord (Ref a)
Ix
        , b -> Ref a -> Ref a
NonEmpty (Ref a) -> Ref a
Ref a -> Ref a -> Ref a
(Ref a -> Ref a -> Ref a)
-> (NonEmpty (Ref a) -> Ref a)
-> (forall b. Integral b => b -> Ref a -> Ref a)
-> Semigroup (Ref a)
forall b. Integral b => b -> Ref a -> Ref a
forall a. Semigroup a => NonEmpty (Ref a) -> Ref a
forall a. Semigroup a => Ref a -> Ref a -> Ref a
forall a b. (Semigroup a, Integral b) => b -> Ref a -> Ref a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Ref a -> Ref a
$cstimes :: forall a b. (Semigroup a, Integral b) => b -> Ref a -> Ref a
sconcat :: NonEmpty (Ref a) -> Ref a
$csconcat :: forall a. Semigroup a => NonEmpty (Ref a) -> Ref a
<> :: Ref a -> Ref a -> Ref a
$c<> :: forall a. Semigroup a => Ref a -> Ref a -> Ref a
Semigroup
        , Semigroup (Ref a)
Ref a
Semigroup (Ref a) =>
Ref a
-> (Ref a -> Ref a -> Ref a)
-> ([Ref a] -> Ref a)
-> Monoid (Ref a)
[Ref a] -> Ref a
Ref a -> Ref a -> Ref a
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. Monoid a => Semigroup (Ref a)
forall a. Monoid a => Ref a
forall a. Monoid a => [Ref a] -> Ref a
forall a. Monoid a => Ref a -> Ref a -> Ref a
mconcat :: [Ref a] -> Ref a
$cmconcat :: forall a. Monoid a => [Ref a] -> Ref a
mappend :: Ref a -> Ref a -> Ref a
$cmappend :: forall a. Monoid a => Ref a -> Ref a -> Ref a
mempty :: Ref a
$cmempty :: forall a. Monoid a => Ref a
$cp1Monoid :: forall a. Monoid a => Semigroup (Ref a)
Monoid
        , Integer -> Ref a
Ref a -> Ref a
Ref a -> Ref a -> Ref a
(Ref a -> Ref a -> Ref a)
-> (Ref a -> Ref a -> Ref a)
-> (Ref a -> Ref a -> Ref a)
-> (Ref a -> Ref a)
-> (Ref a -> Ref a)
-> (Ref a -> Ref a)
-> (Integer -> Ref a)
-> Num (Ref a)
forall a. Num a => Integer -> Ref a
forall a. Num a => Ref a -> Ref a
forall a. Num a => Ref a -> Ref a -> Ref a
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Ref a
$cfromInteger :: forall a. Num a => Integer -> Ref a
signum :: Ref a -> Ref a
$csignum :: forall a. Num a => Ref a -> Ref a
abs :: Ref a -> Ref a
$cabs :: forall a. Num a => Ref a -> Ref a
negate :: Ref a -> Ref a
$cnegate :: forall a. Num a => Ref a -> Ref a
* :: Ref a -> Ref a -> Ref a
$c* :: forall a. Num a => Ref a -> Ref a -> Ref a
- :: Ref a -> Ref a -> Ref a
$c- :: forall a. Num a => Ref a -> Ref a -> Ref a
+ :: Ref a -> Ref a -> Ref a
$c+ :: forall a. Num a => Ref a -> Ref a -> Ref a
Num
        , Eq (Ref a)
Eq (Ref a) =>
(Ref a -> Ref a -> Ordering)
-> (Ref a -> Ref a -> Bool)
-> (Ref a -> Ref a -> Bool)
-> (Ref a -> Ref a -> Bool)
-> (Ref a -> Ref a -> Bool)
-> (Ref a -> Ref a -> Ref a)
-> (Ref a -> Ref a -> Ref a)
-> Ord (Ref a)
Ref a -> Ref a -> Bool
Ref a -> Ref a -> Ordering
Ref a -> Ref a -> Ref a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Ref a)
forall a. Ord a => Ref a -> Ref a -> Bool
forall a. Ord a => Ref a -> Ref a -> Ordering
forall a. Ord a => Ref a -> Ref a -> Ref a
min :: Ref a -> Ref a -> Ref a
$cmin :: forall a. Ord a => Ref a -> Ref a -> Ref a
max :: Ref a -> Ref a -> Ref a
$cmax :: forall a. Ord a => Ref a -> Ref a -> Ref a
>= :: Ref a -> Ref a -> Bool
$c>= :: forall a. Ord a => Ref a -> Ref a -> Bool
> :: Ref a -> Ref a -> Bool
$c> :: forall a. Ord a => Ref a -> Ref a -> Bool
<= :: Ref a -> Ref a -> Bool
$c<= :: forall a. Ord a => Ref a -> Ref a -> Bool
< :: Ref a -> Ref a -> Bool
$c< :: forall a. Ord a => Ref a -> Ref a -> Bool
compare :: Ref a -> Ref a -> Ordering
$ccompare :: forall a. Ord a => Ref a -> Ref a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Ref a)
Ord
        , Num (Ref a)
Ord (Ref a)
(Num (Ref a), Ord (Ref a)) => (Ref a -> Rational) -> Real (Ref a)
Ref a -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
forall a. Real a => Num (Ref a)
forall a. Real a => Ord (Ref a)
forall a. Real a => Ref a -> Rational
toRational :: Ref a -> Rational
$ctoRational :: forall a. Real a => Ref a -> Rational
$cp2Real :: forall a. Real a => Ord (Ref a)
$cp1Real :: forall a. Real a => Num (Ref a)
Real
        , Fractional (Ref a)
Real (Ref a)
(Real (Ref a), Fractional (Ref a)) =>
(forall b. Integral b => Ref a -> (b, Ref a))
-> (forall b. Integral b => Ref a -> b)
-> (forall b. Integral b => Ref a -> b)
-> (forall b. Integral b => Ref a -> b)
-> (forall b. Integral b => Ref a -> b)
-> RealFrac (Ref a)
Ref a -> b
Ref a -> b
Ref a -> b
Ref a -> b
Ref a -> (b, Ref a)
forall b. Integral b => Ref a -> b
forall b. Integral b => Ref a -> (b, Ref a)
forall a.
(Real a, Fractional a) =>
(forall b. Integral b => a -> (b, a))
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> RealFrac a
forall a. RealFrac a => Fractional (Ref a)
forall a. RealFrac a => Real (Ref a)
forall a b. (RealFrac a, Integral b) => Ref a -> b
forall a b. (RealFrac a, Integral b) => Ref a -> (b, Ref a)
floor :: Ref a -> b
$cfloor :: forall a b. (RealFrac a, Integral b) => Ref a -> b
ceiling :: Ref a -> b
$cceiling :: forall a b. (RealFrac a, Integral b) => Ref a -> b
round :: Ref a -> b
$cround :: forall a b. (RealFrac a, Integral b) => Ref a -> b
truncate :: Ref a -> b
$ctruncate :: forall a b. (RealFrac a, Integral b) => Ref a -> b
properFraction :: Ref a -> (b, Ref a)
$cproperFraction :: forall a b. (RealFrac a, Integral b) => Ref a -> (b, Ref a)
$cp2RealFrac :: forall a. RealFrac a => Fractional (Ref a)
$cp1RealFrac :: forall a. RealFrac a => Real (Ref a)
RealFrac
        , Floating (Ref a)
RealFrac (Ref a)
(RealFrac (Ref a), Floating (Ref a)) =>
(Ref a -> Integer)
-> (Ref a -> Int)
-> (Ref a -> (Int, Int))
-> (Ref a -> (Integer, Int))
-> (Integer -> Int -> Ref a)
-> (Ref a -> Int)
-> (Ref a -> Ref a)
-> (Int -> Ref a -> Ref a)
-> (Ref a -> Bool)
-> (Ref a -> Bool)
-> (Ref a -> Bool)
-> (Ref a -> Bool)
-> (Ref a -> Bool)
-> (Ref a -> Ref a -> Ref a)
-> RealFloat (Ref a)
Int -> Ref a -> Ref a
Integer -> Int -> Ref a
Ref a -> Bool
Ref a -> Int
Ref a -> Integer
Ref a -> (Int, Int)
Ref a -> (Integer, Int)
Ref a -> Ref a
Ref a -> Ref a -> Ref a
forall a. RealFloat a => Floating (Ref a)
forall a. RealFloat a => RealFrac (Ref a)
forall a. RealFloat a => Int -> Ref a -> Ref a
forall a. RealFloat a => Integer -> Int -> Ref a
forall a. RealFloat a => Ref a -> Bool
forall a. RealFloat a => Ref a -> Int
forall a. RealFloat a => Ref a -> Integer
forall a. RealFloat a => Ref a -> (Int, Int)
forall a. RealFloat a => Ref a -> (Integer, Int)
forall a. RealFloat a => Ref a -> Ref a
forall a. RealFloat a => Ref a -> Ref a -> Ref a
forall a.
(RealFrac a, Floating a) =>
(a -> Integer)
-> (a -> Int)
-> (a -> (Int, Int))
-> (a -> (Integer, Int))
-> (Integer -> Int -> a)
-> (a -> Int)
-> (a -> a)
-> (Int -> a -> a)
-> (a -> Bool)
-> (a -> Bool)
-> (a -> Bool)
-> (a -> Bool)
-> (a -> Bool)
-> (a -> a -> a)
-> RealFloat a
atan2 :: Ref a -> Ref a -> Ref a
$catan2 :: forall a. RealFloat a => Ref a -> Ref a -> Ref a
isIEEE :: Ref a -> Bool
$cisIEEE :: forall a. RealFloat a => Ref a -> Bool
isNegativeZero :: Ref a -> Bool
$cisNegativeZero :: forall a. RealFloat a => Ref a -> Bool
isDenormalized :: Ref a -> Bool
$cisDenormalized :: forall a. RealFloat a => Ref a -> Bool
isInfinite :: Ref a -> Bool
$cisInfinite :: forall a. RealFloat a => Ref a -> Bool
isNaN :: Ref a -> Bool
$cisNaN :: forall a. RealFloat a => Ref a -> Bool
scaleFloat :: Int -> Ref a -> Ref a
$cscaleFloat :: forall a. RealFloat a => Int -> Ref a -> Ref a
significand :: Ref a -> Ref a
$csignificand :: forall a. RealFloat a => Ref a -> Ref a
exponent :: Ref a -> Int
$cexponent :: forall a. RealFloat a => Ref a -> Int
encodeFloat :: Integer -> Int -> Ref a
$cencodeFloat :: forall a. RealFloat a => Integer -> Int -> Ref a
decodeFloat :: Ref a -> (Integer, Int)
$cdecodeFloat :: forall a. RealFloat a => Ref a -> (Integer, Int)
floatRange :: Ref a -> (Int, Int)
$cfloatRange :: forall a. RealFloat a => Ref a -> (Int, Int)
floatDigits :: Ref a -> Int
$cfloatDigits :: forall a. RealFloat a => Ref a -> Int
floatRadix :: Ref a -> Integer
$cfloatRadix :: forall a. RealFloat a => Ref a -> Integer
$cp2RealFloat :: forall a. RealFloat a => Floating (Ref a)
$cp1RealFloat :: forall a. RealFloat a => RealFrac (Ref a)
RealFloat
        , Ptr b -> Int -> IO (Ref a)
Ptr b -> Int -> Ref a -> IO ()
Ptr (Ref a) -> IO (Ref a)
Ptr (Ref a) -> Int -> IO (Ref a)
Ptr (Ref a) -> Int -> Ref a -> IO ()
Ptr (Ref a) -> Ref a -> IO ()
Ref a -> Int
(Ref a -> Int)
-> (Ref a -> Int)
-> (Ptr (Ref a) -> Int -> IO (Ref a))
-> (Ptr (Ref a) -> Int -> Ref a -> IO ())
-> (forall b. Ptr b -> Int -> IO (Ref a))
-> (forall b. Ptr b -> Int -> Ref a -> IO ())
-> (Ptr (Ref a) -> IO (Ref a))
-> (Ptr (Ref a) -> Ref a -> IO ())
-> Storable (Ref a)
forall b. Ptr b -> Int -> IO (Ref a)
forall b. Ptr b -> Int -> Ref a -> IO ()
forall a. Storable a => Ptr (Ref a) -> IO (Ref a)
forall a. Storable a => Ptr (Ref a) -> Int -> IO (Ref a)
forall a. Storable a => Ptr (Ref a) -> Int -> Ref a -> IO ()
forall a. Storable a => Ptr (Ref a) -> Ref a -> IO ()
forall a. Storable a => Ref a -> Int
forall a b. Storable a => Ptr b -> Int -> IO (Ref a)
forall a b. Storable a => Ptr b -> Int -> Ref a -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr (Ref a) -> Ref a -> IO ()
$cpoke :: forall a. Storable a => Ptr (Ref a) -> Ref a -> IO ()
peek :: Ptr (Ref a) -> IO (Ref a)
$cpeek :: forall a. Storable a => Ptr (Ref a) -> IO (Ref a)
pokeByteOff :: Ptr b -> Int -> Ref a -> IO ()
$cpokeByteOff :: forall a b. Storable a => Ptr b -> Int -> Ref a -> IO ()
peekByteOff :: Ptr b -> Int -> IO (Ref a)
$cpeekByteOff :: forall a b. Storable a => Ptr b -> Int -> IO (Ref a)
pokeElemOff :: Ptr (Ref a) -> Int -> Ref a -> IO ()
$cpokeElemOff :: forall a. Storable a => Ptr (Ref a) -> Int -> Ref a -> IO ()
peekElemOff :: Ptr (Ref a) -> Int -> IO (Ref a)
$cpeekElemOff :: forall a. Storable a => Ptr (Ref a) -> Int -> IO (Ref a)
alignment :: Ref a -> Int
$calignment :: forall a. Storable a => Ref a -> Int
sizeOf :: Ref a -> Int
$csizeOf :: forall a. Storable a => Ref a -> Int
Storable
        )

instance Functor Ref where
    fmap :: (a -> b) -> Ref a -> Ref b
fmap f :: a -> b
f (Ref x :: a
x) = b -> Ref b
forall a. a -> Ref a
Ref (b -> Ref b) -> b -> Ref b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
x

instance Applicative Ref where
    pure :: a -> Ref a
pure = a -> Ref a
forall a. a -> Ref a
Ref
    (Ref f :: a -> b
f) <*> :: Ref (a -> b) -> Ref a -> Ref b
<*> (Ref x :: a
x) = b -> Ref b
forall a. a -> Ref a
Ref (b -> Ref b) -> b -> Ref b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
x

instance Monad Ref where
    return :: a -> Ref a
return = a -> Ref a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Ref x :: a
x) >>= :: Ref a -> (a -> Ref b) -> Ref b
>>= f :: a -> Ref b
f = a -> Ref b
f a
x

instance MonadFix Ref where
    mfix :: (a -> Ref a) -> Ref a
mfix f :: a -> Ref a
f = a -> Ref a
forall a. a -> Ref a
Ref ((a -> a) -> a
forall a. (a -> a) -> a
fix (Ref a -> a
forall a. Ref a -> a
runRef (Ref a -> a) -> (a -> Ref a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Ref a
f))

instance MonadZip Ref where
    mzipWith :: (a -> b -> c) -> Ref a -> Ref b -> Ref c
mzipWith = (a -> b -> c) -> Ref a -> Ref b -> Ref c
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2
    munzip :: Ref (a, b) -> (Ref a, Ref b)
munzip (Ref x :: (a, b)
x) = a -> Ref a
forall a. a -> Ref a
Ref (a -> Ref a) -> (b -> Ref b) -> (a, b) -> (Ref a, Ref b)
forall a a' b b'. (a -> a') -> (b -> b') -> (a, b) -> (a', b')
*** b -> Ref b
forall a. a -> Ref a
Ref ((a, b) -> (Ref a, Ref b)) -> (a, b) -> (Ref a, Ref b)
forall a b. (a -> b) -> a -> b
$ (a, b)
x

instance IsOperand a => Show (Ref a) where
    show :: Ref a -> String
show (Ref x :: a
x) = "[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ "]"