{-# LINE 1 "src/Lua/Types.hsc" #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PatternSynonyms            #-}
{-|
Module      : Lua.Types
Copyright   : © 2007–2012 Gracjan Polak;
              © 2012–2016 Ömer Sinan Ağacan;
              © 2017-2023 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <tarleb@hslua.org>
Stability   : beta
Portability : non-portable (depends on GHC)

The core Lua types, including mappings of Lua types to Haskell.
-}
module Lua.Types
  ( State (..)
  , Reader
  , TypeCode (..)
  , CFunction
  , PreCFunction
  , WarnFunction
  , PreWarnFunction
  , LuaBool (..)
  , Integer (..)
  , Number (..)
  , StackIndex (..)
  , NumArgs (..)
  , NumResults (..)
  , OPCode (..)
  , ArithOPCode (..)
  , StatusCode (..)
    -- * Garbage-Collection
  , GCCode (..)
  )
where



import Prelude hiding (Integer)

import Data.Bifunctor (first)
import Data.Int (Int64)
{-# LINE 44 "src/Lua/Types.hsc" #-}
import Foreign.C (CChar, CInt, CSize, CString)
import Foreign.Ptr (FunPtr, Ptr)
import Foreign.Storable (Storable)
import GHC.Generics (Generic)

-- | An opaque structure that points to a thread and indirectly (through the
-- thread) to the whole state of a Lua interpreter. The Lua library is fully
-- reentrant: it has no global variables. All information about a state is
-- accessible through this structure.
--
-- Synonym for @lua_State *@. See
-- <https://www.lua.org/manual/5.4/#lua_State lua_State>.
newtype State = State (Ptr ()) deriving (State -> State -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: State -> State -> Bool
$c/= :: State -> State -> Bool
== :: State -> State -> Bool
$c== :: State -> State -> Bool
Eq, forall x. Rep State x -> State
forall x. State -> Rep State x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep State x -> State
$cfrom :: forall x. State -> Rep State x
Generic)

-- |  Type for C functions.
--
-- In order to communicate properly with Lua, a C function must use the
-- following protocol, which defines the way parameters and results are
-- passed: a C function receives its arguments from Lua in its stack in
-- direct order (the first argument is pushed first). So, when the
-- function starts, @'Lua.Functions.lua_gettop'@ returns the
-- number of arguments received by the function. The first argument (if
-- any) is at index 1 and its last argument is at index
-- @'Lua.Functions.lua_gettop'@. To return values to Lua, a C
-- function just pushes them onto the stack, in direct order (the first
-- result is pushed first), and returns the number of results. Any other
-- value in the stack below the results will be properly discarded by
-- Lua. Like a Lua function, a C function called by Lua can also return
-- many results.
--
-- See
-- <https://www.lua.org/manual/5.4/manual.html#lua_CFunction lua_CFunction>.
type CFunction = FunPtr PreCFunction

-- | Type of Haskell functions that can be turned into C functions.
--
-- This is the same as a dereferenced 'CFunction'.
type PreCFunction = State -> IO NumResults

-- | The reader function used by @'Lua.load'@.
-- Every time it needs another piece of the chunk, lua_load calls the
-- reader, passing along its data parameter. The reader must return a
-- pointer to a block of memory with a new piece of the chunk and set
-- size to the block size. The block must exist until the reader
-- function is called again. To signal the end of the chunk, the reader
-- must return @NULL@ or set size to zero. The reader function may
-- return pieces of any size greater than zero.
--
-- See <https://www.lua.org/manual/5.4/manual.html#lua_Reader lua_Reader>.
type Reader = FunPtr (State -> Ptr () -> Ptr CSize -> IO (Ptr CChar))

-- | The type of warning functions, called by Lua to emit warnings. The
-- first parameter is an opaque pointer set by 'lua_setwarnf'. The
-- second parameter is the warning message. The third parameter is a
-- boolean that indicates whether the message is to be continued by the
-- message in the next call.
--
-- See <https://www.lua.org/manual/5.4/manual.html#pdf-warn warn> for
-- more details about warnings.
type WarnFunction = FunPtr (Ptr () -> CString -> LuaBool -> IO ())

-- | Type of Haskell functions that can be turned into a WarnFunction.
--
-- This is the same as a dereferenced 'WarnFunction'.
type PreWarnFunction = Ptr () -> CString -> LuaBool -> IO ()


-- |  The type of integers in Lua.
--
-- By default this type is @'Int64'@, but that can be changed to
-- different values in Lua. (See @LUA_INT_TYPE@ in @luaconf.h@.)
--
-- See <https://www.lua.org/manual/5.4/manual.html#lua_Integer lua_Integer>.
newtype Integer = Integer Int64
{-# LINE 118 "src/Lua/Types.hsc" #-}
  deriving (Bounded, Enum, Eq, Integral, Num, Ord, Real)
-- we should be able to use deriving strategies if we decide to drop
-- support for GHC 8.0
instance Show Integer where
  show :: Integer -> String
show (Integer Int64
i) = forall a. Show a => a -> String
show Int64
i
instance Read Integer where
  readsPrec :: Int -> ReadS Integer
readsPrec Int
i = forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Int64 -> Integer
Integer) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => Int -> ReadS a
readsPrec Int
i

-- |  The type of floats in Lua.
--
-- By default this type is @'Double'@, but that can be changed in Lua to
-- a single float or a long double. (See @LUA_FLOAT_TYPE@ in
-- @luaconf.h@.)
--
-- See <https://www.lua.org/manual/5.4/manual.html#lua_Number lua_Number>.
newtype Number = Number Double
{-# LINE 134 "src/Lua/Types.hsc" #-}
  deriving (Eq, Floating, Fractional, Num, Ord, Real, RealFloat, RealFrac)
-- we should be able to use deriving strategies if we decide to drop
-- support for GHC 8.0
instance Show Number where
  show :: Number -> String
show (Number Double
n) = forall a. Show a => a -> String
show Double
n
instance Read Number where
  readsPrec :: Int -> ReadS Number
readsPrec Int
i = forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Double -> Number
Number) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => Int -> ReadS a
readsPrec Int
i

-- | Boolean value returned by a Lua C API function. This is a @'CInt'@
-- and should be interpreted as @'False'@ iff the value is @0@, @'True'@
-- otherwise.
newtype LuaBool = LuaBool CInt
  deriving (LuaBool -> LuaBool -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LuaBool -> LuaBool -> Bool
$c/= :: LuaBool -> LuaBool -> Bool
== :: LuaBool -> LuaBool -> Bool
$c== :: LuaBool -> LuaBool -> Bool
Eq, Ptr LuaBool -> IO LuaBool
Ptr LuaBool -> Int -> IO LuaBool
Ptr LuaBool -> Int -> LuaBool -> IO ()
Ptr LuaBool -> LuaBool -> IO ()
LuaBool -> Int
forall b. Ptr b -> Int -> IO LuaBool
forall b. Ptr b -> Int -> LuaBool -> 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 LuaBool -> LuaBool -> IO ()
$cpoke :: Ptr LuaBool -> LuaBool -> IO ()
peek :: Ptr LuaBool -> IO LuaBool
$cpeek :: Ptr LuaBool -> IO LuaBool
pokeByteOff :: forall b. Ptr b -> Int -> LuaBool -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> LuaBool -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO LuaBool
$cpeekByteOff :: forall b. Ptr b -> Int -> IO LuaBool
pokeElemOff :: Ptr LuaBool -> Int -> LuaBool -> IO ()
$cpokeElemOff :: Ptr LuaBool -> Int -> LuaBool -> IO ()
peekElemOff :: Ptr LuaBool -> Int -> IO LuaBool
$cpeekElemOff :: Ptr LuaBool -> Int -> IO LuaBool
alignment :: LuaBool -> Int
$calignment :: LuaBool -> Int
sizeOf :: LuaBool -> Int
$csizeOf :: LuaBool -> Int
Storable, Int -> LuaBool -> ShowS
[LuaBool] -> ShowS
LuaBool -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LuaBool] -> ShowS
$cshowList :: [LuaBool] -> ShowS
show :: LuaBool -> String
$cshow :: LuaBool -> String
showsPrec :: Int -> LuaBool -> ShowS
$cshowsPrec :: Int -> LuaBool -> ShowS
Show)

-- | Integer code used to encode the type of a Lua value.
newtype TypeCode = TypeCode { TypeCode -> CInt
fromTypeCode :: CInt }
  deriving (TypeCode -> TypeCode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeCode -> TypeCode -> Bool
$c/= :: TypeCode -> TypeCode -> Bool
== :: TypeCode -> TypeCode -> Bool
$c== :: TypeCode -> TypeCode -> Bool
Eq, Eq TypeCode
TypeCode -> TypeCode -> Bool
TypeCode -> TypeCode -> Ordering
TypeCode -> TypeCode -> TypeCode
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 :: TypeCode -> TypeCode -> TypeCode
$cmin :: TypeCode -> TypeCode -> TypeCode
max :: TypeCode -> TypeCode -> TypeCode
$cmax :: TypeCode -> TypeCode -> TypeCode
>= :: TypeCode -> TypeCode -> Bool
$c>= :: TypeCode -> TypeCode -> Bool
> :: TypeCode -> TypeCode -> Bool
$c> :: TypeCode -> TypeCode -> Bool
<= :: TypeCode -> TypeCode -> Bool
$c<= :: TypeCode -> TypeCode -> Bool
< :: TypeCode -> TypeCode -> Bool
$c< :: TypeCode -> TypeCode -> Bool
compare :: TypeCode -> TypeCode -> Ordering
$ccompare :: TypeCode -> TypeCode -> Ordering
Ord, Int -> TypeCode -> ShowS
[TypeCode] -> ShowS
TypeCode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeCode] -> ShowS
$cshowList :: [TypeCode] -> ShowS
show :: TypeCode -> String
$cshow :: TypeCode -> String
showsPrec :: Int -> TypeCode -> ShowS
$cshowsPrec :: Int -> TypeCode -> ShowS
Show)

