-- ElementType.hs ---

-- Copyright (C) 2020 Nerd Ed

-- Author: Nerd Ed <nerded.nerded@gmail.com>

-- This program is free software; you can redistribute it and/or
-- modify it under the terms of the GNU General Public License
-- as published by the Free Software Foundation; either version 3
-- of the License, or (at your option) any later version.

-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.

-- You should have received a copy of the GNU General Public License
-- along with this program. If not, see <http://www.gnu.org/licenses/>.

{-# LANGUAGE DerivingVia #-}

module Zydis.ElementType
  ( ElementType(..)
  )
where

import           Zydis.Util

data ElementType
  = ElementTypeInvalid
  | ElementTypeStruct
  | ElementTypeUint
  | ElementTypeInt
  | ElementTypeFloat16
  | ElementTypeFloat32
  | ElementTypeFloat64
  | ElementTypeFloat80
  | ElementTypeLongbcd
  | ElementTypeCc
  deriving stock (Int -> ElementType -> ShowS
[ElementType] -> ShowS
ElementType -> String
(Int -> ElementType -> ShowS)
-> (ElementType -> String)
-> ([ElementType] -> ShowS)
-> Show ElementType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ElementType] -> ShowS
$cshowList :: [ElementType] -> ShowS
show :: ElementType -> String
$cshow :: ElementType -> String
showsPrec :: Int -> ElementType -> ShowS
$cshowsPrec :: Int -> ElementType -> ShowS
Show, ElementType -> ElementType -> Bool
(ElementType -> ElementType -> Bool)
-> (ElementType -> ElementType -> Bool) -> Eq ElementType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ElementType -> ElementType -> Bool
$c/= :: ElementType -> ElementType -> Bool
== :: ElementType -> ElementType -> Bool
$c== :: ElementType -> ElementType -> Bool
Eq, ElementType
ElementType -> ElementType -> Bounded ElementType
forall a. a -> a -> Bounded a
maxBound :: ElementType
$cmaxBound :: ElementType
minBound :: ElementType
$cminBound :: ElementType
Bounded, Int -> ElementType
ElementType -> Int
ElementType -> [ElementType]
ElementType -> ElementType
ElementType -> ElementType -> [ElementType]
ElementType -> ElementType -> ElementType -> [ElementType]
(ElementType -> ElementType)
-> (ElementType -> ElementType)
-> (Int -> ElementType)
-> (ElementType -> Int)
-> (ElementType -> [ElementType])
-> (ElementType -> ElementType -> [ElementType])
-> (ElementType -> ElementType -> [ElementType])
-> (ElementType -> ElementType -> ElementType -> [ElementType])
-> Enum ElementType
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 :: ElementType -> ElementType -> ElementType -> [ElementType]
$cenumFromThenTo :: ElementType -> ElementType -> ElementType -> [ElementType]
enumFromTo :: ElementType -> ElementType -> [ElementType]
$cenumFromTo :: ElementType -> ElementType -> [ElementType]
enumFromThen :: ElementType -> ElementType -> [ElementType]
$cenumFromThen :: ElementType -> ElementType -> [ElementType]
enumFrom :: ElementType -> [ElementType]
$cenumFrom :: ElementType -> [ElementType]
fromEnum :: ElementType -> Int
$cfromEnum :: ElementType -> Int
toEnum :: Int -> ElementType
$ctoEnum :: Int -> ElementType
pred :: ElementType -> ElementType
$cpred :: ElementType -> ElementType
succ :: ElementType -> ElementType
$csucc :: ElementType -> ElementType
Enum)
  deriving Ptr b -> Int -> IO ElementType
Ptr b -> Int -> ElementType -> IO ()
Ptr ElementType -> IO ElementType
Ptr ElementType -> Int -> IO ElementType
Ptr ElementType -> Int -> ElementType -> IO ()
Ptr ElementType -> ElementType -> IO ()
ElementType -> Int
(ElementType -> Int)
-> (ElementType -> Int)
-> (Ptr ElementType -> Int -> IO ElementType)
-> (Ptr ElementType -> Int -> ElementType -> IO ())
-> (forall b. Ptr b -> Int -> IO ElementType)
-> (forall b. Ptr b -> Int -> ElementType -> IO ())
-> (Ptr ElementType -> IO ElementType)
-> (Ptr ElementType -> ElementType -> IO ())
-> Storable ElementType
forall b. Ptr b -> Int -> IO ElementType
forall b. Ptr b -> Int -> ElementType -> 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 ElementType -> ElementType -> IO ()
$cpoke :: Ptr ElementType -> ElementType -> IO ()
peek :: Ptr ElementType -> IO ElementType
$cpeek :: Ptr ElementType -> IO ElementType
pokeByteOff :: Ptr b -> Int -> ElementType -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> ElementType -> IO ()
peekByteOff :: Ptr b -> Int -> IO ElementType
$cpeekByteOff :: forall b. Ptr b -> Int -> IO ElementType
pokeElemOff :: Ptr ElementType -> Int -> ElementType -> IO ()
$cpokeElemOff :: Ptr ElementType -> Int -> ElementType -> IO ()
peekElemOff :: Ptr ElementType -> Int -> IO ElementType
$cpeekElemOff :: Ptr ElementType -> Int -> IO ElementType
alignment :: ElementType -> Int
$calignment :: ElementType -> Int
sizeOf :: ElementType -> Int
$csizeOf :: ElementType -> Int
Storable via StorableExt ElementType