module DDC.Core.Flow.Prim
(
Name (..)
, readName
, KiConFlow (..)
, readKiConFlow
, TyConFlow (..)
, readTyConFlow
, kindTyConFlow
, DaConFlow (..)
, readDaConFlow
, typeDaConFlow
, OpFlow (..)
, readOpFlow
, typeOpFlow
, OpLoop (..)
, readOpLoop
, typeOpLoop
, OpStore (..)
, readOpStore
, typeOpStore
, PrimTyCon (..)
, kindPrimTyCon
, PrimArith (..)
, typePrimArith
, PrimCast (..)
, typePrimCast)
where
import DDC.Core.Flow.Prim.Base
import DDC.Core.Flow.Prim.KiConFlow
import DDC.Core.Flow.Prim.TyConFlow
import DDC.Core.Flow.Prim.TyConPrim
import DDC.Core.Flow.Prim.DaConFlow
import DDC.Core.Flow.Prim.DaConPrim ()
import DDC.Core.Flow.Prim.OpFlow
import DDC.Core.Flow.Prim.OpLoop
import DDC.Core.Flow.Prim.OpStore
import DDC.Core.Flow.Prim.OpPrim
import DDC.Core.Salt.Name
( readPrimTyCon
, readPrimCast
, readPrimArith
, readLitPrimNat
, readLitPrimInt
, readLitPrimWordOfBits)
import DDC.Base.Pretty
import Control.DeepSeq
import Data.Char
instance NFData Name where
rnf nn
= case nn of
NameVar s -> rnf s
NameVarMod n s -> rnf n `seq` rnf s
NameCon s -> rnf s
NameKiConFlow con -> rnf con
NameTyConFlow con -> rnf con
NameDaConFlow con -> rnf con
NameOpFlow op -> rnf op
NameOpLoop op -> rnf op
NameOpStore op -> rnf op
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 s -> text s
NameVarMod n s -> ppr n <> text "$" <> text s
NameCon c -> text c
NameKiConFlow con -> ppr con
NameTyConFlow con -> ppr con
NameDaConFlow con -> ppr con
NameOpFlow op -> ppr op
NameOpLoop op -> ppr op
NameOpStore op -> ppr op
NamePrimTyCon tc -> ppr tc
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 p <- readKiConFlow str = Just $ NameKiConFlow p
| Just p <- readTyConFlow str = Just $ NameTyConFlow p
| Just p <- readDaConFlow str = Just $ NameDaConFlow p
| Just p <- readOpFlow str = Just $ NameOpFlow p
| Just p <- readOpLoop str = Just $ NameOpLoop p
| Just p <- readOpStore str = Just $ NameOpStore p
| Just p <- readPrimTyCon str = Just $ NamePrimTyCon p
| Just p <- readPrimArith str = Just $ NamePrimArith p
| Just p <- readPrimCast str = Just $ NamePrimCast p
| 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
, isLower c
, Just (str1, strMod) <- splitModString str
, Just n <- readName str1
= Just $ NameVarMod n strMod
| c : _ <- str
, isLower c
= Just $ NameVar str
| c : _ <- str
, isUpper c
= Just $ NameCon str
| otherwise
= Nothing
splitModString :: String -> Maybe (String, String)
splitModString str
= case break (== '$') (reverse str) of
(_, "") -> Nothing
("", _) -> Nothing
(s2, _ : s1) -> Just (reverse s1, reverse s2)