module DDC.Core.Lite.Name
( Name (..)
, EffectTyCon (..)
, DataTyCon (..)
, PrimDaCon (..)
, PrimTyCon (..)
, PrimArith (..)
, PrimCast (..)
, readName)
where
import DDC.Core.Salt.Name.PrimTyCon
import DDC.Core.Salt.Name.PrimOp
import DDC.Core.Salt.Name.Lit
import DDC.Base.Pretty
import Control.DeepSeq
import Data.Typeable
import Data.Char
data Name
= NameVar String
| NameCon String
| NameEffectTyCon EffectTyCon
| NameDataTyCon DataTyCon
| NamePrimDaCon PrimDaCon
| NamePrimTyCon PrimTyCon
| NamePrimArith PrimArith
| NamePrimCast PrimCast
| NameLitBool Bool
| NameLitNat Integer
| NameLitInt Integer
| NameLitWord Integer Int
deriving (Eq, Ord, Show, Typeable)
instance NFData Name where
rnf nn
= case nn of
NameVar s -> rnf s
NameCon s -> rnf s
NameEffectTyCon con -> rnf con
NameDataTyCon con -> rnf con
NamePrimDaCon con -> rnf con
NamePrimTyCon con -> rnf con
NamePrimArith con -> rnf con
NamePrimCast c -> rnf c
NameLitBool b -> rnf b
NameLitNat n -> rnf n
NameLitInt i -> rnf i
NameLitWord i bits -> rnf i `seq` rnf bits
instance Pretty Name where
ppr nn
= case nn of
NameVar v -> text v
NameCon c -> text c
NameEffectTyCon con -> ppr con
NameDataTyCon dc -> ppr dc
NamePrimTyCon tc -> ppr tc
NamePrimDaCon dc -> ppr dc
NamePrimArith op -> ppr op
NamePrimCast op -> ppr op
NameLitBool True -> text "True#"
NameLitBool False -> text "False#"
NameLitNat i -> integer i <> text "#"
NameLitInt i -> integer i <> text "i" <> text "#"
NameLitWord i bits -> integer i <> text "w" <> int bits <> text "#"
readName :: String -> Maybe Name
readName str
| Just name <- readEffectTyCon str
= Just $ NameEffectTyCon name
| Just name <- readDataTyCon str
= Just $ NameDataTyCon name
| Just name <- readPrimTyCon str
= Just $ NamePrimTyCon name
| Just name <- readPrimDaCon str
= Just $ NamePrimDaCon name
| Just p <- readPrimArith str
= Just $ NamePrimArith p
| Just p <- readPrimCast str
= Just $ NamePrimCast p
| str == "()"
= Just $ NamePrimDaCon PrimDaConUnit
| str == "True#" = Just $ NameLitBool True
| str == "False#" = Just $ NameLitBool False
| Just val <- readLitPrimNat str
= Just $ NameLitNat val
| Just val <- readLitPrimInt str
= Just $ NameLitInt val
| Just (val, bits) <- readLitPrimWordOfBits str
, elem bits [8, 16, 32, 64]
= Just $ NameLitWord val bits
| c : _ <- str
, isUpper c
= Just $ NameCon str
| c : _ <- str
, isLower c
= Just $ NameVar str
| otherwise
= Nothing
data EffectTyCon
= EffectTyConConsole
deriving (Eq, Ord, Show)
instance NFData EffectTyCon
instance Pretty EffectTyCon where
ppr tc
= case tc of
EffectTyConConsole -> text "Console"
readEffectTyCon :: String -> Maybe EffectTyCon
readEffectTyCon str
= case str of
"Console" -> Just EffectTyConConsole
_ -> Nothing
data DataTyCon
= DataTyConUnit
| DataTyConBool
| DataTyConNat
| DataTyConInt
| DataTyConPair
| DataTyConList
deriving (Eq, Ord, Show)
instance NFData DataTyCon
instance Pretty DataTyCon where
ppr dc
= case dc of
DataTyConUnit -> text "Unit"
DataTyConBool -> text "Bool"
DataTyConNat -> text "Nat"
DataTyConInt -> text "Int"
DataTyConPair -> text "Pair"
DataTyConList -> text "List"
readDataTyCon :: String -> Maybe DataTyCon
readDataTyCon str
= case str of
"Unit" -> Just DataTyConUnit
"Bool" -> Just DataTyConBool
"Nat" -> Just DataTyConNat
"Int" -> Just DataTyConInt
"Pair" -> Just DataTyConPair
"List" -> Just DataTyConList
_ -> Nothing
data PrimDaCon
= PrimDaConUnit
| PrimDaConBoolU
| PrimDaConNatU
| PrimDaConIntU
| PrimDaConPr
| PrimDaConNil
| PrimDaConCons
deriving (Show, Eq, Ord)
instance NFData PrimDaCon
instance Pretty PrimDaCon where
ppr dc
= case dc of
PrimDaConBoolU -> text "B#"
PrimDaConNatU -> text "N#"
PrimDaConIntU -> text "I#"
PrimDaConUnit -> text "()"
PrimDaConPr -> text "Pr"
PrimDaConNil -> text "Nil"
PrimDaConCons -> text "Cons"
readPrimDaCon :: String -> Maybe PrimDaCon
readPrimDaCon str
= case str of
"B#" -> Just PrimDaConBoolU
"N#" -> Just PrimDaConNatU
"I#" -> Just PrimDaConIntU
"()" -> Just PrimDaConUnit
"Pr" -> Just PrimDaConPr
"Nil" -> Just PrimDaConNil
"Cons" -> Just PrimDaConCons
_ -> Nothing