-- | Relational operator code.
newtype OPCode = OPCode CInt deriving (OPCode -> OPCode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OPCode -> OPCode -> Bool
$c/= :: OPCode -> OPCode -> Bool
== :: OPCode -> OPCode -> Bool
$c== :: OPCode -> OPCode -> Bool
Eq, Ptr OPCode -> IO OPCode
Ptr OPCode -> Int -> IO OPCode
Ptr OPCode -> Int -> OPCode -> IO ()
Ptr OPCode -> OPCode -> IO ()
OPCode -> Int
forall b. Ptr b -> Int -> IO OPCode
forall b. Ptr b -> Int -> OPCode -> 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 OPCode -> OPCode -> IO ()
$cpoke :: Ptr OPCode -> OPCode -> IO ()
peek :: Ptr OPCode -> IO OPCode
$cpeek :: Ptr OPCode -> IO OPCode
pokeByteOff :: forall b. Ptr b -> Int -> OPCode -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> OPCode -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO OPCode
$cpeekByteOff :: forall b. Ptr b -> Int -> IO OPCode
pokeElemOff :: Ptr OPCode -> Int -> OPCode -> IO ()
$cpokeElemOff :: Ptr OPCode -> Int -> OPCode -> IO ()
peekElemOff :: Ptr OPCode -> Int -> IO OPCode
$cpeekElemOff :: Ptr OPCode -> Int -> IO OPCode
alignment :: OPCode -> Int
$calignment :: OPCode -> Int
sizeOf :: OPCode -> Int
$csizeOf :: OPCode -> Int
Storable, Int -> OPCode -> ShowS
[OPCode] -> ShowS
OPCode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OPCode] -> ShowS
$cshowList :: [OPCode] -> ShowS
show :: OPCode -> String
$cshow :: OPCode -> String
showsPrec :: Int -> OPCode -> ShowS
$cshowsPrec :: Int -> OPCode -> ShowS
Show)

