X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=FlattenTypes.hs;h=9f080f70666eec1755c8df1897b4c5ff507222f8;hb=e479bd172f803b7f75b0dc6b08d3d1792638a711;hp=024db9b5332c6f4d94a22b356ed697d966ab70b8;hpb=668cd4041980db707d6afb0cfb5aed4036b0b46b;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/FlattenTypes.hs b/FlattenTypes.hs index 024db9b..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 Signal sigid = Signal { - id :: sigid -} deriving (Eq, Show) +data SignalInfo = SignalInfo { + 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 :: [Signal sigid] -} 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 @@ -104,7 +150,7 @@ type BindMap = [( )] -- | The state during the flattening of a single function -type FlattenState = State.State ([FApp UnnamedSignal], [CondDef UnnamedSignal], [Signal UnnamedSignal], UnnamedSignal) +type FlattenState = State.State ([FApp UnnamedSignal], [CondDef UnnamedSignal], [(UnnamedSignal, SignalInfo)], UnnamedSignal) -- | Add an application to the current FlattenState addApp :: (FApp UnnamedSignal) -> FlattenState () @@ -119,9 +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 - let s = Signal n + -- Generate a new numbered but unnamed signal + let s = (n, SignalInfo Nothing use ty) State.put (apps, conds, s:sigs, n+1) return n