module UHC.Light.Compiler.Base.Target ( Target (..) , defaultTarget , supportedTargetMp, showSupportedTargets', showSupportedTargets , TargetFlavor (..) , defaultTargetFlavor , allTargetFlavorMp, showAllTargetFlavors', showAllTargetFlavors , targetDoesHPTAnalysis , targetIsViaGrin , targetIsGrinBytecode , targetAllowsGrinNodePtrMix , targetIsC , targetAllowsOLinking , targetAllowsJarLinking , targetIsCoreVariation , targetIsCoreRun , targetIsTyCore , targetIsJVM , targetIsViaGrinCmmJavaScript , targetIsViaCoreJavaScript , targetIsJavaScript , targetIsOnUnixAndOrC , FFIWay (..) , ffiWayForPrim , TargetInfo (..), TargInfoMp , allTargetInfoMp, allFFIWays ) where import qualified Data.Map as Map import Data.List import UHC.Util.Pretty import UHC.Util.Utils import UHC.Util.Binary import UHC.Util.Serialize {-# LINE 78 "src/ehc/Base/Target.chs" #-} -- | All possible targets, even though they may not be configured (done in supportedTargetMp) data Target = Target_None -- no codegen | Target_None_Core_AsIs -- only Core | Target_None_Core_CoreRun -- CoreRun via Core | Target_None_TyCore_None -- only TyCore -- jazy | Target_Interpreter_Core_Jazy -- java based on Core, using jazy library -- javascript | Target_Interpreter_Core_JavaScript -- javascript based on Core | Target_Interpreter_GrinCmm_JavaScript -- javascript based on Grin -> Cmm -- grin, wholeprogC | Target_FullProgAnal_Grin_C -- full program analysis on grin, generating C -- grin, llvm, wholeprogC | Target_FullProgAnal_Grin_LLVM -- full program analysis on grin, generating LLVM -- grin, jvm, wholeprogC | Target_FullProgAnal_Grin_JVM -- full program analysis on grin, generating for Java VM -- grin | Target_Interpreter_Grin_C -- no full program analysis, grin interpreter, generating C -- grin, clr, wholeprogC | Target_FullProgAnal_Grin_CLR -- full program analysis on grin, generating for Common Language Runtime (.NET / Mono) deriving ( Eq, Ord, Enum ) {-# LINE 119 "src/ehc/Base/Target.chs" #-} instance Show Target where show Target_None = "NONE" show Target_None_Core_AsIs = "cr" show Target_None_Core_CoreRun = "crr" show Target_None_TyCore_None = "tycore" show Target_Interpreter_Core_Jazy = "jazy" show Target_Interpreter_Core_JavaScript = "js" show Target_Interpreter_GrinCmm_JavaScript= "cmmjs" show Target_FullProgAnal_Grin_C = "C" show Target_FullProgAnal_Grin_LLVM = "llvm" show Target_FullProgAnal_Grin_JVM = "jvm" show Target_Interpreter_Grin_C = "bc" show Target_FullProgAnal_Grin_CLR = "clr" {-# LINE 142 "src/ehc/Base/Target.chs" #-} defaultTarget :: Target defaultTarget = Target_None_Core_AsIs {-# LINE 155 "src/ehc/Base/Target.chs" #-} supportedTargetMp :: Map.Map String Target (supportedTargetMp,allTargetInfoMp) = (Map.fromList ts, Map.fromList is) where (ts,is) = unzip [ ((show t, t),(t,i)) | (t,i) <- [] ++ [ mk Target_None_Core_AsIs [] ] -- ++ [ mk Target_None_Core_CoreRun [] ] ] mk t ffis = (t,TargetInfo (FFIWay_Prim : ffis)) showSupportedTargets' :: String -> String showSupportedTargets' = showStringMapKeys supportedTargetMp showSupportedTargets :: String showSupportedTargets = showSupportedTargets' " " {-# LINE 211 "src/ehc/Base/Target.chs" #-} data TargetFlavor = TargetFlavor_Plain -- no special stuff | TargetFlavor_Debug -- debugging variant -- more: profiling, .... deriving (Eq,Ord,Enum) {-# LINE 219 "src/ehc/Base/Target.chs" #-} defaultTargetFlavor :: TargetFlavor defaultTargetFlavor = TargetFlavor_Plain {-# LINE 224 "src/ehc/Base/Target.chs" #-} instance Show TargetFlavor where show TargetFlavor_Plain = "plain" show TargetFlavor_Debug = "debug" {-# LINE 232 "src/ehc/Base/Target.chs" #-} allTargetFlavorMp :: Map.Map String TargetFlavor allTargetFlavorMp = Map.fromList ts where ts = [ (show t, t) | t <- [ TargetFlavor_Plain , TargetFlavor_Debug ] ] showAllTargetFlavors' :: String -> String showAllTargetFlavors' = showStringMapKeys allTargetFlavorMp showAllTargetFlavors :: String showAllTargetFlavors = showAllTargetFlavors' " " {-# LINE 257 "src/ehc/Base/Target.chs" #-} targetDoesHPTAnalysis :: Target -> Bool targetDoesHPTAnalysis t = case t of _ -> False {-# LINE 286 "src/ehc/Base/Target.chs" #-} targetIsViaGrin :: Target -> Bool targetIsViaGrin t = case t of _ -> False {-# INLINE targetIsViaGrin #-} {-# LINE 298 "src/ehc/Base/Target.chs" #-} targetIsGrinBytecode :: Target -> Bool targetIsGrinBytecode t = case t of _ -> False {-# INLINE targetIsGrinBytecode #-} {-# LINE 309 "src/ehc/Base/Target.chs" #-} targetAllowsGrinNodePtrMix :: Target -> Bool targetAllowsGrinNodePtrMix t = case t of _ -> False {-# INLINE targetAllowsGrinNodePtrMix #-} {-# LINE 321 "src/ehc/Base/Target.chs" #-} targetIsC :: Target -> Bool targetIsC t = case t of _ -> False {-# INLINE targetIsC #-} {-# LINE 335 "src/ehc/Base/Target.chs" #-} targetAllowsOLinking :: Target -> Bool targetAllowsOLinking t = case t of _ -> False {-# INLINE targetAllowsOLinking #-} {-# LINE 346 "src/ehc/Base/Target.chs" #-} targetAllowsJarLinking :: Target -> Bool targetAllowsJarLinking t = case t of _ -> False {-# INLINE targetAllowsJarLinking #-} {-# LINE 357 "src/ehc/Base/Target.chs" #-} -- | Is a variation of direct Core running, without further platform dependent translation targetIsCoreVariation :: Target -> Bool targetIsCoreVariation t = case t of Target_None_Core_AsIs -> True Target_None_Core_CoreRun -> True _ -> False {-# INLINE targetIsCoreVariation #-} {-# LINE 370 "src/ehc/Base/Target.chs" #-} -- | Is CoreRun target targetIsCoreRun :: Target -> Bool targetIsCoreRun t = case t of Target_None_Core_CoreRun -> True _ -> False {-# LINE 381 "src/ehc/Base/Target.chs" #-} targetIsTyCore :: Target -> Bool targetIsTyCore t = case t of Target_None_TyCore_None -> True _ -> False {-# INLINE targetIsTyCore #-} {-# LINE 390 "src/ehc/Base/Target.chs" #-} targetIsJVM :: Target -> Bool targetIsJVM t = case t of _ -> False {-# INLINE targetIsJVM #-} {-# LINE 401 "src/ehc/Base/Target.chs" #-} targetIsViaGrinCmmJavaScript :: Target -> Bool targetIsViaGrinCmmJavaScript t = case t of _ -> False {-# INLINE targetIsViaGrinCmmJavaScript #-} {-# LINE 412 "src/ehc/Base/Target.chs" #-} targetIsViaCoreJavaScript :: Target -> Bool targetIsViaCoreJavaScript t = case t of _ -> False {-# INLINE targetIsViaCoreJavaScript #-} {-# LINE 423 "src/ehc/Base/Target.chs" #-} targetIsJavaScript :: Target -> Bool targetIsJavaScript t = case t of _ -> False {-# INLINE targetIsJavaScript #-} {-# LINE 457 "src/ehc/Base/Target.chs" #-} -- | target runs on (possibly emulated) UNIX / C environment? this should coincide with flag EHC_CFG_USE_UNIX_AND_C in src/ehc/variant.mk targetIsOnUnixAndOrC :: Target -> Bool targetIsOnUnixAndOrC t = targetIsC t || targetIsJVM t {-# INLINE targetIsOnUnixAndOrC #-} {-# LINE 469 "src/ehc/Base/Target.chs" #-} data FFIWay = FFIWay_Prim -- as primitive | FFIWay_CCall -- as C call | FFIWay_Jazy -- as Java/Jazy deriving (Eq,Ord,Enum) instance Show FFIWay where show FFIWay_Prim = "prim" show FFIWay_CCall = "ccall" show FFIWay_Jazy = "jazy" instance PP FFIWay where pp = pp . show {-# LINE 499 "src/ehc/Base/Target.chs" #-} ffiWayForPrim :: Target -> Maybe FFIWay ffiWayForPrim t | targetIsC t = Just FFIWay_CCall | otherwise = Nothing {-# LINE 527 "src/ehc/Base/Target.chs" #-} data TargetInfo = TargetInfo { targiAllowedFFI :: [FFIWay] } type TargInfoMp = Map.Map Target TargetInfo {-# LINE 536 "src/ehc/Base/Target.chs" #-} allTargetInfoMp :: TargInfoMp -- | All allowed platform dependent ways to do a FFI call, a primitive 'FFIWay_Prim' is always allowed even though there might be no backend for it. -- This allows code still to compile when no target/backend is available. allFFIWays :: [FFIWay] allFFIWays = nub $ (FFIWay_Prim :) $ concatMap targiAllowedFFI $ Map.elems allTargetInfoMp {-# LINE 549 "src/ehc/Base/Target.chs" #-} deriving instance Typeable Target deriving instance Data Target deriving instance Typeable FFIWay deriving instance Data FFIWay deriving instance Typeable TargetFlavor deriving instance Data TargetFlavor {-# LINE 564 "src/ehc/Base/Target.chs" #-} instance Binary Target where put = putEnum8 get = getEnum8 instance Serialize Target where sput = sputPlain sget = sgetPlain instance Binary FFIWay where put = putEnum8 get = getEnum8 instance Serialize FFIWay where sput = sputPlain sget = sgetPlain instance Binary TargetFlavor where put = putEnum8 get = getEnum8 instance Serialize TargetFlavor where sput = sputPlain sget = sgetPlain