-- | Arithmetic operator code.
newtype ArithOPCode = ArithOPCode CInt deriving (ArithOPCode -> ArithOPCode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArithOPCode -> ArithOPCode -> Bool
$c/= :: ArithOPCode -> ArithOPCode -> Bool
== :: ArithOPCode -> ArithOPCode -> Bool
$c== :: ArithOPCode -> ArithOPCode -> Bool
Eq, Ptr ArithOPCode -> IO ArithOPCode
Ptr ArithOPCode -> Int -> IO ArithOPCode
Ptr ArithOPCode -> Int -> ArithOPCode -> IO ()
Ptr ArithOPCode -> ArithOPCode -> IO ()
ArithOPCode -> Int
forall b. Ptr b -> Int -> IO ArithOPCode
forall b. Ptr b -> Int -> ArithOPCode -> 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 ArithOPCode -> ArithOPCode -> IO ()
$cpoke :: Ptr ArithOPCode -> ArithOPCode -> IO ()
peek :: Ptr ArithOPCode -> IO ArithOPCode
$cpeek :: Ptr ArithOPCode -> IO ArithOPCode
pokeByteOff :: forall b. Ptr b -> Int -> ArithOPCode -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> ArithOPCode -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO ArithOPCode
$cpeekByteOff :: forall b. Ptr b -> Int -> IO ArithOPCode
pokeElemOff :: Ptr ArithOPCode -> Int -> ArithOPCode -> IO ()
$cpokeElemOff :: Ptr ArithOPCode -> Int -> ArithOPCode -> IO ()
peekElemOff :: Ptr ArithOPCode -> Int -> IO ArithOPCode
$cpeekElemOff :: Ptr ArithOPCode -> Int -> IO ArithOPCode
alignment :: ArithOPCode -> Int
$calignment :: ArithOPCode -> Int
sizeOf :: ArithOPCode -> Int
$csizeOf :: ArithOPCode -> Int
Storable, Int -> ArithOPCode -> ShowS
[ArithOPCode] -> ShowS
ArithOPCode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArithOPCode] -> ShowS
$cshowList :: [ArithOPCode] -> ShowS
show :: ArithOPCode -> String
$cshow :: ArithOPCode -> String
showsPrec :: Int -> ArithOPCode -> ShowS
$cshowsPrec :: Int -> ArithOPCode -> ShowS
Show)

