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
data Target
= Target_None
| Target_None_Core_AsIs
| Target_None_Core_CoreRun
| Target_None_TyCore_None
| Target_Interpreter_Core_Jazy
| Target_Interpreter_Core_JavaScript
| Target_Interpreter_GrinCmm_JavaScript
| Target_FullProgAnal_Grin_C
| Target_FullProgAnal_Grin_LLVM
| Target_FullProgAnal_Grin_JVM
| Target_Interpreter_Grin_C
| Target_FullProgAnal_Grin_CLR
deriving ( Eq, Ord, Enum )
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"
defaultTarget :: Target
defaultTarget = Target_None_Core_AsIs
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' " "
data TargetFlavor
= TargetFlavor_Plain
| TargetFlavor_Debug
deriving (Eq,Ord,Enum)
defaultTargetFlavor :: TargetFlavor
defaultTargetFlavor = TargetFlavor_Plain
instance Show TargetFlavor where
show TargetFlavor_Plain = "plain"
show TargetFlavor_Debug = "debug"
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' " "
targetDoesHPTAnalysis :: Target -> Bool
targetDoesHPTAnalysis t
= case t of
_ -> False
targetIsViaGrin :: Target -> Bool
targetIsViaGrin t
= case t of
_ -> False
targetIsGrinBytecode :: Target -> Bool
targetIsGrinBytecode t
= case t of
_ -> False
targetAllowsGrinNodePtrMix :: Target -> Bool
targetAllowsGrinNodePtrMix t
= case t of
_ -> False
targetIsC :: Target -> Bool
targetIsC t
= case t of
_ -> False
targetAllowsOLinking :: Target -> Bool
targetAllowsOLinking t
= case t of
_ -> False
targetAllowsJarLinking :: Target -> Bool
targetAllowsJarLinking t
= case t of
_ -> False
targetIsCoreVariation :: Target -> Bool
targetIsCoreVariation t
= case t of
Target_None_Core_AsIs -> True
Target_None_Core_CoreRun -> True
_ -> False
targetIsCoreRun :: Target -> Bool
targetIsCoreRun t
= case t of
Target_None_Core_CoreRun -> True
_ -> False
targetIsTyCore :: Target -> Bool
targetIsTyCore t
= case t of
Target_None_TyCore_None -> True
_ -> False
targetIsJVM :: Target -> Bool
targetIsJVM t
= case t of
_ -> False
targetIsViaGrinCmmJavaScript :: Target -> Bool
targetIsViaGrinCmmJavaScript t
= case t of
_ -> False
targetIsViaCoreJavaScript :: Target -> Bool
targetIsViaCoreJavaScript t
= case t of
_ -> False
targetIsJavaScript :: Target -> Bool
targetIsJavaScript t
= case t of
_ -> False
targetIsOnUnixAndOrC :: Target -> Bool
targetIsOnUnixAndOrC t
= targetIsC t || targetIsJVM t
data FFIWay
= FFIWay_Prim
| FFIWay_CCall
| FFIWay_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
ffiWayForPrim :: Target -> Maybe FFIWay
ffiWayForPrim t
| targetIsC t = Just FFIWay_CCall
| otherwise = Nothing
data TargetInfo
= TargetInfo
{ targiAllowedFFI :: [FFIWay]
}
type TargInfoMp = Map.Map Target TargetInfo
allTargetInfoMp :: TargInfoMp
allFFIWays :: [FFIWay]
allFFIWays = nub $ (FFIWay_Prim :) $ concatMap targiAllowedFFI $ Map.elems allTargetInfoMp
deriving instance Typeable Target
deriving instance Data Target
deriving instance Typeable FFIWay
deriving instance Data FFIWay
deriving instance Typeable TargetFlavor
deriving instance Data TargetFlavor
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