{-# LINE 1 "src/LLVM/Internal/FFI/InstructionDefs.hsc" #-}
-- This module translates the instruction data in "llvm/Instruction.def" into a Haskell data structure,
-- so it may be accessed conveniently with Template Haskell code
module LLVM.Internal.FFI.InstructionDefs where

import LLVM.Prelude

import LLVM.Internal.FFI.LLVMCTypes









data InstructionKind = Terminator | Unary | Binary | Memory | Cast | FuncletPad | Other
  deriving (InstructionKind -> InstructionKind -> Bool
(InstructionKind -> InstructionKind -> Bool)
-> (InstructionKind -> InstructionKind -> Bool)
-> Eq InstructionKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InstructionKind -> InstructionKind -> Bool
== :: InstructionKind -> InstructionKind -> Bool
$c/= :: InstructionKind -> InstructionKind -> Bool
/= :: InstructionKind -> InstructionKind -> Bool
Eq, Eq InstructionKind
Eq InstructionKind
-> (InstructionKind -> InstructionKind -> Ordering)
-> (InstructionKind -> InstructionKind -> Bool)
-> (InstructionKind -> InstructionKind -> Bool)
-> (InstructionKind -> InstructionKind -> Bool)
-> (InstructionKind -> InstructionKind -> Bool)
-> (InstructionKind -> InstructionKind -> InstructionKind)
-> (InstructionKind -> InstructionKind -> InstructionKind)
-> Ord InstructionKind
InstructionKind -> InstructionKind -> Bool
InstructionKind -> InstructionKind -> Ordering
InstructionKind -> InstructionKind -> InstructionKind
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
$ccompare :: InstructionKind -> InstructionKind -> Ordering
compare :: InstructionKind -> InstructionKind -> Ordering
$c< :: InstructionKind -> InstructionKind -> Bool
< :: InstructionKind -> InstructionKind -> Bool
$c<= :: InstructionKind -> InstructionKind -> Bool
<= :: InstructionKind -> InstructionKind -> Bool
$c> :: InstructionKind -> InstructionKind -> Bool
> :: InstructionKind -> InstructionKind -> Bool
$c>= :: InstructionKind -> InstructionKind -> Bool
>= :: InstructionKind -> InstructionKind -> Bool
$cmax :: InstructionKind -> InstructionKind -> InstructionKind
max :: InstructionKind -> InstructionKind -> InstructionKind
$cmin :: InstructionKind -> InstructionKind -> InstructionKind
min :: InstructionKind -> InstructionKind -> InstructionKind
Ord, Int -> InstructionKind -> ShowS
[InstructionKind] -> ShowS
InstructionKind -> String
(Int -> InstructionKind -> ShowS)
-> (InstructionKind -> String)
-> ([InstructionKind] -> ShowS)
-> Show InstructionKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InstructionKind -> ShowS
showsPrec :: Int -> InstructionKind -> ShowS
$cshow :: InstructionKind -> String
show :: InstructionKind -> String
$cshowList :: [InstructionKind] -> ShowS
showList :: [InstructionKind] -> ShowS
Show)

data InstructionDef = InstructionDef {
    InstructionDef -> CPPOpcode
cppOpcode :: CPPOpcode,
    InstructionDef -> String
cAPIName :: String,
    InstructionDef -> String
cAPIClassName :: String,
    InstructionDef -> InstructionKind
instructionKind :: InstructionKind
  }
  deriving (InstructionDef -> InstructionDef -> Bool
(InstructionDef -> InstructionDef -> Bool)
-> (InstructionDef -> InstructionDef -> Bool) -> Eq InstructionDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InstructionDef -> InstructionDef -> Bool
== :: InstructionDef -> InstructionDef -> Bool
$c/= :: InstructionDef -> InstructionDef -> Bool
/= :: InstructionDef -> InstructionDef -> Bool
Eq, Eq InstructionDef
Eq InstructionDef
-> (InstructionDef -> InstructionDef -> Ordering)
-> (InstructionDef -> InstructionDef -> Bool)
-> (InstructionDef -> InstructionDef -> Bool)
-> (InstructionDef -> InstructionDef -> Bool)
-> (InstructionDef -> InstructionDef -> Bool)
-> (InstructionDef -> InstructionDef -> InstructionDef)
-> (InstructionDef -> InstructionDef -> InstructionDef)
-> Ord InstructionDef
InstructionDef -> InstructionDef -> Bool
InstructionDef -> InstructionDef -> Ordering
InstructionDef -> InstructionDef -> InstructionDef
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
$ccompare :: InstructionDef -> InstructionDef -> Ordering
compare :: InstructionDef -> InstructionDef -> Ordering
$c< :: InstructionDef -> InstructionDef -> Bool
< :: InstructionDef -> InstructionDef -> Bool
$c<= :: InstructionDef -> InstructionDef -> Bool
<= :: InstructionDef -> InstructionDef -> Bool
$c> :: InstructionDef -> InstructionDef -> Bool
> :: InstructionDef -> InstructionDef -> Bool
$c>= :: InstructionDef -> InstructionDef -> Bool
>= :: InstructionDef -> InstructionDef -> Bool
$cmax :: InstructionDef -> InstructionDef -> InstructionDef
max :: InstructionDef -> InstructionDef -> InstructionDef
$cmin :: InstructionDef -> InstructionDef -> InstructionDef
min :: InstructionDef -> InstructionDef -> InstructionDef
Ord, Int -> InstructionDef -> ShowS
[InstructionDef] -> ShowS
InstructionDef -> String
(Int -> InstructionDef -> ShowS)
-> (InstructionDef -> String)
-> ([InstructionDef] -> ShowS)
-> Show InstructionDef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InstructionDef -> ShowS
showsPrec :: Int -> InstructionDef -> ShowS
$cshow :: InstructionDef -> String
show :: InstructionDef -> String
$cshowList :: [InstructionDef] -> ShowS
showList :: [InstructionDef] -> ShowS
Show)

instructionDefs :: [InstructionDef]
instructionDefs :: [InstructionDef]
instructionDefs = [
 CPPOpcode -> String -> String -> InstructionKind -> InstructionDef
InstructionDef CPPOpcode
o String
an String
acn InstructionKind
k
 | (CPPOpcode
o, String
an, String
acn, InstructionKind
k) <-
   [ (CPPOpcode 1,"Ret","ReturnInst", Terminator)
   , (CPPOpcode 2,"Br","BranchInst", Terminator)
   , (CPPOpcode 3,"Switch","SwitchInst", Terminator)
   , (CPPOpcode 4,"IndirectBr","IndirectBrInst", Terminator)
   , (CPPOpcode 5,"Invoke","InvokeInst", Terminator)
   , (CPPOpcode 6,"Resume","ResumeInst", Terminator)
   , (CPPOpcode 7,"Unreachable","UnreachableInst", Terminator)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
8,String
"CleanupRet",String
"CleanupReturnInst", InstructionKind
Terminator)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
9,String
"CatchRet",String
"CatchReturnInst", InstructionKind
Terminator)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
10,String
"CatchSwitch",String
"CatchSwitchInst", InstructionKind
Terminator)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
11,String
"CallBr",String
"CallBrInst", InstructionKind
Terminator)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
12,String
"FNeg",String
"UnaryOperator", InstructionKind
Unary)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
13,String
"Add",String
"BinaryOperator", InstructionKind
Binary)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
14,String
"FAdd",String
"BinaryOperator", InstructionKind
Binary)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
15,String
"Sub",String
"BinaryOperator", InstructionKind
Binary)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
16,String
"FSub",String
"BinaryOperator", InstructionKind
Binary)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
17,String
"Mul",String
"BinaryOperator", InstructionKind
Binary)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
18,String
"FMul",String
"BinaryOperator", InstructionKind
Binary)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
19,String
"UDiv",String
"BinaryOperator", InstructionKind
Binary)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
20,String
"SDiv",String
"BinaryOperator", InstructionKind
Binary)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
21,String
"FDiv",String
"BinaryOperator", InstructionKind
Binary)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
22,String
"URem",String
"BinaryOperator", InstructionKind
Binary)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
23,String
"SRem",String
"BinaryOperator", InstructionKind
Binary)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
24,String
"FRem",String
"BinaryOperator", InstructionKind
Binary)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
25,String
"Shl",String
"BinaryOperator", InstructionKind
Binary)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
26,String
"LShr",String
"BinaryOperator", InstructionKind
Binary)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
27,String
"AShr",String
"BinaryOperator", InstructionKind
Binary)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
28,String
"And",String
"BinaryOperator", InstructionKind
Binary)
   , (CPPOpcode 29,"Or","BinaryOperator", Binary)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