-- | Integer code used to signal the status of a thread or computation.
newtype StatusCode = StatusCode CInt deriving (StatusCode -> StatusCode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StatusCode -> StatusCode -> Bool
$c/= :: StatusCode -> StatusCode -> Bool
== :: StatusCode -> StatusCode -> Bool
$c== :: StatusCode -> StatusCode -> Bool
Eq, Ptr StatusCode -> IO StatusCode
Ptr StatusCode -> Int -> IO StatusCode
Ptr StatusCode -> Int -> StatusCode -> IO ()
Ptr StatusCode -> StatusCode -> IO ()
StatusCode -> Int
forall b. Ptr b -> Int -> IO StatusCode
forall b. Ptr b -> Int -> StatusCode -> 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 StatusCode -> StatusCode -> IO ()
$cpoke :: Ptr StatusCode -> StatusCode -> IO ()
peek :: Ptr StatusCode -> IO StatusCode
$cpeek :: Ptr StatusCode -> IO StatusCode
pokeByteOff :: forall b. Ptr b -> Int -> StatusCode -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> StatusCode -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO StatusCode
$cpeekByteOff :: forall b. Ptr b -> Int -> IO StatusCode
pokeElemOff :: Ptr StatusCode -> Int -> StatusCode -> IO ()
$cpokeElemOff :: Ptr StatusCode -> Int -> StatusCode -> IO ()
peekElemOff :: Ptr StatusCode -> Int -> IO StatusCode
$cpeekElemOff :: Ptr StatusCode -> Int -> IO StatusCode
alignment :: StatusCode -> Int
$calignment :: StatusCode -> Int
sizeOf :: StatusCode -> Int
$csizeOf :: StatusCode -> Int
Storable, Int -> StatusCode -> ShowS
[StatusCode] -> ShowS
StatusCode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StatusCode] -> ShowS
$cshowList :: [StatusCode] -> ShowS
show :: StatusCode -> String
$cshow :: StatusCode -> String
showsPrec :: Int -> StatusCode -> ShowS
$cshowsPrec :: Int -> StatusCode -> ShowS
Show)

