module DDC.Core.DataDef
( DataDef (..)
, DataDefs (..)
, DataMode (..)
, DataType (..)
, DataCtor (..)
, emptyDataDefs
, insertDataDef
, fromListDataDefs
, lookupModeOfDataType)
where
import DDC.Type.Exp
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe
import Control.Monad
data DataDef n
= DataDef
{
dataDefTypeName :: n
, dataDefParamKinds :: [Kind n]
, dataDefCtors :: Maybe [(n, [Type n])] }
data DataDefs n
= DataDefs
{ dataDefsTypes :: Map n (DataType n)
, dataDefsCtors :: Map n (DataCtor n) }
data DataMode n
= DataModeSmall [n]
| DataModeLarge
data DataType n
= DataType
{
dataTypeName :: n
, dataTypeParamKinds :: [Kind n]
, dataTypeMode :: DataMode n }
data DataCtor n
= DataCtor
{
dataCtorName :: n
, dataCtorFieldTypes :: [Type n]
, dataCtorTypeName :: n }
emptyDataDefs :: DataDefs n
emptyDataDefs
= DataDefs
{ dataDefsTypes = Map.empty
, dataDefsCtors = Map.empty }
insertDataDef :: Ord n => DataDef n -> DataDefs n -> DataDefs n
insertDataDef (DataDef nType ks mCtors) dataDefs
= let defType = DataType
{ dataTypeName = nType
, dataTypeParamKinds = ks
, dataTypeMode = defMode }
defMode = case mCtors of
Nothing -> DataModeLarge
Just ctors -> DataModeSmall (map fst ctors)
makeDefCtor (nCtor, tsFields)
= DataCtor
{ dataCtorName = nCtor
, dataCtorFieldTypes = tsFields
, dataCtorTypeName = nType }
defCtors = case mCtors of
Nothing -> Nothing
Just cs -> Just $ map makeDefCtor cs
in dataDefs
{ dataDefsTypes = Map.insert nType defType (dataDefsTypes dataDefs)
, dataDefsCtors = Map.union (dataDefsCtors dataDefs)
$ Map.fromList [(n, def) | def@(DataCtor n _ _)
<- concat $ maybeToList defCtors] }
fromListDataDefs :: Ord n => [DataDef n] -> DataDefs n
fromListDataDefs defs
= foldr insertDataDef emptyDataDefs defs
lookupModeOfDataType :: Ord n => n -> DataDefs n -> Maybe (DataMode n)
lookupModeOfDataType n defs
= liftM dataTypeMode $ Map.lookup n (dataDefsTypes defs)