30,String
"Xor",String
"BinaryOperator", InstructionKind
Binary)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
31,String
"Alloca",String
"AllocaInst", InstructionKind
Memory)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
32,String
"Load",String
"LoadInst", InstructionKind
Memory)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
33,String
"Store",String
"StoreInst", InstructionKind
Memory)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
34,String
"GetElementPtr",String
"GetElementPtrInst", InstructionKind
Memory)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
35,String
"Fence",String
"FenceInst", InstructionKind
Memory)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
36,String
"AtomicCmpXchg",String
"AtomicCmpXchgInst", InstructionKind
Memory)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
37,String
"AtomicRMW",String
"AtomicRMWInst", InstructionKind
Memory)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
38,String
"Trunc",String
"TruncInst", InstructionKind
Cast)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
39,String
"ZExt",String
"ZExtInst", InstructionKind
Cast)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
40,String
"SExt",String
"SExtInst", InstructionKind
Cast)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
41,String
"FPToUI",String
"FPToUIInst", InstructionKind
Cast)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
42,String
"FPToSI",String
"FPToSIInst", InstructionKind
Cast)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
43,String
"UIToFP",String
"UIToFPInst", InstructionKind
Cast)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
44,String
"SIToFP",String
"SIToFPInst", InstructionKind
Cast)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
45,String
"FPTrunc",String
"FPTruncInst", InstructionKind
Cast)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
46,String
"FPExt",String
"FPExtInst", InstructionKind
Cast)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
47,String
"PtrToInt",String
"PtrToIntInst", InstructionKind
Cast)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
48,String
"IntToPtr",String
"IntToPtrInst", InstructionKind
Cast)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
49,String
"BitCast",String
"BitCastInst", InstructionKind
Cast)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
50,String
"AddrSpaceCast",String
"AddrSpaceCastInst", InstructionKind
Cast)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
51,String
"CleanupPad",String
"CleanupPadInst", InstructionKind
FuncletPad)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
52,String
"CatchPad",String
"CatchPadInst", InstructionKind
FuncletPad)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
53,String
"ICmp",String
"ICmpInst", InstructionKind
Other)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
54,String
"FCmp",String
"FCmpInst", InstructionKind
Other)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
55,String
"PHI",String
"PHINode", InstructionKind
Other)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
56,String
"Call",String
"CallInst", InstructionKind
Other)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
57,String
"Select",String
"SelectInst", InstructionKind
Other)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
58,String
"UserOp1",String
"Instruction", InstructionKind
Other)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
59,String
"UserOp2",String
"Instruction", InstructionKind
Other)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
60,String
"VAArg",String
"VAArgInst", InstructionKind
Other)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
61,String
"ExtractElement",String
"ExtractElementInst", InstructionKind
Other)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
62,String
"InsertElement",String
"InsertElementInst", InstructionKind
Other)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
63,String
"ShuffleVector",String
"ShuffleVectorInst", InstructionKind
Other)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
64,String
"ExtractValue",String
"ExtractValueInst", InstructionKind
Other)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
65,String
"InsertValue",String
"InsertValueInst", InstructionKind
Other)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
66,String
"LandingPad",String
"LandingPadInst", InstructionKind
Other)
   , (CUInt -> CPPOpcode
CPPOpcode CUInt
67,String
"Freeze",String
"FreezeInst", InstructionKind
Other) ] ,
{-# LINE 60 "src/LLVM/Internal/FFI/InstructionDefs.hsc" #-}
 an /= "UserOp1" && an /= "UserOp2"
 ]