module DDC.Core.Salt.Name.PrimTyCon
( PrimTyCon (..)
, readPrimTyCon
, primTyConIsIntegral
, primTyConIsFloating
, primTyConIsUnsigned
, primTyConIsSigned
, primTyConWidth)
where
import DDC.Base.Pretty
import DDC.Core.Salt.Platform
import Data.Char
import Data.List
import Control.DeepSeq
data PrimTyCon
= PrimTyConVoid
| PrimTyConBool
| PrimTyConNat
| PrimTyConInt
| PrimTyConWord Int
| PrimTyConFloat Int
| PrimTyConTag
| PrimTyConAddr
| PrimTyConPtr
| PrimTyConString
deriving (Eq, Ord, Show)
instance NFData PrimTyCon where
rnf tc
= case tc of
PrimTyConWord i -> rnf i
PrimTyConFloat i -> rnf i
_ -> ()
instance Pretty PrimTyCon where
ppr tc
= case tc of
PrimTyConVoid -> text "Void#"
PrimTyConBool -> text "Bool#"
PrimTyConNat -> text "Nat#"
PrimTyConInt -> text "Int#"
PrimTyConWord bits -> text "Word" <> int bits <> text "#"
PrimTyConFloat bits -> text "Float" <> int bits <> text "#"
PrimTyConTag -> text "Tag#"
PrimTyConAddr -> text "Addr#"
PrimTyConPtr -> text "Ptr#"
PrimTyConString -> text "String#"
readPrimTyCon :: String -> Maybe PrimTyCon
readPrimTyCon str
| str == "Void#" = Just $ PrimTyConVoid
| str == "Bool#" = Just $ PrimTyConBool
| str == "Nat#" = Just $ PrimTyConNat
| str == "Int#" = Just $ PrimTyConInt
| str == "Tag#" = Just $ PrimTyConTag
| str == "Addr#" = Just $ PrimTyConAddr
| str == "Ptr#" = Just $ PrimTyConPtr
| str == "String#" = Just $ PrimTyConString
| Just rest <- stripPrefix "Word" str
, (ds, "#") <- span isDigit rest
, not $ null ds
, n <- read ds
, elem n [8, 16, 32, 64]
= Just $ PrimTyConWord n
| Just rest <- stripPrefix "Float" str
, (ds, "#") <- span isDigit rest
, not $ null ds
, n <- read ds
, elem n [32, 64]
= Just $ PrimTyConFloat n
| otherwise
= Nothing
primTyConIsIntegral :: PrimTyCon -> Bool
primTyConIsIntegral tc
= case tc of
PrimTyConBool -> True
PrimTyConNat -> True
PrimTyConInt -> True
PrimTyConWord{} -> True
PrimTyConTag -> True
_ -> False
primTyConIsFloating :: PrimTyCon -> Bool
primTyConIsFloating tc
= case tc of
PrimTyConFloat{} -> True
_ -> False
primTyConIsUnsigned :: PrimTyCon -> Bool
primTyConIsUnsigned tc
= case tc of
PrimTyConBool -> True
PrimTyConNat -> True
PrimTyConWord{} -> True
PrimTyConTag -> True
_ -> False
primTyConIsSigned :: PrimTyCon -> Bool
primTyConIsSigned tc
= case tc of
PrimTyConInt -> True
PrimTyConFloat{} -> True
_ -> False
primTyConWidth :: Platform -> PrimTyCon -> Maybe Integer
primTyConWidth pp tc
= case tc of
PrimTyConBool -> Just $ 8 * platformNatBytes pp
PrimTyConNat -> Just $ 8 * platformNatBytes pp
PrimTyConInt -> Just $ 8 * platformNatBytes pp
PrimTyConWord bits -> Just $ fromIntegral bits
PrimTyConFloat bits -> Just $ fromIntegral bits
PrimTyConTag -> Just $ 8 * platformTagBytes pp
PrimTyConAddr -> Just $ 8 * platformAddrBytes pp
PrimTyConPtr -> Just $ 8 * platformAddrBytes pp
PrimTyConVoid -> Nothing
PrimTyConString -> Nothing