Target.hs

module UHC.Light.Compiler.Base.Target
( Target (..)
, defaultTarget
, supportedTargetMp, showSupportedTargets', showSupportedTargets
, TargetFlavor (..)
, defaultTargetFlavor
, allTargetFlavorMp, showAllTargetFlavors', showAllTargetFlavors
, targetDoesHPTAnalysis
, targetIsGrinBytecode
, targetAllowsGrinNodePtrMix
, targetIsC
, targetAllowsOLinking
, targetAllowsJarLinking
, targetIsCore
, 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_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 118 "src/ehc/Base/Target.chs" #-}
instance Show Target where
  show Target_None							= "NONE"
  show Target_None_Core_AsIs				= "cr"
  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 140 "src/ehc/Base/Target.chs" #-}
defaultTarget :: Target
defaultTarget = Target_None_Core_AsIs

{-# LINE 153 "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 t ffis = (t,TargetInfo (FFIWay_Prim : ffis))

showSupportedTargets' :: String -> String
showSupportedTargets'
  = showStringMapKeys supportedTargetMp

showSupportedTargets :: String
showSupportedTargets
  = showSupportedTargets' " "

{-# LINE 206 "src/ehc/Base/Target.chs" #-}
data TargetFlavor
  = TargetFlavor_Plain						-- no special stuff
  | TargetFlavor_Debug						-- debugging variant
  -- more: profiling, ....
  deriving (Eq,Ord,Enum)

{-# LINE 214 "src/ehc/Base/Target.chs" #-}
defaultTargetFlavor :: TargetFlavor
defaultTargetFlavor = TargetFlavor_Plain

{-# LINE 219 "src/ehc/Base/Target.chs" #-}
instance Show TargetFlavor where
  show TargetFlavor_Plain				= "plain"
  show TargetFlavor_Debug				= "debug"

{-# LINE 227 "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 252 "src/ehc/Base/Target.chs" #-}
targetDoesHPTAnalysis :: Target -> Bool
targetDoesHPTAnalysis t
  = case t of
      _ 								-> False

{-# LINE 293 "src/ehc/Base/Target.chs" #-}
targetIsGrinBytecode :: Target -> Bool
targetIsGrinBytecode t
  = case t of
      _ 								-> False
{-# INLINE targetIsGrinBytecode #-}

{-# LINE 304 "src/ehc/Base/Target.chs" #-}
targetAllowsGrinNodePtrMix :: Target -> Bool
targetAllowsGrinNodePtrMix t
  = case t of
      _ 								-> False
{-# INLINE targetAllowsGrinNodePtrMix #-}

{-# LINE 316 "src/ehc/Base/Target.chs" #-}
targetIsC :: Target -> Bool
targetIsC t
  = case t of
      _ 								-> False
{-# INLINE targetIsC #-}

{-# LINE 330 "src/ehc/Base/Target.chs" #-}
targetAllowsOLinking :: Target -> Bool
targetAllowsOLinking t
  = case t of
      _ 								-> False
{-# INLINE targetAllowsOLinking #-}

{-# LINE 341 "src/ehc/Base/Target.chs" #-}
targetAllowsJarLinking :: Target -> Bool
targetAllowsJarLinking t
  = case t of
      _ 								-> False
{-# INLINE targetAllowsJarLinking #-}

{-# LINE 352 "src/ehc/Base/Target.chs" #-}
targetIsCore :: Target -> Bool
targetIsCore t
  = case t of
      Target_None_Core_AsIs				-> True
      _ 								-> False
{-# INLINE targetIsCore #-}

{-# LINE 361 "src/ehc/Base/Target.chs" #-}
targetIsTyCore :: Target -> Bool
targetIsTyCore t
  = case t of
      Target_None_TyCore_None			-> True
      _ 								-> False
{-# INLINE targetIsTyCore #-}

{-# LINE 370 "src/ehc/Base/Target.chs" #-}
targetIsJVM :: Target -> Bool
targetIsJVM t
  = case t of
      _ 								-> False
{-# INLINE targetIsJVM #-}

{-# LINE 381 "src/ehc/Base/Target.chs" #-}
targetIsViaGrinCmmJavaScript :: Target -> Bool
targetIsViaGrinCmmJavaScript t
  = case t of
      _ 									-> False
{-# INLINE targetIsViaGrinCmmJavaScript #-}

{-# LINE 392 "src/ehc/Base/Target.chs" #-}
targetIsViaCoreJavaScript :: Target -> Bool
targetIsViaCoreJavaScript t
  = case t of
      _ 									-> False
{-# INLINE targetIsViaCoreJavaScript #-}

{-# LINE 403 "src/ehc/Base/Target.chs" #-}
targetIsJavaScript :: Target -> Bool
targetIsJavaScript t
  = case t of
      _ 									-> False
{-# INLINE targetIsJavaScript #-}

{-# LINE 437 "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 449 "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 479 "src/ehc/Base/Target.chs" #-}
ffiWayForPrim :: Target -> Maybe FFIWay
ffiWayForPrim t
  | targetIsC t			              				= Just FFIWay_CCall
  | otherwise			              				= Nothing

{-# LINE 507 "src/ehc/Base/Target.chs" #-}
data TargetInfo
  = TargetInfo
      { targiAllowedFFI		:: [FFIWay]
      }

type TargInfoMp = Map.Map Target TargetInfo

{-# LINE 516 "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 529 "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 544 "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