{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-unused-matches #-} module LLVM.General.Quote.Base ( ToDefintions(..), quasiquote, parse ) where import Control.Monad ((>=>)) import qualified Data.ByteString.Char8 as B import Data.Data (Data(..)) import Data.Generics (extQ) import Data.Word import Data.Loc import Data.Typeable (Typeable) import Language.Haskell.Meta (parseExp, parsePat) import Language.Haskell.TH import Language.Haskell.TH.Quote (QuasiQuoter(..), dataToExpQ, dataToPatQ) import qualified LLVM.General.Quote.Parser as P import qualified LLVM.General.Quote.AST as A import qualified LLVM.General.AST.IntegerPredicate as AI import qualified LLVM.General.AST as L import qualified LLVM.General.AST.Constant as L (Constant(Int, Float, Null, Struct, Array, Vector, Undef, BlockAddress, GlobalReference)) import qualified LLVM.General.AST.Float as L import qualified LLVM.General.AST.InlineAssembly as L import qualified LLVM.General.AST.DataLayout as L import qualified LLVM.General.AST.AddrSpace as A import qualified Data.Map as M import qualified Data.Set as S import Data.Maybe class ToDefintion a where toDefinition :: a -> L.Definition instance ToDefintion L.Definition where toDefinition = id instance ToDefintion L.Global where toDefinition = L.GlobalDefinition class ToDefintions a where toDefinitions :: a -> [L.Definition] instance ToDefintion a => ToDefintions [a] where toDefinitions = map toDefinition class ToConstant a where toConstant :: a -> L.Constant instance ToConstant Word8 where toConstant n = L.Int 8 (toInteger n) instance ToConstant Word16 where toConstant n = L.Int 16 (toInteger n) instance ToConstant Word32 where toConstant n = L.Int 32 (toInteger n) instance ToConstant Word64 where toConstant n = L.Int 64 (toInteger n) instance ToConstant Float where toConstant n = L.Float (L.Single n) instance ToConstant Double where toConstant n = L.Float (L.Double n) class ToName a where toName :: a -> L.Name instance ToName L.Name where toName = id instance ToName String where toName = L.Name instance ToName Word where toName = L.UnName class ToTargetTriple a where toTargetTriple :: a -> Maybe String instance ToTargetTriple String where toTargetTriple = Just instance ToTargetTriple (Maybe String) where toTargetTriple = id antiVarE :: String -> ExpQ antiVarE = either fail return . parseExp qqDefinitionListE :: [A.Definition] -> Maybe (Q Exp) qqDefinitionListE [] = Just [|[]|] qqDefinitionListE (A.AntiDefinitionList v : defs) = Just [|toDefinitions $(antiVarE v) ++ $(qqE defs)|] qqDefinitionListE (def : defs) = Just [|$(qqE def) : $(qqE defs)|] qqDefinitionE :: A.Definition -> Maybe (Q Exp) qqDefinitionE (A.GlobalDefinition v) = Just [|L.GlobalDefinition $(qqE v) :: L.Definition|] qqDefinitionE (A.TypeDefinition n v) = Just [|L.TypeDefinition $(qqE n) $(qqE v) :: L.Definition|] qqDefinitionE (A.MetadataNodeDefinition i vs) = Just [|L.MetadataNodeDefinition $(qqE i) $(qqE vs) :: L.Definition|] qqDefinitionE (A.NamedMetadataDefinition i vs) = Just [|L.NamedMetadataDefinition $(qqE i) $(qqE vs) :: L.Definition|] qqDefinitionE (A.ModuleInlineAssembly s) = Just [|L.ModuleInlineAssembly $(qqE s) :: L.Definition|] qqDefinitionE a@(A.AntiDefinition s) = Just $ antiVarE s qqDefinitionE a@(A.AntiDefinitionList _s) = error $ "Internal Error: unexpected antiquote " ++ show a qqModuleE :: A.Module -> Maybe (Q Exp) qqModuleE (A.Module n dl tt ds) = Just [|L.Module $(qqE n) $(qqE dl) $(qqE tt) $(qqE ds) :: L.Module|] qqGlobalE :: A.Global -> Maybe (Q Exp) qqGlobalE (A.GlobalVariable x1 x2 x3 x4 x5 x6 x7 x8 x9 xA xB) = Just [|L.GlobalVariable $(qqE x1) $(qqE x2) $(qqE x3) $(qqE x4) $(qqE x5) $(qqE x6) $(qqE x7) $(qqE x8) $(qqE x9) $(qqE xA) $(qqE xB)|] qqGlobalE (A.GlobalAlias x1 x2 x3 x4 x5) = Just [|L.GlobalAlias $(qqE x1) $(qqE x2) $(qqE x3) $(qqE x4) $(qqE x5)|] qqGlobalE (A.Function x1 x2 x3 x4 x5 x6 x7 x8 x9 xA xB xC) = Just [|L.Function $(qqE x1) $(qqE x2) $(qqE x3) $(qqE x4) $(qqE x5) $(qqE x6) $(qqE x7) $(qqE x8) $(qqE x9) $(qqE xA) $(qqE xB) $(qqE xC)|] qqParameterListE :: [A.Parameter] -> Maybe (Q Exp) qqParameterListE [] = Just [|[]|] qqParameterListE (A.AntiParameterList v : defs) = Just [|$(antiVarE v) ++ $(qqE defs)|] qqParameterListE (def : defs) = Just [|$(qqE def) : $(qqE defs)|] qqParameterE :: A.Parameter -> Maybe (Q Exp) qqParameterE (A.Parameter x1 x2 x3) = Just [|L.Parameter $(qqE x1) $(qqE x2) $(qqE x3)|] qqParameterE (A.AntiParameter s) = Just $ antiVarE s qqParameterE a@(A.AntiParameterList _s) = error $ "Internal Error: unexpected antiquote " ++ show a qqBasicBlockListE :: [A.BasicBlock] -> Maybe (Q Exp) qqBasicBlockListE [] = Just [|[]|] qqBasicBlockListE (for@A.ForLoop{} : defs) = Just [|$(qqE $ transform for) ++ $(qqE defs)|] qqBasicBlockListE (A.AntiBasicBlockList v : defs) = Just [|$(antiVarE v) ++ $(qqE defs)|] qqBasicBlockListE (def : defs) = Just [|$(qqE def) : $(qqE defs)|] transform :: A.BasicBlock -> [A.BasicBlock] transform bb@A.BasicBlock{} = [bb] transform (A.ForLoop label iterType iterName from to elementType element elementName body next) = let labelString = case label of A.Name s -> s A.UnName n -> "num"++show n A.AntiName s -> error $ "Error: antiquotation for names not legal in for-header " ++ s cond = A.Name $ labelString ++ ".cond" iterNameNew = A.Name $ case iterName of A.Name s -> s ++ ".new" A.UnName n -> "num"++show n++".new" A.AntiName s -> error $ "Error: antiquotation for names not legal in for-header " ++ s iterBits = case iterType of A.IntegerType n -> n t -> error $ "Internal Error: unexpected type " ++ show t iter = (A.LocalReference iterName) --labels = map A.label body preInstrs = [ iterName A.:= A.Phi iterType (map (\(_,l) -> (A.LocalReference iterNameNew,l)) returns ++ map (\(_,s) -> (from,s)) element) [] , elementName A.:= A.Phi elementType (returns ++ element) [] , cond A.:= A.ICmp AI.ULE iter to [] , iterNameNew A.:= A.Add True True iter (A.ConstantOperand $ A.Int iterBits 1) [] ] body' = body >>= transform bodyLabel = A.label $ head body' returns = body' >>= maybeToList . ret pre = case next of Just next' -> A.BasicBlock label preInstrs (A.Do $ A.CondBr (A.LocalReference cond) bodyLabel next' []) Nothing -> A.BasicBlock label preInstrs (A.Do $ A.Ret (Just $ A.LocalReference elementName) []) main = map (replaceRet label) body' in (pre:main) transform A.AntiBasicBlock{} = error $ "Error: antiquotation of BasicBlocks not allowed inside a loop" transform A.AntiBasicBlockList{} = error $ "Error: antiquotation of BasicBlocks not allowed inside a loop" ret :: A.BasicBlock -> Maybe (A.Operand, A.Name) ret (A.BasicBlock l _ t') = do let t = case t' of _ A.:= t'' -> t'' A.Do t'' -> t'' A.Ret (Just x) _ <- return t return (x,l) ret x = error $ "Internal Error: only plain BasicBlocks should arrive at function ret. got: " ++ show x replaceRet :: A.Name -> A.BasicBlock -> A.BasicBlock replaceRet label bb@A.BasicBlock{} = case A.terminator bb of n A.:= A.Ret _ md -> bb{ A.terminator = n A.:= A.Br label md } A.Do (A.Ret _ md) -> bb{ A.terminator = A.Do (A.Br label md) } _ -> bb replaceRet _ x = error $ "Internal Error: only plain BasicBlocks should arrive at function replaceRet. got: " ++ show x qqBasicBlockE :: A.BasicBlock -> Maybe (Q Exp) qqBasicBlockE (A.BasicBlock x1 x2 x3) = Just [|L.BasicBlock $(qqE x1) $(qqE x2) $(qqE x3)|] qqBasicBlockE (A.AntiBasicBlock s) = Just $ antiVarE s qqBasicBlockE a@A.ForLoop{} = error $ "Internal Error: unexpected loop " ++ show a qqBasicBlockE a@(A.AntiBasicBlockList _s) = error $ "Internal Error: unexpected antiquote " ++ show a qqTerminatorE :: A.Terminator -> Maybe (Q Exp) qqTerminatorE (A.Ret x1 x2) = Just [|L.Ret $(qqE x1) $(qqE x2)|] qqTerminatorE (A.CondBr x1 x2 x3 x4) = Just [|L.CondBr $(qqE x1) $(qqE x2) $(qqE x3) $(qqE x4)|] qqTerminatorE (A.Br x1 x2) = Just [|L.Br $(qqE x1) $(qqE x2)|] qqTerminatorE (A.Switch x1 x2 x3 x4) = Just [|L.Switch $(qqE x1) $(qqE x2) $(qqE x3) $(qqE x4)|] qqTerminatorE (A.IndirectBr x1 x2 x3) = Just [|L.IndirectBr $(qqE x1) $(qqE x2) $(qqE x3)|] qqTerminatorE (A.Invoke x1 x2 x3 x4 x5 x6 x7 x8) = Just [|L.Invoke $(qqE x1) $(qqE x2) $(qqE x3) $(qqE x4) $(qqE x5) $(qqE x6) $(qqE x7) $(qqE x8)|] qqTerminatorE (A.Resume x1 x2) = Just [|L.Resume $(qqE x1) $(qqE x2)|] qqTerminatorE (A.Unreachable x1) = Just [|L.Unreachable $(qqE x1)|] qqMemoryOrderingE :: A.MemoryOrdering -> Maybe (Q Exp) qqMemoryOrderingE A.Unordered = Just [|L.Unordered|] qqMemoryOrderingE A.Monotonic = Just [|L.Monotonic|] qqMemoryOrderingE A.Acquire = Just [|L.Acquire|] qqMemoryOrderingE A.Release = Just [|L.Release|] qqMemoryOrderingE A.AcquireRelease = Just [|L.AcquireRelease|] qqMemoryOrderingE A.SequentiallyConsistent = Just [|L.SequentiallyConsistent|] qqAtomicityE :: A.Atomicity -> Maybe (Q Exp) qqAtomicityE (A.Atomicity x1 x2) = Just [|L.Atomicity $(qqE x1) $(qqE x2)|] qqLandingPadClauseE :: A.LandingPadClause -> Maybe (Q Exp) qqLandingPadClauseE (A.Catch x1) = Just [|L.Catch $(qqE x1)|] qqLandingPadClauseE (A.Filter x1) = Just [|L.Filter $(qqE x1)|] qqInstructionE :: A.Instruction -> Maybe (Q Exp) qqInstructionE (A.Add x1 x2 x3 x4 x5) = Just [|L.Add $(qqE x1) $(qqE x2) $(qqE x3) $(qqE x4) $(qqE x5)|] qqInstructionE (A.FAdd x1 x2 x3) = Just [|L.FAdd $(qqE x1) $(qqE x2) $(qqE x3)|] qqInstructionE (A.Sub x1 x2 x3 x4 x5) = Just [|L.Sub $(qqE x1) $(qqE x2) $(qqE x3) $(qqE x4) $(qqE x5)|] qqInstructionE (A.FSub x1 x2 x3) = Just [|L.FSub $(qqE x1) $(qqE x2) $(qqE x3)|] qqInstructionE (A.Mul x1 x2 x3 x4 x5) = Just [|L.Mul $(qqE x1) $(qqE x2) $(qqE x3) $(qqE x4) $(qqE x5)|] qqInstructionE (A.FMul x1 x2 x3) = Just [|L.FMul $(qqE x1) $(qqE x2) $(qqE x3)|] qqInstructionE (A.UDiv x1 x2 x3 x4) = Just [|L.UDiv $(qqE x1) $(qqE x2) $(qqE x3) $(qqE x4)|] qqInstructionE (A.SDiv x1 x2 x3 x4) = Just [|L.SDiv $(qqE x1) $(qqE x2) $(qqE x3) $(qqE x4)|] qqInstructionE (A.FDiv x1 x2 x3) = Just [|L.FDiv $(qqE x1) $(qqE x2) $(qqE x3)|] qqInstructionE (A.URem x1 x2 x3) = Just [|L.URem $(qqE x1) $(qqE x2) $(qqE x3)|] qqInstructionE (A.SRem x1 x2 x3) = Just [|L.SRem $(qqE x1) $(qqE x2) $(qqE x3)|] qqInstructionE (A.FRem x1 x2 x3) = Just [|L.FRem $(qqE x1) $(qqE x2) $(qqE x3)|] qqInstructionE (A.Shl x1 x2 x3 x4 x5) = Just [|L.Shl $(qqE x1) $(qqE x2) $(qqE x3) $(qqE x4) $(qqE x5)|] qqInstructionE (A.LShr x1 x2 x3 x4) = Just [|L.LShr $(qqE x1) $(qqE x2) $(qqE x3) $(qqE x4)|] qqInstructionE (A.AShr x1 x2 x3 x4) = Just [|L.AShr $(qqE x1) $(qqE x2) $(qqE x3) $(qqE x4)|] qqInstructionE (A.And x1 x2 x3) = Just [|L.And $(qqE x1) $(qqE x2) $(qqE x3)|] qqInstructionE (A.Or x1 x2 x3) = Just [|L.Or $(qqE x1) $(qqE x2) $(qqE x3)|] qqInstructionE (A.Xor x1 x2 x3) = Just [|L.Xor $(qqE x1) $(qqE x2) $(qqE x3)|] qqInstructionE (A.Alloca x1 x2 x3 x4) = Just [|L.Alloca $(qqE x1) $(qqE x2) $(qqE x3) $(qqE x4)|] qqInstructionE (A.Load x1 x2 x3 x4 x5) = Just [|L.Load $(qqE x1) $(qqE x2) $(qqE x3) $(qqE x4) $(qqE x5)|] qqInstructionE (A.Store x1 x2 x3 x4 x5 x6) = Just [|L.Store $(qqE x1) $(qqE x2) $(qqE x3) $(qqE x4) $(qqE x5) $(qqE x6)|] qqInstructionE (A.GetElementPtr x1 x2 x3 x4) = Just [|L.GetElementPtr $(qqE x1) $(qqE x2) $(qqE x3) $(qqE x4)|] qqInstructionE (A.Fence x1 x2) = Just [|L.Fence $(qqE x1) $(qqE x2)|] qqInstructionE (A.CmpXchg x1 x2 x3 x4 x5 x6) = Just [|L.CmpXchg $(qqE x1) $(qqE x2) $(qqE x3) $(qqE x4) $(qqE x5) $(qqE x6)|] qqInstructionE (A.AtomicRMW x1 x2 x3 x4 x5 x6) = Just [|L.AtomicRMW $(qqE x1) $(qqE x2) $(qqE x3) $(qqE x4) $(qqE x5) $(qqE x6)|] qqInstructionE (A.Trunc x1 x2 x3) = Just [|L.Trunc $(qqE x1) $(qqE x2) $(qqE x3)|] qqInstructionE (A.ZExt x1 x2 x3) = Just [|L.ZExt $(qqE x1) $(qqE x2) $(qqE x3)|] qqInstructionE (A.SExt x1 x2 x3) = Just [|L.SExt $(qqE x1) $(qqE x2) $(qqE x3)|] qqInstructionE (A.FPToUI x1 x2 x3) = Just [|L.FPToUI $(qqE x1) $(qqE x2) $(qqE x3)|] qqInstructionE (A.FPToSI x1 x2 x3) = Just [|L.FPToSI $(qqE x1) $(qqE x2) $(qqE x3)|] qqInstructionE (A.UIToFP x1 x2 x3) = Just [|L.UIToFP $(qqE x1) $(qqE x2) $(qqE x3)|] qqInstructionE (A.SIToFP x1 x2 x3) = Just [|L.SIToFP $(qqE x1) $(qqE x2) $(qqE x3)|] qqInstructionE (A.FPTrunc x1 x2 x3) = Just [|L.FPTrunc $(qqE x1) $(qqE x2) $(qqE x3)|] qqInstructionE (A.FPExt x1 x2 x3) = Just [|L.FPExt $(qqE x1) $(qqE x2) $(qqE x3)|] qqInstructionE (A.PtrToInt x1 x2 x3) = Just [|L.PtrToInt $(qqE x1) $(qqE x2) $(qqE x3)|] qqInstructionE (A.IntToPtr x1 x2 x3) = Just [|L.IntToPtr $(qqE x1) $(qqE x2) $(qqE x3)|] qqInstructionE (A.BitCast x1 x2 x3) = Just [|L.BitCast $(qqE x1) $(qqE x2) $(qqE x3)|] qqInstructionE (A.AddrSpaceCast x1 x2 x3) = Just [|L.AddrSpaceCast $(qqE x1) $(qqE x2) $(qqE x3)|] qqInstructionE (A.ICmp x1 x2 x3 x4) = Just [|L.ICmp $(qqE x1) $(qqE x2) $(qqE x3) $(qqE x4)|] qqInstructionE (A.FCmp x1 x2 x3 x4) = Just [|L.FCmp $(qqE x1) $(qqE x2) $(qqE x3) $(qqE x4)|] qqInstructionE (A.Phi x1 x2 x3) = Just [|L.Phi $(qqE x1) $(qqE x2) $(qqE x3)|] qqInstructionE (A.Call x1 x2 x3 x4 x5 x6 x7) = Just [|L.Call $(qqE x1) $(qqE x2) $(qqE x3) $(qqE x4) $(qqE x5) $(qqE x6) $(qqE x7)|] qqInstructionE (A.Select x1 x2 x3 x4) = Just [|L.Select $(qqE x1) $(qqE x2) $(qqE x3) $(qqE x4)|] qqInstructionE (A.VAArg x1 x2 x3) = Just [|L.VAArg $(qqE x1) $(qqE x2) $(qqE x3)|] qqInstructionE (A.ExtractElement x1 x2 x3) = Just [|L.ExtractElement $(qqE x1) $(qqE x2) $(qqE x3)|] qqInstructionE (A.InsertElement x1 x2 x3 x4) = Just [|L.InsertElement $(qqE x1) $(qqE x2) $(qqE x3) $(qqE x4)|] qqInstructionE (A.ShuffleVector x1 x2 x3 x4) = Just [|L.ShuffleVector $(qqE x1) $(qqE x2) $(qqE x3) $(qqE x4)|] qqInstructionE (A.ExtractValue x1 x2 x3) = Just [|L.ExtractValue $(qqE x1) $(qqE x2) $(qqE x3)|] qqInstructionE (A.InsertValue x1 x2 x3 x4) = Just [|L.InsertValue $(qqE x1) $(qqE x2) $(qqE x3) $(qqE x4)|] qqInstructionE (A.LandingPad x1 x2 x3 x4 x5) = Just [|L.LandingPad $(qqE x1) $(qqE x2) $(qqE x3) $(qqE x4) $(qqE x5)|] qqInstructionE (A.AntiInstruction s) = Just $ antiVarE s qqNamedE :: (Typeable a, Data a) => A.Named a -> Maybe (Q Exp) qqNamedE ((A.:=) x1 x2) = Just [|(L.:=) $(qqE x1) $(qqE x2)|] qqNamedE (A.Do x1) = Just [|L.Do $(qqE x1)|] qqMetadataNodeIDE :: A.MetadataNodeID -> Maybe (Q Exp) qqMetadataNodeIDE (A.MetadataNodeID x1) = Just [|L.MetadataNodeID $(qqE x1)|] qqMetadataNodeE :: A.MetadataNode -> Maybe (Q Exp) qqMetadataNodeE (A.MetadataNode x1) = Just [|L.MetadataNode $(qqE x1)|] qqMetadataNodeE (A.MetadataNodeReference x1) = Just [|L.MetadataNodeReference $(qqE x1)|] qqOperandE :: A.Operand -> Maybe (Q Exp) qqOperandE (A.LocalReference x1) = Just [|L.LocalReference $(qqE x1)|] qqOperandE (A.ConstantOperand x1) = Just [|L.ConstantOperand $(qqE x1)|] qqOperandE (A.MetadataStringOperand x1) = Just [|L.MetadataStringOperand $(qqE x1)|] qqOperandE (A.MetadataNodeOperand x1) = Just [|L.MetadataNodeOperand $(qqE x1)|] qqConstantE :: A.Constant -> Maybe (Q Exp) qqConstantE (A.Int x1 x2) = Just [|L.Int $(qqE x1) $(qqE x2)|] qqConstantE (A.Float x1) = Just [|L.Float $(qqE x1)|] qqConstantE (A.Null x1) = Just [|L.Null $(qqE x1)|] qqConstantE (A.Struct x1 x2 x3) = Just [|L.Struct $(qqE x1) $(qqE x2) $(qqE x3)|] qqConstantE (A.Array x1 x2) = Just [|L.Array $(qqE x1) $(qqE x2)|] qqConstantE (A.Vector x1) = Just [|L.Vector $(qqE x1)|] qqConstantE (A.Undef x1) = Just [|L.Undef $(qqE x1)|] qqConstantE (A.BlockAddress x1 x2) = Just [|L.BlockAddress $(qqE x1) $(qqE x2)|] qqConstantE (A.GlobalReference x1) = Just [|L.GlobalReference $(qqE x1)|] qqConstantE (A.AntiConstant s) = Just [|toConstant $(antiVarE s)|] qqNameE :: A.Name -> Maybe (Q Exp) qqNameE (A.Name x1) = Just [|L.Name $(qqE x1)|] qqNameE (A.UnName x1) = Just [|L.UnName $(qqE x1)|] qqNameE (A.AntiName s) = Just [|toName $(antiVarE s)|] qqFloatingPointFormatE :: A.FloatingPointFormat -> Maybe (Q Exp) qqFloatingPointFormatE A.IEEE = Just [|L.IEEE|] qqFloatingPointFormatE A.DoubleExtended = Just [|L.DoubleExtended|] qqFloatingPointFormatE A.PairOfFloats = Just [|L.PairOfFloats|] qqTypeE :: A.Type -> Maybe (Q Exp) qqTypeE A.VoidType = Just [|L.VoidType|] qqTypeE (A.IntegerType x1) = Just [|L.IntegerType $(qqE x1)|] qqTypeE (A.PointerType x1 x2) = Just [|L.PointerType $(qqE x1) $(qqE x2)|] qqTypeE (A.FloatingPointType x1 x2) = Just [|L.FloatingPointType $(qqE x1) $(qqE x2)|] qqTypeE (A.FunctionType x1 x2 x3) = Just [|L.FunctionType $(qqE x1) $(qqE x2) $(qqE x3)|] qqTypeE (A.VectorType x1 x2) = Just [|L.VectorType $(qqE x1) $(qqE x2)|] qqTypeE (A.StructureType x1 x2) = Just [|L.StructureType $(qqE x1) $(qqE x2)|] qqTypeE (A.ArrayType x1 x2) = Just [|L.ArrayType $(qqE x1) $(qqE x2)|] qqTypeE (A.NamedTypeReference x1) = Just [|L.NamedTypeReference $(qqE x1)|] qqTypeE A.MetadataType = Just [|L.MetadataType|] qqDialectE :: A.Dialect -> Maybe (Q Exp) qqDialectE A.ATTDialect = Just [|L.ATTDialect|] qqDialectE A.IntelDialect = Just [|L.IntelDialect|] qqInlineAssemblyE :: A.InlineAssembly -> Maybe (Q Exp) qqInlineAssemblyE (A.InlineAssembly x1 x2 x3 x4 x5 x6) = Just [|L.InlineAssembly $(qqE x1) $(qqE x2) $(qqE x3) $(qqE x4) $(qqE x5) $(qqE x6)|] qqMapE :: (Data a, Data b) => M.Map a b -> Maybe (Q Exp) qqMapE m = Just [|M.fromList $(qqE (M.toList m))|] qqSetE :: Data a => S.Set a -> Maybe (Q Exp) qqSetE m = Just [|S.fromList $(qqE (S.toList m))|] qqEndiannessE :: A.Endianness -> Maybe (Q Exp) qqEndiannessE A.LittleEndian = Just [|L.LittleEndian|] qqEndiannessE A.BigEndian = Just [|L.BigEndian|] qqAlignmentInfoE :: A.AlignmentInfo -> Maybe (Q Exp) qqAlignmentInfoE (A.AlignmentInfo x1 x2) = Just [|L.AlignmentInfo $(qqE x1) $(qqE x2)|] qqAlignTypeE :: A.AlignType -> Maybe (Q Exp) qqAlignTypeE A.IntegerAlign = Just [|L.IntegerAlign|] qqAlignTypeE A.VectorAlign = Just [|L.VectorAlign|] qqAlignTypeE A.FloatAlign = Just [|L.FloatAlign|] qqAlignTypeE A.AggregateAlign = Just [|L.AggregateAlign|] qqAlignTypeE A.StackAlign = Just [|L.StackAlign|] qqDataLayoutE :: A.DataLayout -> Maybe (Q Exp) qqDataLayoutE (A.DataLayout x1 x2 x3 x4 x5) = Just [|L.DataLayout $(qqE x1) $(qqE x2) $(qqE x3) $(qqE x4) $(qqE x5)|] qqDataLayoutE (A.AntiDataLayout s) = Just $ antiVarE s qqTargetTripleE :: A.TargetTriple -> Maybe (Q Exp) qqTargetTripleE A.NoTargetTriple = Just [|Nothing|] qqTargetTripleE (A.TargetTriple v) = Just [|Just $(qqE v)|] qqTargetTripleE (A.AntiTargetTriple v) = Just [|toTargetTriple $(antiVarE v)|] qqE :: Data a => a -> Q Exp qqE x = dataToExpQ qqExp x qqExp :: Typeable a => a -> Maybe (Q Exp) qqExp = const Nothing `extQ` qqDefinitionE `extQ` qqDefinitionListE `extQ` qqModuleE `extQ` qqGlobalE `extQ` qqParameterListE `extQ` qqParameterE `extQ` qqBasicBlockE `extQ` qqBasicBlockListE `extQ` qqTerminatorE `extQ` qqMemoryOrderingE `extQ` qqAtomicityE `extQ` qqLandingPadClauseE `extQ` qqInstructionE `extQ` (qqNamedE :: A.Named A.Instruction -> Maybe (Q Exp)) `extQ` (qqNamedE :: A.Named A.Terminator -> Maybe (Q Exp)) `extQ` qqMetadataNodeIDE `extQ` qqMetadataNodeE `extQ` qqOperandE `extQ` qqConstantE `extQ` qqNameE `extQ` qqFloatingPointFormatE `extQ` qqTypeE `extQ` qqDialectE `extQ` qqInlineAssemblyE `extQ` (qqMapE :: M.Map A.AddrSpace (Word32, A.AlignmentInfo) -> Maybe (Q Exp)) `extQ` (qqMapE :: M.Map (A.AlignType, Word32) A.AlignmentInfo -> Maybe (Q Exp)) `extQ` (qqSetE :: S.Set Word32 -> Maybe (Q Exp)) `extQ` qqEndiannessE `extQ` qqAlignmentInfoE `extQ` qqAlignTypeE `extQ` qqDataLayoutE `extQ` qqTargetTripleE antiVarP :: String -> PatQ antiVarP = either fail return . parsePat qqDefinitionListP :: [A.Definition] -> Maybe (Q Pat) qqDefinitionListP [] = Just [p|[]|] qqDefinitionListP [A.AntiDefinitionList v] = Just $ antiVarP v qqDefinitionListP (A.AntiDefinitionList _ : _ : _) = error "Antiquoted list of definitions must be last item in quoted list" qqDefinitionListP (def : defs) = Just [p|$(qqP def) : $(qqP defs)|] qqDefinitionP :: A.Definition -> Maybe (Q Pat) qqDefinitionP (A.GlobalDefinition v) = Just [p|L.GlobalDefinition $(qqP v)|] qqDefinitionP (A.TypeDefinition n v) = Just [p|L.TypeDefinition $(qqP n) $(qqP v)|] qqDefinitionP (A.MetadataNodeDefinition i vs) = Just [p|L.MetadataNodeDefinition $(qqP i) $(qqP vs)|] qqDefinitionP (A.NamedMetadataDefinition i vs) = Just [p|L.NamedMetadataDefinition $(qqP i) $(qqP vs)|] qqDefinitionP (A.ModuleInlineAssembly s) = Just [p|L.ModuleInlineAssembly $(qqP s)|] qqDefinitionP (A.AntiDefinition s) = Just $ antiVarP s qqDefinitionP a@(A.AntiDefinitionList _s) = error $ "Internal Error: unexpected antiquote " ++ show a qqModuleP :: A.Module -> Maybe (Q Pat) qqModuleP (A.Module n dl tt ds) = Just [p|L.Module $(qqP n) $(qqP dl) $(qqP tt) $(qqP ds)|] qqGlobalP :: A.Global -> Maybe (Q Pat) qqGlobalP (A.GlobalVariable x1 x2 x3 x4 x5 x6 x7 x8 x9 xA xB) = Just [p|L.GlobalVariable $(qqP x1) $(qqP x2) $(qqP x3) $(qqP x4) $(qqP x5) $(qqP x6) $(qqP x7) $(qqP x8) $(qqP x9) $(qqP xA) $(qqP xB)|] qqGlobalP (A.GlobalAlias x1 x2 x3 x4 x5) = Just [p|L.GlobalAlias $(qqP x1) $(qqP x2) $(qqP x3) $(qqP x4) $(qqP x5)|] qqGlobalP (A.Function x1 x2 x3 x4 x5 x6 x7 x8 x9 xA xB xC) = Just [p|L.Function $(qqP x1) $(qqP x2) $(qqP x3) $(qqP x4) $(qqP x5) $(qqP x6) $(qqP x7) $(qqP x8) $(qqP x9) $(qqP xA) $(qqP xB) $(qqP xC)|] qqParameterListP :: [A.Parameter] -> Maybe (Q Pat) qqParameterListP [] = Just [p|[]|] qqParameterListP [A.AntiParameterList v] = Just $ antiVarP v qqParameterListP (A.AntiParameterList v : _) = error "Antiquoted list of Parameters must be last item in quoted list" qqParameterListP (def : defs) = Just [p|$(qqP def) : $(qqP defs)|] qqParameterP :: A.Parameter -> Maybe (Q Pat) qqParameterP (A.Parameter x1 x2 x3) = Just [p|L.Parameter $(qqP x1) $(qqP x2) $(qqP x3)|] qqParameterP (A.AntiParameter s) = Just $ antiVarP s qqParameterP a@(A.AntiParameterList _s) = error $ "Internal Error: unexpected antiquote " ++ show a qqBasicBlockListP :: [A.BasicBlock] -> Maybe (Q Pat) qqBasicBlockListP [] = Just [p|[]|] qqBasicBlockListP [A.AntiBasicBlockList v] = Just $ antiVarP v qqBasicBlockListP (A.AntiBasicBlockList v : defs) = error "Antiquoted list of BasicBlocks must be last item in quoted list" qqBasicBlockListP (def : defs) = Just [p|$(qqP def) : $(qqP defs)|] qqBasicBlockP :: A.BasicBlock -> Maybe (Q Pat) qqBasicBlockP (A.BasicBlock x1 x2 x3) = Just [p|L.BasicBlock $(qqP x1) $(qqP x2) $(qqP x3)|] qqBasicBlockP (A.AntiBasicBlock s) = Just $ antiVarP s qqBasicBlockP a@A.ForLoop{} = error $ "Error: for-loop not allowed in pattern quote " ++ show a qqBasicBlockP a@(A.AntiBasicBlockList _s) = error $ "Internal Error: unexpected antiquote " ++ show a qqTerminatorP :: A.Terminator -> Maybe (Q Pat) qqTerminatorP (A.Ret x1 x2) = Just [p|L.Ret $(qqP x1) $(qqP x2)|] qqTerminatorP (A.CondBr x1 x2 x3 x4) = Just [p|L.CondBr $(qqP x1) $(qqP x2) $(qqP x3) $(qqP x4)|] qqTerminatorP (A.Br x1 x2) = Just [p|L.Br $(qqP x1) $(qqP x2)|] qqTerminatorP (A.Switch x1 x2 x3 x4) = Just [p|L.Switch $(qqP x1) $(qqP x2) $(qqP x3) $(qqP x4)|] qqTerminatorP (A.IndirectBr x1 x2 x3) = Just [p|L.IndirectBr $(qqP x1) $(qqP x2) $(qqP x3)|] qqTerminatorP (A.Invoke x1 x2 x3 x4 x5 x6 x7 x8) = Just [p|L.Invoke $(qqP x1) $(qqP x2) $(qqP x3) $(qqP x4) $(qqP x5) $(qqP x6) $(qqP x7) $(qqP x8)|] qqTerminatorP (A.Resume x1 x2) = Just [p|L.Resume $(qqP x1) $(qqP x2)|] qqTerminatorP (A.Unreachable x1) = Just [p|L.Unreachable $(qqP x1)|] qqMemoryOrderingP :: A.MemoryOrdering -> Maybe (Q Pat) qqMemoryOrderingP A.Unordered = Just [p|L.Unordered|] qqMemoryOrderingP A.Monotonic = Just [p|L.Monotonic|] qqMemoryOrderingP A.Acquire = Just [p|L.Acquire|] qqMemoryOrderingP A.Release = Just [p|L.Release|] qqMemoryOrderingP A.AcquireRelease = Just [p|L.AcquireRelease|] qqMemoryOrderingP A.SequentiallyConsistent = Just [p|L.SequentiallyConsistent|] qqAtomicityP :: A.Atomicity -> Maybe (Q Pat) qqAtomicityP (A.Atomicity x1 x2) = Just [p|L.Atomicity $(qqP x1) $(qqP x2)|] qqLandingPadClauseP :: A.LandingPadClause -> Maybe (Q Pat) qqLandingPadClauseP (A.Catch x1) = Just [p|L.Catch $(qqP x1)|] qqLandingPadClauseP (A.Filter x1) = Just [p|L.Filter $(qqP x1)|] qqInstructionP :: A.Instruction -> Maybe (Q Pat) qqInstructionP (A.Add x1 x2 x3 x4 x5) = Just [p|L.Add $(qqP x1) $(qqP x2) $(qqP x3) $(qqP x4) $(qqP x5)|] qqInstructionP (A.FAdd x1 x2 x3) = Just [p|L.FAdd $(qqP x1) $(qqP x2) $(qqP x3)|] qqInstructionP (A.Sub x1 x2 x3 x4 x5) = Just [p|L.Sub $(qqP x1) $(qqP x2) $(qqP x3) $(qqP x4) $(qqP x5)|] qqInstructionP (A.FSub x1 x2 x3) = Just [p|L.FSub $(qqP x1) $(qqP x2) $(qqP x3)|] qqInstructionP (A.Mul x1 x2 x3 x4 x5) = Just [p|L.Mul $(qqP x1) $(qqP x2) $(qqP x3) $(qqP x4) $(qqP x5)|] qqInstructionP (A.FMul x1 x2 x3) = Just [p|L.FMul $(qqP x1) $(qqP x2) $(qqP x3)|] qqInstructionP (A.UDiv x1 x2 x3 x4) = Just [p|L.UDiv $(qqP x1) $(qqP x2) $(qqP x3) $(qqP x4)|] qqInstructionP (A.SDiv x1 x2 x3 x4) = Just [p|L.SDiv $(qqP x1) $(qqP x2) $(qqP x3) $(qqP x4)|] qqInstructionP (A.FDiv x1 x2 x3) = Just [p|L.FDiv $(qqP x1) $(qqP x2) $(qqP x3)|] qqInstructionP (A.URem x1 x2 x3) = Just [p|L.URem $(qqP x1) $(qqP x2) $(qqP x3)|] qqInstructionP (A.SRem x1 x2 x3) = Just [p|L.SRem $(qqP x1) $(qqP x2) $(qqP x3)|] qqInstructionP (A.FRem x1 x2 x3) = Just [p|L.FRem $(qqP x1) $(qqP x2) $(qqP x3)|] qqInstructionP (A.Shl x1 x2 x3 x4 x5) = Just [p|L.Shl $(qqP x1) $(qqP x2) $(qqP x3) $(qqP x4) $(qqP x5)|] qqInstructionP (A.LShr x1 x2 x3 x4) = Just [p|L.LShr $(qqP x1) $(qqP x2) $(qqP x3) $(qqP x4)|] qqInstructionP (A.AShr x1 x2 x3 x4) = Just [p|L.AShr $(qqP x1) $(qqP x2) $(qqP x3) $(qqP x4)|] qqInstructionP (A.And x1 x2 x3) = Just [p|L.And $(qqP x1) $(qqP x2) $(qqP x3)|] qqInstructionP (A.Or x1 x2 x3) = Just [p|L.Or $(qqP x1) $(qqP x2) $(qqP x3)|] qqInstructionP (A.Xor x1 x2 x3) = Just [p|L.Xor $(qqP x1) $(qqP x2) $(qqP x3)|] qqInstructionP (A.Alloca x1 x2 x3 x4) = Just [p|L.Alloca $(qqP x1) $(qqP x2) $(qqP x3) $(qqP x4)|] qqInstructionP (A.Load x1 x2 x3 x4 x5) = Just [p|L.Load $(qqP x1) $(qqP x2) $(qqP x3) $(qqP x4) $(qqP x5)|] qqInstructionP (A.Store x1 x2 x3 x4 x5 x6) = Just [p|L.Store $(qqP x1) $(qqP x2) $(qqP x3) $(qqP x4) $(qqP x5) $(qqP x6)|] qqInstructionP (A.GetElementPtr x1 x2 x3 x4) = Just [p|L.GetElementPtr $(qqP x1) $(qqP x2) $(qqP x3) $(qqP x4)|] qqInstructionP (A.Fence x1 x2) = Just [p|L.Fence $(qqP x1) $(qqP x2)|] qqInstructionP (A.CmpXchg x1 x2 x3 x4 x5 x6) = Just [p|L.CmpXchg $(qqP x1) $(qqP x2) $(qqP x3) $(qqP x4) $(qqP x5) $(qqP x6)|] qqInstructionP (A.AtomicRMW x1 x2 x3 x4 x5 x6) = Just [p|L.AtomicRMW $(qqP x1) $(qqP x2) $(qqP x3) $(qqP x4) $(qqP x5) $(qqP x6)|] qqInstructionP (A.Trunc x1 x2 x3) = Just [p|L.Trunc $(qqP x1) $(qqP x2) $(qqP x3)|] qqInstructionP (A.ZExt x1 x2 x3) = Just [p|L.ZExt $(qqP x1) $(qqP x2) $(qqP x3)|] qqInstructionP (A.SExt x1 x2 x3) = Just [p|L.SExt $(qqP x1) $(qqP x2) $(qqP x3)|] qqInstructionP (A.FPToUI x1 x2 x3) = Just [p|L.FPToUI $(qqP x1) $(qqP x2) $(qqP x3)|] qqInstructionP (A.FPToSI x1 x2 x3) = Just [p|L.FPToSI $(qqP x1) $(qqP x2) $(qqP x3)|] qqInstructionP (A.UIToFP x1 x2 x3) = Just [p|L.UIToFP $(qqP x1) $(qqP x2) $(qqP x3)|] qqInstructionP (A.SIToFP x1 x2 x3) = Just [p|L.SIToFP $(qqP x1) $(qqP x2) $(qqP x3)|] qqInstructionP (A.FPTrunc x1 x2 x3) = Just [p|L.FPTrunc $(qqP x1) $(qqP x2) $(qqP x3)|] qqInstructionP (A.FPExt x1 x2 x3) = Just [p|L.FPExt $(qqP x1) $(qqP x2) $(qqP x3)|] qqInstructionP (A.PtrToInt x1 x2 x3) = Just [p|L.PtrToInt $(qqP x1) $(qqP x2) $(qqP x3)|] qqInstructionP (A.IntToPtr x1 x2 x3) = Just [p|L.IntToPtr $(qqP x1) $(qqP x2) $(qqP x3)|] qqInstructionP (A.BitCast x1 x2 x3) = Just [p|L.BitCast $(qqP x1) $(qqP x2) $(qqP x3)|] qqInstructionP (A.AddrSpaceCast x1 x2 x3) = Just [p|L.AddrSpaceCast $(qqP x1) $(qqP x2) $(qqP x3)|] qqInstructionP (A.ICmp x1 x2 x3 x4) = Just [p|L.ICmp $(qqP x1) $(qqP x2) $(qqP x3) $(qqP x4)|] qqInstructionP (A.FCmp x1 x2 x3 x4) = Just [p|L.FCmp $(qqP x1) $(qqP x2) $(qqP x3) $(qqP x4)|] qqInstructionP (A.Phi x1 x2 x3) = Just [p|L.Phi $(qqP x1) $(qqP x2) $(qqP x3)|] qqInstructionP (A.Call x1 x2 x3 x4 x5 x6 x7) = Just [p|L.Call $(qqP x1) $(qqP x2) $(qqP x3) $(qqP x4) $(qqP x5) $(qqP x6) $(qqP x7)|] qqInstructionP (A.Select x1 x2 x3 x4) = Just [p|L.Select $(qqP x1) $(qqP x2) $(qqP x3) $(qqP x4)|] qqInstructionP (A.VAArg x1 x2 x3) = Just [p|L.VAArg $(qqP x1) $(qqP x2) $(qqP x3)|] qqInstructionP (A.ExtractElement x1 x2 x3) = Just [p|L.ExtractElement $(qqP x1) $(qqP x2) $(qqP x3)|] qqInstructionP (A.InsertElement x1 x2 x3 x4) = Just [p|L.InsertElement $(qqP x1) $(qqP x2) $(qqP x3) $(qqP x4)|] qqInstructionP (A.ShuffleVector x1 x2 x3 x4) = Just [p|L.ShuffleVector $(qqP x1) $(qqP x2) $(qqP x3) $(qqP x4)|] qqInstructionP (A.ExtractValue x1 x2 x3) = Just [p|L.ExtractValue $(qqP x1) $(qqP x2) $(qqP x3)|] qqInstructionP (A.InsertValue x1 x2 x3 x4) = Just [p|L.InsertValue $(qqP x1) $(qqP x2) $(qqP x3) $(qqP x4)|] qqInstructionP (A.LandingPad x1 x2 x3 x4 x5) = Just [p|L.LandingPad $(qqP x1) $(qqP x2) $(qqP x3) $(qqP x4) $(qqP x5)|] qqInstructionP (A.AntiInstruction s) = Just $ antiVarP s qqNamedP :: (Typeable a, Data a) => A.Named a -> Maybe (Q Pat) qqNamedP ((A.:=) x1 x2) = Just [p|(L.:=) $(qqP x1) $(qqP x2)|] qqNamedP (A.Do x1) = Just [p|L.Do $(qqP x1)|] qqMetadataNodeIDP :: A.MetadataNodeID -> Maybe (Q Pat) qqMetadataNodeIDP (A.MetadataNodeID x1) = Just [p|L.MetadataNodeID $(qqP x1)|] qqMetadataNodeP :: A.MetadataNode -> Maybe (Q Pat) qqMetadataNodeP (A.MetadataNode x1) = Just [p|L.MetadataNode $(qqP x1)|] qqMetadataNodeP (A.MetadataNodeReference x1) = Just [p|L.MetadataNodeReference $(qqP x1)|] qqOperandP :: A.Operand -> Maybe (Q Pat) qqOperandP (A.LocalReference x1) = Just [p|L.LocalReference $(qqP x1)|] qqOperandP (A.ConstantOperand x1) = Just [p|L.ConstantOperand $(qqP x1)|] qqOperandP (A.MetadataStringOperand x1) = Just [p|L.MetadataStringOperand $(qqP x1)|] qqOperandP (A.MetadataNodeOperand x1) = Just [p|L.MetadataNodeOperand $(qqP x1)|] qqConstantP :: A.Constant -> Maybe (Q Pat) qqConstantP (A.Int x1 x2) = Just [p|L.Int $(qqP x1) $(qqP x2)|] qqConstantP (A.Float x1) = Just [p|L.Float $(qqP x1)|] qqConstantP (A.Null x1) = Just [p|L.Null $(qqP x1)|] qqConstantP (A.Struct x1 x2 x3) = Just [p|L.Struct $(qqP x1) $(qqP x2) $(qqP x3)|] qqConstantP (A.Array x1 x2) = Just [p|L.Array $(qqP x1) $(qqP x2)|] qqConstantP (A.Vector x1) = Just [p|L.Vector $(qqP x1)|] qqConstantP (A.Undef x1) = Just [p|L.Undef $(qqP x1)|] qqConstantP (A.BlockAddress x1 x2) = Just [p|L.BlockAddress $(qqP x1) $(qqP x2)|] qqConstantP (A.GlobalReference x1) = Just [p|L.GlobalReference $(qqP x1)|] qqConstantP (A.AntiConstant s) = Just $ antiVarP s qqNameP :: A.Name -> Maybe (Q Pat) qqNameP (A.Name x1) = Just [p|L.Name $(qqP x1)|] qqNameP (A.UnName x1) = Just [p|L.UnName $(qqP x1)|] qqNameP (A.AntiName s) = Just $ antiVarP s qqFloatingPointFormatP :: A.FloatingPointFormat -> Maybe (Q Pat) qqFloatingPointFormatP A.IEEE = Just [p|L.IEEE|] qqFloatingPointFormatP A.DoubleExtended = Just [p|L.DoubleExtended|] qqFloatingPointFormatP A.PairOfFloats = Just [p|L.PairOfFloats|] qqTypeP :: A.Type -> Maybe (Q Pat) qqTypeP A.VoidType = Just [p|L.VoidType|] qqTypeP (A.IntegerType x1) = Just [p|L.IntegerType $(qqP x1)|] qqTypeP (A.PointerType x1 x2) = Just [p|L.PointerType $(qqP x1) $(qqP x2)|] qqTypeP (A.FloatingPointType x1 x2) = Just [p|L.FloatingPointType $(qqP x1) $(qqP x2)|] qqTypeP (A.FunctionType x1 x2 x3) = Just [p|L.FunctionType $(qqP x1) $(qqP x2) $(qqP x3)|] qqTypeP (A.VectorType x1 x2) = Just [p|L.VectorType $(qqP x1) $(qqP x2)|] qqTypeP (A.StructureType x1 x2) = Just [p|L.StructureType $(qqP x1) $(qqP x2)|] qqTypeP (A.ArrayType x1 x2) = Just [p|L.ArrayType $(qqP x1) $(qqP x2)|] qqTypeP (A.NamedTypeReference x1) = Just [p|L.NamedTypeReference $(qqP x1)|] qqTypeP A.MetadataType = Just [p|L.MetadataType|] qqDialectP :: A.Dialect -> Maybe (Q Pat) qqDialectP A.ATTDialect = Just [p|L.ATTDialect|] qqDialectP A.IntelDialect = Just [p|L.IntelDialect|] qqInlineAssemblyP :: A.InlineAssembly -> Maybe (Q Pat) qqInlineAssemblyP (A.InlineAssembly x1 x2 x3 x4 x5 x6) = Just [p|L.InlineAssembly $(qqP x1) $(qqP x2) $(qqP x3) $(qqP x4) $(qqP x5) $(qqP x6)|] qqEndiannessP :: A.Endianness -> Maybe (Q Pat) qqEndiannessP A.LittleEndian = Just [p|L.LittleEndian|] qqEndiannessP A.BigEndian = Just [p|L.BigEndian|] qqAlignmentInfoP :: A.AlignmentInfo -> Maybe (Q Pat) qqAlignmentInfoP (A.AlignmentInfo x1 x2) = Just [p|L.AlignmentInfo $(qqP x1) $(qqP x2)|] qqAlignTypeP :: A.AlignType -> Maybe (Q Pat) qqAlignTypeP A.IntegerAlign = Just [p|L.IntegerAlign|] qqAlignTypeP A.VectorAlign = Just [p|L.VectorAlign|] qqAlignTypeP A.FloatAlign = Just [p|L.FloatAlign|] qqAlignTypeP A.AggregateAlign = Just [p|L.AggregateAlign|] qqAlignTypeP A.StackAlign = Just [p|L.StackAlign|] qqDataLayoutP :: A.DataLayout -> Maybe (Q Pat) qqDataLayoutP (A.DataLayout x1 x2 x3 x4 x5) = Just [p|L.DataLayout $(qqP x1) $(qqP x2) $(qqP x3) $(qqP x4) $(qqP x5)|] qqDataLayoutP (A.AntiDataLayout s) = Just $ antiVarP s qqTargetTripleP :: A.TargetTriple -> Maybe (Q Pat) qqTargetTripleP A.NoTargetTriple = Just [p|Nothing|] qqTargetTripleP (A.TargetTriple v) = Just [p|Just $(qqP v)|] qqTargetTripleP (A.AntiTargetTriple v) = Just $ antiVarP v qqP :: Data a => a -> Q Pat qqP x = dataToPatQ qqPat x qqPat :: Typeable a => a -> Maybe (Q Pat) qqPat = const Nothing `extQ` qqDefinitionP `extQ` qqDefinitionListP `extQ` qqModuleP `extQ` qqGlobalP `extQ` qqParameterListP `extQ` qqParameterP `extQ` qqBasicBlockP `extQ` qqBasicBlockListP `extQ` qqTerminatorP `extQ` qqMemoryOrderingP `extQ` qqAtomicityP `extQ` qqLandingPadClauseP `extQ` qqInstructionP `extQ` (qqNamedP :: A.Named A.Instruction -> Maybe (Q Pat)) `extQ` (qqNamedP :: A.Named A.Terminator -> Maybe (Q Pat)) `extQ` qqMetadataNodeIDP `extQ` qqMetadataNodeP `extQ` qqOperandP `extQ` qqConstantP `extQ` qqNameP `extQ` qqFloatingPointFormatP `extQ` qqTypeP `extQ` qqDialectP `extQ` qqInlineAssemblyP `extQ` qqEndiannessP `extQ` qqAlignmentInfoP `extQ` qqAlignTypeP `extQ` qqDataLayoutP `extQ` qqTargetTripleP parse :: [A.Extensions] -> P.P a -> String -> Q a parse exts p s = do loc <- location case P.parse (A.Antiquotation : exts) p (B.pack s) (locToPos loc) of Left err -> fail (show err) Right x -> return x where locToPos :: Language.Haskell.TH.Loc -> Pos locToPos loc = Pos (loc_filename loc) ((fst . loc_start) loc) ((snd . loc_start) loc) 0 quasiquote :: Data a => [A.Extensions] -> P.P a -> QuasiQuoter quasiquote exts p = QuasiQuoter { quoteExp = parse exts p >=> qqE , quotePat = parse exts p >=> qqP , quoteType = fail "LLVM type quasiquoter undefined" , quoteDec = fail "LLVM declaration quasiquoter undefined" }