-- GENERATED by C->Haskell Compiler, version 0.28.8 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Heystone/Internal/Core.chs" #-}
{-# LANGUAGE ForeignFunctionInterface #-}

{-|
Module      : Heystone.Internal.Core
Description : Core Keystone components.
Copyright   : (c) Adrian Herrera, 2016
License     : GPL-2

Defines core Keystone components.

This module should not be directly imported; it is only exposed because of the
way cabal handles ordering of chs files.
-}
module Heystone.Internal.Core where
import qualified Foreign.ForeignPtr as C2HSImp
import qualified Foreign.Ptr as C2HSImp



import Control.Monad
import Control.Monad.Trans.Except (ExceptT)
import Foreign


{-# LINE 20 "src/Heystone/Internal/Core.chs" #-}





-- | The Keystone engine.
newtype Engine = Engine (C2HSImp.ForeignPtr (Engine))
withEngine :: Engine -> (C2HSImp.Ptr Engine -> IO b) -> IO b
withEngine :: forall b. Engine -> (Ptr Engine -> IO b) -> IO b
withEngine (Engine ForeignPtr Engine
fptr) = ForeignPtr Engine -> (Ptr Engine -> IO b) -> IO b
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
C2HSImp.withForeignPtr ForeignPtr Engine
fptr
{-# LINE 29 "src/Heystone/Internal/Core.chs" #-}


-- | A pointer to the Keystone engine.
type EnginePtr = C2HSImp.Ptr (Engine)
{-# LINE 32 "src/Heystone/Internal/Core.chs" #-}


-- | Make a new Keystone engine out of an engine pointer. The returned Keystone
-- engine will automatically call @ks_close_wrapper@ when it goes out of scope.
mkEngine :: EnginePtr
         -> IO Engine
mkEngine :: Ptr Engine -> IO Engine
mkEngine Ptr Engine
ptr =
    (ForeignPtr Engine -> Engine)
-> IO (ForeignPtr Engine) -> IO Engine
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ForeignPtr Engine -> Engine
Engine (FinalizerPtr Engine -> Ptr Engine -> IO (ForeignPtr Engine)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr Engine
close Ptr Engine
ptr)

-- | Errors encountered by the Keystone API. These values are returned by
--   'Heystone.errno'.
data Error = ErrOk
           | ErrNomem
           | ErrArch
           | ErrHandle
           | ErrMode
           | ErrVersion
           | ErrOptInvalid
           | ErrAsmExprToken
           | ErrAsmDirectiveValueRange
           | ErrAsmDirectiveId
           | ErrAsmDirectiveToken
           | ErrAsmDirectiveStr
           | ErrAsmDirectiveComma
           | ErrAsmDirectiveRelocName
           | ErrAsmDirectiveRelocToken
           | ErrAsmDirectiveFpoint
           | ErrAsmDirectiveUnknown
           | ErrAsmDirectiveEqu
           | ErrAsmDirectiveInvalid
           | ErrAsmVariantInvalid
           | ErrAsmExprBracket
           | ErrAsmSymbolModifier
           | ErrAsmSymbolRedefined
           | ErrAsmSymbolMissing
           | ErrAsmRparen
           | ErrAsmStatToken
           | ErrAsmUnsupported
           | ErrAsmMacroToken
           | ErrAsmMacroParen
           | ErrAsmMacroEqu
           | ErrAsmMacroArgs
           | ErrAsmMacroLevelsExceed
           | ErrAsmMacroStr
           | ErrAsmMacroInvalid
           | ErrAsmEscBackslash
           | ErrAsmEscOctal
           | ErrAsmEscSequence
           | ErrAsmEscStr
           | ErrAsmTokenInvalid
           | ErrAsmInsnUnsupported
           | ErrAsmFixupInvalid
           | ErrAsmLabelInvalid
           | ErrAsmFragmentInvalid
           | ErrAsmInvalidoperand
           | ErrAsmMissingfeature
           | ErrAsmMnemonicfail
  deriving (Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
(Int -> Error -> ShowS)
-> (Error -> String) -> ([Error] -> ShowS) -> Show Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Error] -> ShowS
$cshowList :: [Error] -> ShowS
show :: Error -> String
$cshow :: Error -> String
showsPrec :: Int -> Error -> ShowS
$cshowsPrec :: Int -> Error -> ShowS
Show,Error -> Error -> Bool
(Error -> Error -> Bool) -> (Error -> Error -> Bool) -> Eq Error
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c== :: Error -> Error -> Bool
Eq,Error
Error -> Error -> Bounded Error
forall a. a -> a -> Bounded a
maxBound :: Error
$cmaxBound :: Error
minBound :: Error
$cminBound :: Error
Bounded)
instance Enum Error where
  succ :: Error -> Error
succ Error
ErrOk = Error
ErrNomem
  succ Error
ErrNomem = Error
ErrArch
  succ Error
ErrArch = Error
ErrHandle
  succ Error
ErrHandle = Error
ErrMode
  succ Error
ErrMode = Error
ErrVersion
  succ Error
ErrVersion = Error
ErrOptInvalid
  succ Error
ErrOptInvalid = Error
ErrAsmExprToken
  succ Error
ErrAsmExprToken = Error
ErrAsmDirectiveValueRange
  succ Error
ErrAsmDirectiveValueRange = Error
ErrAsmDirectiveId
  succ Error
ErrAsmDirectiveId = Error
ErrAsmDirectiveToken
  succ Error
ErrAsmDirectiveToken = Error
ErrAsmDirectiveStr
  succ Error
ErrAsmDirectiveStr = Error
ErrAsmDirectiveComma
  succ Error
ErrAsmDirectiveComma = Error
ErrAsmDirectiveRelocName
  succ Error
ErrAsmDirectiveRelocName = Error
ErrAsmDirectiveRelocToken
  succ Error
ErrAsmDirectiveRelocToken = Error
ErrAsmDirectiveFpoint
  succ Error
ErrAsmDirectiveFpoint = Error
ErrAsmDirectiveUnknown
  succ Error
ErrAsmDirectiveUnknown = Error
ErrAsmDirectiveEqu
  succ Error
ErrAsmDirectiveEqu = Error
ErrAsmDirectiveInvalid
  succ Error
ErrAsmDirectiveInvalid = Error
ErrAsmVariantInvalid
  succ Error
ErrAsmVariantInvalid = Error
ErrAsmExprBracket
  succ Error
ErrAsmExprBracket = Error
ErrAsmSymbolModifier
  succ Error
ErrAsmSymbolModifier = Error
ErrAsmSymbolRedefined
  succ Error
ErrAsmSymbolRedefined = Error
ErrAsmSymbolMissing
  succ Error
ErrAsmSymbolMissing = Error
ErrAsmRparen
  succ Error
ErrAsmRparen = Error
ErrAsmStatToken
  succ Error
ErrAsmStatToken = Error
ErrAsmUnsupported
  succ Error
ErrAsmUnsupported = Error
ErrAsmMacroToken
  succ Error
ErrAsmMacroToken = Error
ErrAsmMacroParen
  succ Error
ErrAsmMacroParen = Error
ErrAsmMacroEqu
  succ Error
ErrAsmMacroEqu = Error
ErrAsmMacroArgs
  succ Error
ErrAsmMacroArgs = Error
ErrAsmMacroLevelsExceed
  succ Error
ErrAsmMacroLevelsExceed = Error
ErrAsmMacroStr
  succ Error
ErrAsmMacroStr = Error
ErrAsmMacroInvalid
  succ Error
ErrAsmMacroInvalid = Error
ErrAsmEscBackslash
  succ Error
ErrAsmEscBackslash = Error
ErrAsmEscOctal
  succ Error
ErrAsmEscOctal = Error
ErrAsmEscSequence
  succ Error
ErrAsmEscSequence = Error
ErrAsmEscStr
  succ Error
ErrAsmEscStr = Error
ErrAsmTokenInvalid
  succ Error
ErrAsmTokenInvalid = Error
ErrAsmInsnUnsupported
  succ Error
ErrAsmInsnUnsupported = Error
ErrAsmFixupInvalid
  succ Error
ErrAsmFixupInvalid = Error
ErrAsmLabelInvalid
  succ Error
ErrAsmLabelInvalid = Error
ErrAsmFragmentInvalid
  succ Error
ErrAsmFragmentInvalid = Error
ErrAsmInvalidoperand
  succ Error
ErrAsmInvalidoperand = Error
ErrAsmMissingfeature
  succ Error
ErrAsmMissingfeature = Error
ErrAsmMnemonicfail
  succ Error
ErrAsmMnemonicfail = String -> Error
forall a. HasCallStack => String -> a
error String
"Error.succ: ErrAsmMnemonicfail has no successor"

  pred :: Error -> Error
pred Error
ErrNomem = Error
ErrOk
  pred Error
ErrArch = Error
ErrNomem
  pred Error
ErrHandle = Error
ErrArch
  pred Error
ErrMode = Error
ErrHandle
  pred Error
ErrVersion = Error
ErrMode
  pred Error
ErrOptInvalid = Error
ErrVersion
  pred Error
ErrAsmExprToken = Error
ErrOptInvalid
  pred Error
ErrAsmDirectiveValueRange = Error
ErrAsmExprToken
  pred Error
ErrAsmDirectiveId = Error
ErrAsmDirectiveValueRange
  pred Error
ErrAsmDirectiveToken = Error
ErrAsmDirectiveId
  pred Error
ErrAsmDirectiveStr = Error
ErrAsmDirectiveToken
  pred Error
ErrAsmDirectiveComma = Error
ErrAsmDirectiveStr
  pred Error
ErrAsmDirectiveRelocName = Error
ErrAsmDirectiveComma
  pred Error
ErrAsmDirectiveRelocToken = Error
ErrAsmDirectiveRelocName
  pred Error
ErrAsmDirectiveFpoint = Error
ErrAsmDirectiveRelocToken
  pred Error
ErrAsmDirectiveUnknown = Error
ErrAsmDirectiveFpoint
  pred Error
ErrAsmDirectiveEqu = Error
ErrAsmDirectiveUnknown
  pred Error
ErrAsmDirectiveInvalid = Error
ErrAsmDirectiveEqu
  pred Error
ErrAsmVariantInvalid = Error
ErrAsmDirectiveInvalid
  pred Error
ErrAsmExprBracket = Error
ErrAsmVariantInvalid
  pred Error
ErrAsmSymbolModifier = Error
ErrAsmExprBracket
  pred Error
ErrAsmSymbolRedefined = Error
ErrAsmSymbolModifier
  pred Error
ErrAsmSymbolMissing = Error
ErrAsmSymbolRedefined
  pred Error
ErrAsmRparen = Error
ErrAsmSymbolMissing
  pred Error
ErrAsmStatToken = Error
ErrAsmRparen
  pred Error
ErrAsmUnsupported = Error
ErrAsmStatToken
  pred Error
ErrAsmMacroToken = Error
ErrAsmUnsupported
  pred Error
ErrAsmMacroParen = Error
ErrAsmMacroToken
  pred Error
ErrAsmMacroEqu = Error
ErrAsmMacroParen
  pred Error
ErrAsmMacroArgs = Error
ErrAsmMacroEqu
  pred Error
ErrAsmMacroLevelsExceed = Error
ErrAsmMacroArgs
  pred Error
ErrAsmMacroStr = Error
ErrAsmMacroLevelsExceed
  pred Error
ErrAsmMacroInvalid = Error
ErrAsmMacroStr
  pred Error
ErrAsmEscBackslash = Error
ErrAsmMacroInvalid
  pred Error
ErrAsmEscOctal = Error
ErrAsmEscBackslash
  pred Error
ErrAsmEscSequence = Error
ErrAsmEscOctal
  pred Error
ErrAsmEscStr = Error
ErrAsmEscSequence
  pred Error
ErrAsmTokenInvalid = Error
ErrAsmEscStr
  pred Error
ErrAsmInsnUnsupported = Error
ErrAsmTokenInvalid
  pred Error
ErrAsmFixupInvalid = Error
ErrAsmInsnUnsupported
  pred Error
ErrAsmLabelInvalid = Error
ErrAsmFixupInvalid
  pred Error
ErrAsmFragmentInvalid = Error
ErrAsmLabelInvalid
  pred Error
ErrAsmInvalidoperand = Error
ErrAsmFragmentInvalid
  pred Error
ErrAsmMissingfeature = Error
ErrAsmInvalidoperand
  pred Error
ErrAsmMnemonicfail = Error
ErrAsmMissingfeature
  pred Error
ErrOk = String -> Error
forall a. HasCallStack => String -> a
error String
"Error.pred: ErrOk has no predecessor"

  enumFromTo :: Error -> Error -> [Error]
enumFromTo Error
from Error
to = Error -> [Error]
go Error
from
    where
      end :: Int
end = Error -> Int
forall a. Enum a => a -> Int
fromEnum Error
to
      go :: Error -> [Error]
go Error
v = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Error -> Int
forall a. Enum a => a -> Int
fromEnum Error
v) Int
end of
                 Ordering
LT -> Error
v Error -> [Error] -> [Error]
forall a. a -> [a] -> [a]
: Error -> [Error]
go (Error -> Error
forall a. Enum a => a -> a
succ Error
v)
                 Ordering
EQ -> [Error
v]
                 Ordering
GT -> []

  enumFrom :: Error -> [Error]
enumFrom Error
from = Error -> Error -> [Error]
forall a. Enum a => a -> a -> [a]
enumFromTo Error
from Error
ErrAsmMnemonicfail

  fromEnum :: Error -> Int
fromEnum Error
ErrOk = Int
0
  fromEnum Error
ErrNomem = Int
1
  fromEnum Error
ErrArch = Int
2
  fromEnum Error
ErrHandle = Int
3
  fromEnum Error
ErrMode = Int
4
  fromEnum Error
ErrVersion = Int
5
  fromEnum Error
ErrOptInvalid = Int
6
  fromEnum Error
ErrAsmExprToken = Int
128
  fromEnum Error
ErrAsmDirectiveValueRange = Int
129
  fromEnum Error
ErrAsmDirectiveId = Int
130
  fromEnum Error
ErrAsmDirectiveToken = Int
131
  fromEnum Error
ErrAsmDirectiveStr = Int
132
  fromEnum Error
ErrAsmDirectiveComma = Int
133
  fromEnum Error
ErrAsmDirectiveRelocName = Int
134
  fromEnum Error
ErrAsmDirectiveRelocToken = Int
135
  fromEnum Error
ErrAsmDirectiveFpoint = Int
136
  fromEnum Error
ErrAsmDirectiveUnknown = Int
137
  fromEnum Error
ErrAsmDirectiveEqu = Int
138
  fromEnum Error
ErrAsmDirectiveInvalid = Int
139
  fromEnum Error
ErrAsmVariantInvalid = Int
140
  fromEnum Error
ErrAsmExprBracket = Int
141
  fromEnum Error
ErrAsmSymbolModifier = Int
142
  fromEnum Error
ErrAsmSymbolRedefined = Int
143
  fromEnum Error
ErrAsmSymbolMissing = Int
144
  fromEnum Error
ErrAsmRparen = Int
145
  fromEnum Error
ErrAsmStatToken = Int
146
  fromEnum Error
ErrAsmUnsupported = Int
147
  fromEnum Error
ErrAsmMacroToken = Int
148
  fromEnum Error
ErrAsmMacroParen = Int
149
  fromEnum Error
ErrAsmMacroEqu = Int
150
  fromEnum Error
ErrAsmMacroArgs = Int
151
  fromEnum Error
ErrAsmMacroLevelsExceed = Int
152
  fromEnum Error
ErrAsmMacroStr = Int
153
  fromEnum Error
ErrAsmMacroInvalid = Int
154
  fromEnum Error
ErrAsmEscBackslash = Int
155
  fromEnum Error
ErrAsmEscOctal = Int
156
  fromEnum Error
ErrAsmEscSequence = Int
157
  fromEnum Error
ErrAsmEscStr = Int
158
  fromEnum Error
ErrAsmTokenInvalid = Int
159
  fromEnum Error
ErrAsmInsnUnsupported = Int
160
  fromEnum Error
ErrAsmFixupInvalid = Int
161
  fromEnum Error
ErrAsmLabelInvalid = Int
162
  fromEnum Error
ErrAsmFragmentInvalid = Int
163
  fromEnum Error
ErrAsmInvalidoperand = Int
512
  fromEnum Error
ErrAsmMissingfeature = Int
513
  fromEnum Error
ErrAsmMnemonicfail = Int
514

  toEnum :: Int -> Error
toEnum Int
0 = Error
ErrOk
  toEnum Int
1 = Error
ErrNomem
  toEnum Int
2 = Error
ErrArch
  toEnum Int
3 = Error
ErrHandle
  toEnum Int
4 = Error
ErrMode
  toEnum Int
5 = Error
ErrVersion
  toEnum Int
6 = Error
ErrOptInvalid
  toEnum Int
128 = Error
ErrAsmExprToken
  toEnum Int
129 = Error
ErrAsmDirectiveValueRange
  toEnum Int
130 = Error
ErrAsmDirectiveId
  toEnum Int
131 = Error
ErrAsmDirectiveToken
  toEnum Int
132 = Error
ErrAsmDirectiveStr
  toEnum Int
133 = Error
ErrAsmDirectiveComma
  toEnum Int
134 = Error
ErrAsmDirectiveRelocName
  toEnum Int
135 = Error
ErrAsmDirectiveRelocToken
  toEnum Int
136 = Error
ErrAsmDirectiveFpoint
  toEnum Int
137 = Error
ErrAsmDirectiveUnknown
  toEnum Int
138 = Error
ErrAsmDirectiveEqu
  toEnum Int
139 = Error
ErrAsmDirectiveInvalid
  toEnum Int
140 = Error
ErrAsmVariantInvalid
  toEnum Int
141 = Error
ErrAsmExprBracket
  toEnum Int
142 = Error
ErrAsmSymbolModifier
  toEnum Int
143 = Error
ErrAsmSymbolRedefined
  toEnum Int
144 = Error
ErrAsmSymbolMissing
  toEnum Int
145 = Error
ErrAsmRparen
  toEnum Int
146 = Error
ErrAsmStatToken
  toEnum Int
147 = Error
ErrAsmUnsupported
  toEnum Int
148 = Error
ErrAsmMacroToken
  toEnum Int
149 = Error
ErrAsmMacroParen
  toEnum Int
150 = Error
ErrAsmMacroEqu
  toEnum Int
151 = Error
ErrAsmMacroArgs
  toEnum Int
152 = Error
ErrAsmMacroLevelsExceed
  toEnum Int
153 = Error
ErrAsmMacroStr
  toEnum Int
154 = Error
ErrAsmMacroInvalid
  toEnum Int
155 = Error
ErrAsmEscBackslash
  toEnum Int
156 = Error
ErrAsmEscOctal
  toEnum Int
157 = Error
ErrAsmEscSequence
  toEnum Int
158 = Error
ErrAsmEscStr
  toEnum Int
159 = Error
ErrAsmTokenInvalid
  toEnum Int
160 = Error
ErrAsmInsnUnsupported
  toEnum Int
161 = Error
ErrAsmFixupInvalid
  toEnum Int
162 = Error
ErrAsmLabelInvalid
  toEnum Int
163 = Error
ErrAsmFragmentInvalid
  toEnum Int
512 = Error
ErrAsmInvalidoperand
  toEnum Int
513 = Error
ErrAsmMissingfeature
  toEnum Int
514 = Error
ErrAsmMnemonicfail
  toEnum Int
unmatched = String -> Error
forall a. HasCallStack => String -> a
error (String
"Error.toEnum: Cannot match " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
unmatched)

{-# LINE 47 "src/Heystone/Internal/Core.chs" #-}


-- | The assembler runs in the IO monad and allows for the handling of errors
-- "under the hood".
type Assembler a = ExceptT Error IO a

foreign import ccall "Heystone/Internal/Core.chs.h &ks_close_wrapper"
  close :: C2HSImp.FinalizerPtr Engine