module DDC.Core.Flow.Prim
(
Name (..)
, readName
, KiConFlow (..)
, readKiConFlow
, TyConFlow (..)
, readTyConFlow
, kindTyConFlow
, DaConFlow (..)
, readDaConFlow
, typeDaConFlow
, OpConcrete (..)
, readOpConcrete
, typeOpConcrete
, OpSeries (..)
, readOpSeries
, typeOpSeries
, OpControl (..)
, readOpControl
, typeOpControl
, OpStore (..)
, readOpStore
, typeOpStore
, OpVector (..)
, readOpVector
, typeOpVector
, PrimTyCon (..)
, kindPrimTyCon
, PrimArith (..)
, typePrimArith
, PrimVec (..)
, typePrimVec
, multiOfPrimVec
, liftPrimArithToVec
, lowerPrimVecToArith
, 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.OpConcrete
import DDC.Core.Flow.Prim.OpControl
import DDC.Core.Flow.Prim.OpSeries
import DDC.Core.Flow.Prim.OpStore
import DDC.Core.Flow.Prim.OpVector
import DDC.Core.Flow.Prim.OpPrim
import DDC.Core.Salt.Name
( readPrimTyCon
, readPrimArith
, readPrimVec
, multiOfPrimVec
, liftPrimArithToVec
, lowerPrimVecToArith
, readPrimCast
, readLitPrimNat
, readLitPrimInt
, readLitPrimWordOfBits
, readLitPrimFloatOfBits)
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
NameOpConcrete op -> rnf op
NameOpControl op -> rnf op
NameOpSeries op -> rnf op
NameOpStore op -> rnf op
NameOpVector op -> rnf op
NamePrimTyCon op -> rnf op
NamePrimArith op -> rnf op
NamePrimVec op -> rnf op
NamePrimCast op -> rnf op
NameLitBool b -> rnf b
NameLitNat n -> rnf n
NameLitInt i -> rnf i
NameLitWord i bits -> rnf i `seq` rnf bits
NameLitFloat r bits -> rnf r `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
NameOpConcrete op -> ppr op
NameOpControl op -> ppr op
NameOpSeries op -> ppr op
NameOpStore op -> ppr op
NameOpVector op -> ppr op
NamePrimTyCon tc -> ppr tc
NamePrimArith op -> ppr op
NamePrimVec 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 "#"
NameLitFloat r bits -> double (fromRational r) <> text "f" <> 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 <- readOpConcrete str = Just $ NameOpConcrete p
| Just p <- readOpControl str = Just $ NameOpControl p
| Just p <- readOpSeries str = Just $ NameOpSeries p
| Just p <- readOpStore str = Just $ NameOpStore p
| Just p <- readOpVector str = Just $ NameOpVector p
| Just p <- readPrimTyCon str = Just $ NamePrimTyCon p
| Just p <- readPrimArith str = Just $ NamePrimArith p
| Just p <- readPrimVec str = Just $ NamePrimVec 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
| Just (val, bits) <- readLitPrimFloatOfBits str
, elem bits [32, 64]
= Just $ NameLitFloat (toRational 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)