-- RoundingMode.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.RoundingMode
  ( RoundingMode(..)
  )
where

import           Zydis.Util

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