{-# 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 String "AtomicCmpXchg" = String "CmpXchg" refName String "PHI" = String "Phi" refName String x = String x innerJoin :: Ord k => Map k a -> Map k b -> Map k (a,b) innerJoin :: forall k a b. Ord k => 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 :: forall k a b. Ord k => Map k a -> Map k b -> Map k (Maybe a, Maybe b) outerJoin Map k a xs 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 -> 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 -> (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, Maybe a Nothing) (Maybe a Nothing, Just 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 (Maybe a, Maybe a) _ (Maybe a, Maybe a) _ = String -> (Maybe a, Maybe a) forall a. HasCallStack => String -> a error String "outerJoin: the impossible happened" instrP :: TH.QuasiQuoter instrP :: QuasiQuoter instrP = 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 (m :: * -> *) a. (Quote m, Data a) => (forall b. Data b => b -> Maybe (m Pat)) -> a -> m 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 }