-- | Garbage-collection options.
newtype GCCode = GCCode CInt deriving (GCCode -> GCCode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GCCode -> GCCode -> Bool
$c/= :: GCCode -> GCCode -> Bool
== :: GCCode -> GCCode -> Bool
$c== :: GCCode -> GCCode -> Bool
Eq, Ptr GCCode -> IO GCCode
Ptr GCCode -> Int -> IO GCCode
Ptr GCCode -> Int -> GCCode -> IO ()
Ptr GCCode -> GCCode -> IO ()
GCCode -> Int
forall b. Ptr b -> Int -> IO GCCode
forall b. Ptr b -> Int -> GCCode -> 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 GCCode -> GCCode -> IO ()
$cpoke :: Ptr GCCode -> GCCode -> IO ()
peek :: Ptr GCCode -> IO GCCode
$cpeek :: Ptr GCCode -> IO GCCode
pokeByteOff :: forall b. Ptr b -> Int -> GCCode -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> GCCode -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO GCCode
$cpeekByteOff :: forall b. Ptr b -> Int -> IO GCCode
pokeElemOff :: Ptr GCCode -> Int -> GCCode -> IO ()
$cpokeElemOff :: Ptr GCCode -> Int -> GCCode -> IO ()
peekElemOff :: Ptr GCCode -> Int -> IO GCCode
$cpeekElemOff :: Ptr GCCode -> Int -> IO GCCode
alignment :: GCCode -> Int
$calignment :: GCCode -> Int
sizeOf :: GCCode -> Int
$csizeOf :: GCCode -> Int
Storable, Int -> GCCode -> ShowS
[GCCode] -> ShowS
GCCode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GCCode] -> ShowS
$cshowList :: [GCCode] -> ShowS
show :: GCCode -> String
$cshow :: GCCode -> String
showsPrec :: Int -> GCCode -> ShowS
$cshowsPrec :: Int -> GCCode -> ShowS
Show)

