X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=FlattenTypes.hs;h=e7d21d605c5fec8901e9ad104cb4f92f8f3c3849;hb=e73057cb92295256ab62810771da8e723f4a8223;hp=4e2640a8ee7d18520ea0f72333ce0b63bb248385;hpb=85ee6f8e10f7dcc73db62a55a07d924bc002f216;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/FlattenTypes.hs b/FlattenTypes.hs index 4e2640a..e7d21d6 100644 --- a/FlattenTypes.hs +++ b/FlattenTypes.hs @@ -1,6 +1,7 @@ module FlattenTypes where import Data.Traversable +import qualified Data.Foldable as Foldable import qualified Control.Monad.State as State import CoreSyn @@ -28,6 +29,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 @@ -60,6 +66,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, @@ -75,19 +86,27 @@ data CondDef sigid = CondDef { condRes :: sigid } deriving (Show, Eq) +-- | How is a given signal used in the resulting VHDL? +data SigUse = + SigPort -- | Use as a port + | SigInternal -- | Use as an internal signal + | SigState -- | Use as an internal state + | SigSubState -- | Do not use, state variable is used in a subcircuit + -- | Information on a signal definition 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 :: [(sigid, SignalInfo)] + flat_args :: [SignalMap sigid], + flat_res :: SignalMap sigid, + flat_apps :: [FApp sigid], + flat_conds :: [CondDef sigid], + flat_sigs :: [(sigid, SignalInfo)] } -- | A flat function that does not have its signals named @@ -121,10 +140,10 @@ addCondDef c = do State.put (apps, c:conds, sigs, n) -- | Generates a new signal id, which is unique within the current flattening. -genSignalId :: Type.Type -> FlattenState UnnamedSignal -genSignalId ty = 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 ty) + let s = (n, SignalInfo Nothing use ty) State.put (apps, conds, s:sigs, n+1) return n