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 Typeable FFIWay
deriving instance Typeable 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