-- | A stack index
newtype StackIndex = StackIndex { StackIndex -> CInt
fromStackIndex :: CInt }
  deriving (Int -> StackIndex
StackIndex -> Int
StackIndex -> [StackIndex]
StackIndex -> StackIndex
StackIndex -> StackIndex -> [StackIndex]
StackIndex -> StackIndex -> StackIndex -> [StackIndex]
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 :: StackIndex -> StackIndex -> StackIndex -> [StackIndex]
$cenumFromThenTo :: StackIndex -> StackIndex -> StackIndex -> [StackIndex]
enumFromTo :: StackIndex -> StackIndex -> [StackIndex]
$cenumFromTo :: StackIndex -> StackIndex -> [StackIndex]
enumFromThen :: StackIndex -> StackIndex -> [StackIndex]
$cenumFromThen :: StackIndex -> StackIndex -> [StackIndex]
enumFrom :: StackIndex -> [StackIndex]
$cenumFrom :: StackIndex -> [StackIndex]
fromEnum :: StackIndex -> Int
$cfromEnum :: StackIndex -> Int
toEnum :: Int -> StackIndex
$ctoEnum :: Int -> StackIndex
pred :: StackIndex -> StackIndex
$cpred :: StackIndex -> StackIndex
succ :: StackIndex -> StackIndex
$csucc :: StackIndex -> StackIndex
Enum, StackIndex -> StackIndex -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StackIndex -> StackIndex -> Bool
$c/= :: StackIndex -> StackIndex -> Bool
== :: StackIndex -> StackIndex -> Bool
$c== :: StackIndex -> StackIndex -> Bool
Eq, Integer -> StackIndex
StackIndex -> StackIndex
StackIndex -> StackIndex -> StackIndex
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> StackIndex
$cfromInteger :: Integer -> StackIndex
signum :: StackIndex -> StackIndex
$csignum :: StackIndex -> StackIndex
abs :: StackIndex -> StackIndex
$cabs :: StackIndex -> StackIndex
negate :: StackIndex -> StackIndex
$cnegate :: StackIndex -> StackIndex
* :: StackIndex -> StackIndex -> StackIndex
$c* :: StackIndex -> StackIndex -> StackIndex
- :: StackIndex -> StackIndex -> StackIndex
$c- :: StackIndex -> StackIndex -> StackIndex
+ :: StackIndex -> StackIndex -> StackIndex
$c+ :: StackIndex -> StackIndex -> StackIndex
Num, Eq StackIndex
StackIndex -> StackIndex -> Bool
StackIndex -> StackIndex -> Ordering
StackIndex -> StackIndex -> StackIndex
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 :: StackIndex -> StackIndex -> StackIndex
$cmin :: StackIndex -> StackIndex -> StackIndex
max :: StackIndex -> StackIndex -> StackIndex
$cmax :: StackIndex -> StackIndex -> StackIndex
>= :: StackIndex -> StackIndex -> Bool
$c>= :: StackIndex -> StackIndex -> Bool
> :: StackIndex -> StackIndex -> Bool
$c> :: StackIndex -> StackIndex -> Bool
<= :: StackIndex -> StackIndex -> Bool
$c<= :: StackIndex -> StackIndex -> Bool
< :: StackIndex -> StackIndex -> Bool
$c< :: StackIndex -> StackIndex -> Bool
compare :: StackIndex -> StackIndex -> Ordering
$ccompare :: StackIndex -> StackIndex -> Ordering
Ord, Int -> StackIndex -> ShowS
[StackIndex] -> ShowS
StackIndex -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StackIndex] -> ShowS
$cshowList :: [StackIndex] -> ShowS
show :: StackIndex -> String
$cshow :: StackIndex -> String
showsPrec :: Int -> StackIndex -> ShowS
$cshowsPrec :: Int -> StackIndex -> ShowS
Show)

--
-- Number of arguments and return values
--

