X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=FlattenTypes.hs;h=9f080f70666eec1755c8df1897b4c5ff507222f8;hb=c9878e08917311385ce7edbb93f548788cf9df14;hp=7838dcdcbc28563fa7f77d54063e21183b9a3cd6;hpb=9913c8098b3f42e404ee1b76c2ccd47f15769c64;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/FlattenTypes.hs b/FlattenTypes.hs index 7838dcd..9f080f7 100644 --- a/FlattenTypes.hs +++ b/FlattenTypes.hs @@ -1,9 +1,12 @@ module FlattenTypes where +import qualified Maybe import Data.Traversable +import qualified Data.Foldable as Foldable import qualified Control.Monad.State as State import CoreSyn +import qualified Type import HsValueMap @@ -27,6 +30,11 @@ data HsValueUse = } deriving (Show, Eq, Ord) +-- | Is this HsValueUse a state use? +isStateUse :: HsValueUse -> Bool +isStateUse (State _) = True +isStateUse _ = False + -- | A map from a Haskell value to the use of each single value type HsUseMap = HsValueMap HsValueUse @@ -59,6 +67,11 @@ data HsFunction = HsFunction { hsFuncRes :: HsUseMap } deriving (Show, Eq, Ord) +hasState :: HsFunction -> Bool +hasState hsfunc = + any (Foldable.any isStateUse) (hsFuncArgs hsfunc) + || Foldable.any isStateUse (hsFuncRes hsfunc) + -- | A flattened function application data FApp sigid = FApp { appFunc :: HsFunction, @@ -74,19 +87,52 @@ data CondDef sigid = CondDef { condRes :: sigid } deriving (Show, Eq) +-- | How is a given signal used in the resulting VHDL? +data SigUse = + SigPortIn -- | Use as an input port + | SigPortOut -- | Use as an input port + | SigInternal -- | Use as an internal signal + | SigStateOld Int -- | Use as the current internal state + | SigStateNew Int -- | Use as the new internal state + | SigSubState -- | Do not use, state variable is used in a subcircuit + +-- | Is this a port signal use? +isPortSigUse :: SigUse -> Bool +isPortSigUse SigPortIn = True +isPortSigUse SigPortOut = True +isPortSigUse _ = False + +-- | Is this a state signal use? Returns false for substate. +isStateSigUse :: SigUse -> Bool +isStateSigUse (SigStateOld _) = True +isStateSigUse (SigStateNew _) = True +isStateSigUse _ = False + +-- | Is this an internal signal use? +isInternalSigUse :: SigUse -> Bool +isInternalSigUse SigInternal = True +isInternalSigUse _ = False + -- | Information on a signal definition data SignalInfo = SignalInfo { - name :: Maybe String -} deriving (Eq, Show) + sigName :: Maybe String, + sigUse :: SigUse, + sigTy :: Type.Type +} -- | A flattened function data FlatFunction' sigid = FlatFunction { - args :: [SignalMap sigid], - res :: SignalMap sigid, - apps :: [FApp sigid], - conds :: [CondDef sigid], - sigs :: [(sigid, SignalInfo)] -} deriving (Show, Eq) + flat_args :: [SignalMap sigid], + flat_res :: SignalMap sigid, + flat_apps :: [FApp sigid], + flat_conds :: [CondDef sigid], + flat_sigs :: [(sigid, SignalInfo)] +} + +-- | Lookup a given signal id in a signal map, and return the associated +-- SignalInfo. Errors out if the signal was not found. +signalInfo :: Eq sigid => [(sigid, SignalInfo)] -> sigid -> SignalInfo +signalInfo sigs id = Maybe.fromJust $ lookup id sigs -- | A flat function that does not have its signals named type FlatFunction = FlatFunction' UnnamedSignal @@ -119,10 +165,10 @@ addCondDef c = do State.put (apps, c:conds, sigs, n) -- | Generates a new signal id, which is unique within the current flattening. -genSignalId :: FlattenState UnnamedSignal -genSignalId = do +genSignalId :: SigUse -> Type.Type -> FlattenState UnnamedSignal +genSignalId use ty = do (apps, conds, sigs, n) <- State.get -- Generate a new numbered but unnamed signal - let s = (n, SignalInfo Nothing) + let s = (n, SignalInfo Nothing use ty) State.put (apps, conds, s:sigs, n+1) return n