{-# LANGUAGE TemplateHaskell, CPP #-} module LLVM.Internal.InstructionDefs ( astInstructionRecs, astConstantRecs, instructionDefs, ID.InstructionKind(..), ID.InstructionDef(..), instrP, innerJoin, outerJoin ) where import LLVM.Prelude import qualified Language.Haskell.TH as TH import qualified Language.Haskell.TH.Quote as TH import Data.Map (Map) import qualified Data.Map as Map import qualified LLVM.Internal.FFI.InstructionDefs as ID import qualified LLVM.AST.Instruction as A import qualified LLVM.AST.Constant as A.C $(do let ctorRecs t = do #if __GLASGOW_HASKELL__ < 800 TH.TyConI (TH.DataD _ _ _ cons _) <- TH.reify t #else TH.TyConI (TH.DataD _ _ _ _ cons _) <- TH.reify t #endif TH.dataToExpQ (const Nothing) $ [ (TH.nameBase n, rec) | rec@(TH.RecC n _) <- cons ] [d| astInstructionRecs :: Map String TH.Con astInstructionRecs = Map.fromList $(ctorRecs ''A.Instruction) astConstantRecs :: Map String TH.Con astConstantRecs = Map.fromList $(ctorRecs ''A.C.Constant) |] ) instructionDefs :: Map String ID.InstructionDef instructionDefs :: Map String InstructionDef instructionDefs = [(String, InstructionDef)] -> Map String InstructionDef forall k a. Ord k => [(k, a)] -> Map k a Map.fromList [ ((String -> String refName (String -> String) -> (InstructionDef -> String) -> InstructionDef -> String forall b c a. (b -> c) -> (a -> b) -> a -> c . InstructionDef -> String ID.cAPIName (InstructionDef -> String) -> InstructionDef -> String forall a b. (a -> b) -> a -> b $ InstructionDef i), InstructionDef i) | InstructionDef i <- [InstructionDef] ID.instructionDefs ] where refName :: String -> String refName "AtomicCmpXchg" = "CmpXchg" refName "PHI" = "Phi" refName x :: String x = String x innerJoin :: Ord k => Map k a -> Map k b -> Map k (a,b) innerJoin :: Map k a -> Map k b -> Map k (a, b) innerJoin = (a -> b -> (a, b)) -> Map k a -> Map k b -> Map k (a, b) forall k a b c. Ord k => (a -> b -> c) -> Map k a -> Map k b -> Map k c Map.intersectionWith (,) outerJoin :: Ord k => Map k a -> Map k b -> Map k (Maybe a, Maybe b) outerJoin :: Map k a -> Map k b -> Map k (Maybe a, Maybe b) outerJoin xs :: Map k a xs ys :: Map k b ys = ((Maybe a, Maybe b) -> (Maybe a, Maybe b) -> (Maybe a, Maybe b)) -> Map k (Maybe a, Maybe b) -> Map k (Maybe a, Maybe b) -> Map k (Maybe a, Maybe b) forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a Map.unionWith (Maybe a, Maybe b) -> (Maybe a, Maybe b) -> (Maybe a, Maybe b) forall a a a a. (Maybe a, Maybe a) -> (Maybe a, Maybe a) -> (Maybe a, Maybe a) combine ((a -> (Maybe a, Maybe b)) -> Map k a -> Map k (Maybe a, Maybe b) forall a b k. (a -> b) -> Map k a -> Map k b Map.map (\a :: a a -> (a -> Maybe a forall a. a -> Maybe a Just a a, Maybe b forall a. Maybe a Nothing)) Map k a xs) ((b -> (Maybe a, Maybe b)) -> Map k b -> Map k (Maybe a, Maybe b) forall a b k. (a -> b) -> Map k a -> Map k b Map.map (\b :: b b -> (Maybe a forall a. Maybe a Nothing, b -> Maybe b forall a. a -> Maybe a Just b b)) Map k b ys) where combine :: (Maybe a, Maybe a) -> (Maybe a, Maybe a) -> (Maybe a, Maybe a) combine (Just a :: a a, Nothing) (Nothing, Just b :: a b) = (a -> Maybe a forall a. a -> Maybe a Just a a, a -> Maybe a forall a. a -> Maybe a Just a b) combine _ _ = String -> (Maybe a, Maybe a) forall a. HasCallStack => String -> a error "outerJoin: the impossible happened" instrP :: TH.QuasiQuoter instrP :: QuasiQuoter instrP = QuasiQuoter :: (String -> Q Exp) -> (String -> Q Pat) -> (String -> Q Type) -> (String -> Q [Dec]) -> QuasiQuoter TH.QuasiQuoter { quoteExp :: String -> Q Exp TH.quoteExp = String -> Q Exp forall a. HasCallStack => a undefined, quotePat :: String -> Q Pat TH.quotePat = let m :: Map String CPPOpcode m = [(String, CPPOpcode)] -> Map String CPPOpcode forall k a. Ord k => [(k, a)] -> Map k a Map.fromList [ (InstructionDef -> String ID.cAPIName InstructionDef i, InstructionDef -> CPPOpcode ID.cppOpcode InstructionDef i) | InstructionDef i <- [InstructionDef] ID.instructionDefs ] in (forall b. Data b => b -> Maybe (Q Pat)) -> CPPOpcode -> Q Pat forall a. Data a => (forall b. Data b => b -> Maybe (Q Pat)) -> a -> Q Pat TH.dataToPatQ (Maybe (Q Pat) -> b -> Maybe (Q Pat) forall a b. a -> b -> a const Maybe (Q Pat) forall a. Maybe a Nothing) (CPPOpcode -> Q Pat) -> (String -> CPPOpcode) -> String -> Q Pat forall b c a. (b -> c) -> (a -> b) -> a -> c . (Map String CPPOpcode m Map String CPPOpcode -> String -> CPPOpcode forall k a. Ord k => Map k a -> k -> a Map.!), quoteType :: String -> Q Type TH.quoteType = String -> Q Type forall a. HasCallStack => a undefined, quoteDec :: String -> Q [Dec] TH.quoteDec = String -> Q [Dec] forall a. HasCallStack => a undefined }