-- | The number of arguments consumed curing a function call.
newtype NumArgs = NumArgs { NumArgs -> CInt
fromNumArgs :: CInt }
  deriving (NumArgs -> NumArgs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NumArgs -> NumArgs -> Bool
$c/= :: NumArgs -> NumArgs -> Bool
== :: NumArgs -> NumArgs -> Bool
$c== :: NumArgs -> NumArgs -> Bool
Eq, Integer -> NumArgs
NumArgs -> NumArgs
NumArgs -> NumArgs -> NumArgs
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> NumArgs
$cfromInteger :: Integer -> NumArgs
signum :: NumArgs -> NumArgs
$csignum :: NumArgs -> NumArgs
abs :: NumArgs -> NumArgs
$cabs :: NumArgs -> NumArgs
negate :: NumArgs -> NumArgs
$cnegate :: NumArgs -> NumArgs
* :: NumArgs -> NumArgs -> NumArgs
$c* :: NumArgs -> NumArgs -> NumArgs
- :: NumArgs -> NumArgs -> NumArgs
$c- :: NumArgs -> NumArgs -> NumArgs
+ :: NumArgs -> NumArgs -> NumArgs
$c+ :: NumArgs -> NumArgs -> NumArgs
Num, Eq NumArgs
NumArgs -> NumArgs -> Bool
NumArgs -> NumArgs -> Ordering
NumArgs -> NumArgs -> NumArgs
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 :: NumArgs -> NumArgs -> NumArgs
$cmin :: NumArgs -> NumArgs -> NumArgs
max :: NumArgs -> NumArgs -> NumArgs
$cmax :: NumArgs -> NumArgs -> NumArgs
>= :: NumArgs -> NumArgs -> Bool
$c>= :: NumArgs -> NumArgs -> Bool
> :: NumArgs -> NumArgs -> Bool
$c> :: NumArgs -> NumArgs -> Bool
<= :: NumArgs -> NumArgs -> Bool
$c<= :: NumArgs -> NumArgs -> Bool
< :: NumArgs -> NumArgs -> Bool
$c< :: NumArgs -> NumArgs -> Bool
compare :: NumArgs -> NumArgs -> Ordering
$ccompare :: NumArgs -> NumArgs -> Ordering
Ord, Int -> NumArgs -> ShowS
[NumArgs] -> ShowS
NumArgs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NumArgs] -> ShowS
$cshowList :: [NumArgs] -> ShowS
show :: NumArgs -> String
$cshow :: NumArgs -> String
showsPrec :: Int -> NumArgs -> ShowS
$cshowsPrec :: Int -> NumArgs -> ShowS
Show)

-- | The number of results returned by a function call.
newtype NumResults = NumResults { NumResults -> CInt
fromNumResults :: CInt }
  deriving (NumResults -> NumResults -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NumResults -> NumResults -> Bool
$c/= :: NumResults -> NumResults -> Bool
== :: NumResults -> NumResults -> Bool
$c== :: NumResults -> NumResults -> Bool
Eq, Integer -> NumResults
NumResults -> NumResults
NumResults -> NumResults -> NumResults
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> NumResults
$cfromInteger :: Integer -> NumResults
signum :: NumResults -> NumResults
$csignum :: NumResults -> NumResults
abs :: NumResults -> NumResults
$cabs :: NumResults -> NumResults
negate :: NumResults -> NumResults
$cnegate :: NumResults -> NumResults
* :: NumResults -> NumResults -> NumResults
$c* :: NumResults -> NumResults -> NumResults
- :: NumResults -> NumResults -> NumResults
$c- :: NumResults -> NumResults -> NumResults
+ :: NumResults -> NumResults -> NumResults
$c+ :: NumResults -> NumResults -> NumResults
Num, Eq NumResults
NumResults -> NumResults -> Bool
NumResults -> NumResults -> Ordering
NumResults -> NumResults -> NumResults
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 :: NumResults -> NumResults -> NumResults
$cmin :: NumResults -> NumResults -> NumResults
max :: NumResults -> NumResults -> NumResults
$cmax :: NumResults -> NumResults -> NumResults
>= :: NumResults -> NumResults -> Bool
$c>= :: NumResults -> NumResults -> Bool
> :: NumResults -> NumResults -> Bool
$c> :: NumResults -> NumResults -> Bool
<= :: NumResults -> NumResults -> Bool
$c<= :: NumResults -> NumResults -> Bool
< :: NumResults -> NumResults -> Bool
$c< :: NumResults -> NumResults -> Bool
compare :: NumResults -> NumResults -> Ordering
$ccompare :: NumResults -> NumResults -> Ordering
Ord, Int -> NumResults -> ShowS
[NumResults] -> ShowS
NumResults -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NumResults] -> ShowS
$cshowList :: [NumResults] -> ShowS
show :: NumResults -> String
$cshow :: NumResults -> String
showsPrec :: Int -> NumResults -> ShowS
$cshowsPrec :: Int -> NumResults -> ShowS
Show)