{-# 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
 }