X-Git-Url: https://git.stderr.nl/gitweb?p=matthijs%2Fmaster-project%2Fc%CE%BBash.git;a=blobdiff_plain;f=FlattenTypes.hs;h=bd6c1d5996cf2a75c6f6b9595444a795684c6e31;hp=092baff4911fdcb6789399ec613c09293fe30f02;hb=HEAD;hpb=14367b6b9fd0770a78e02fad425daa369df4bec6 diff --git a/FlattenTypes.hs b/FlattenTypes.hs index 092baff..bd6c1d5 100644 --- a/FlattenTypes.hs +++ b/FlattenTypes.hs @@ -3,12 +3,13 @@ module FlattenTypes where import qualified Maybe import Data.Traversable import qualified Data.Foldable as Foldable -import qualified Control.Monad.State as State +import qualified Control.Monad.Trans.State as State import CoreSyn import qualified Type import HsValueMap +import CoreShow -- | A signal identifier type SignalId = Int @@ -96,13 +97,36 @@ data SigDef = defDst :: SignalId } deriving (Show, Eq) +-- | Is the given SigDef a FApp? +is_FApp :: SigDef -> Bool +is_FApp d = case d of + (FApp _ _ _) -> True + _ -> False + +-- | Which signals are used by the given SigDef? +sigDefUses :: SigDef -> [SignalId] +sigDefUses (UncondDef (Left id) _) = [id] +sigDefUses (UncondDef (Right expr) _) = sigExprUses expr +sigDefUses (CondDef cond true false _) = [cond, true, false] +sigDefUses (FApp _ args _) = concat $ map Foldable.toList args + -- | An expression on signals data SignalExpr = EqLit SignalId String -- ^ Is the given signal equal to the given (VHDL) literal - | Literal String -- ^ A literal value + | Literal String (Maybe Type.Type)-- ^ A literal value, with an optional type to cast to | Eq SignalId SignalId -- ^ A comparison between to signals deriving (Show, Eq) +-- Instantiate Eq for Type, so we can derive Eq for SignalExpr. +instance Eq Type.Type where + (==) = Type.coreEqType + +-- | Which signals are used by the given SignalExpr? +sigExprUses :: SignalExpr -> [SignalId] +sigExprUses (EqLit id _) = [id] +sigExprUses (Literal _ _) = [] +sigExprUses (Eq a b) = [a, b] + -- Returns the function used by the given SigDef, if any usedHsFunc :: SigDef -> Maybe HsFunction usedHsFunc (FApp hsfunc _ _) = Just hsfunc @@ -116,6 +140,7 @@ data SigUse = | SigStateOld StateId -- | Use as the current internal state | SigStateNew StateId -- | Use as the new internal state | SigSubState -- | Do not use, state variable is used in a subcircuit + deriving (Show) -- | Is this a port signal use? isPortSigUse :: SigUse -> Bool @@ -134,12 +159,21 @@ isInternalSigUse :: SigUse -> Bool isInternalSigUse SigInternal = True isInternalSigUse _ = False +oldStateId :: SigUse -> Maybe StateId +oldStateId (SigStateOld id) = Just id +oldStateId _ = Nothing + +newStateId :: SigUse -> Maybe StateId +newStateId (SigStateNew id) = Just id +newStateId _ = Nothing + -- | Information on a signal definition data SignalInfo = SignalInfo { sigName :: Maybe String, sigUse :: SigUse, - sigTy :: Type.Type -} + sigTy :: Type.Type, + nameHints :: [String] +} deriving (Show) -- | A flattened function data FlatFunction = FlatFunction { @@ -147,7 +181,7 @@ data FlatFunction = FlatFunction { flat_res :: SignalMap, flat_defs :: [SigDef], flat_sigs :: [(SignalId, SignalInfo)] -} +} deriving (Show) -- | Lookup a given signal id in a signal map, and return the associated -- SignalInfo. Errors out if the signal was not found. @@ -183,10 +217,22 @@ genSignalId :: SigUse -> Type.Type -> FlattenState SignalId genSignalId use ty = do (defs, sigs, n) <- State.get -- Generate a new numbered but unnamed signal - let s = (n, SignalInfo Nothing use ty) + let s = (n, SignalInfo Nothing use ty []) State.put (defs, s:sigs, n+1) return n +-- | Add a name hint to the given signal +addNameHint :: String -> SignalId -> FlattenState () +addNameHint hint id = do + info <- getSignalInfo id + let hints = nameHints info + if hint `elem` hints + then do + return () + else do + let hints' = (hint:hints) + setSignalInfo id (info {nameHints = hints'}) + -- | Returns the SignalInfo for the given signal. Errors if the signal is not -- known in the session. getSignalInfo :: SignalId -> FlattenState SignalInfo @@ -199,3 +245,5 @@ setSignalInfo id' info' = do (defs, sigs, n) <- State.get let sigs' = map (\(id, info) -> (id, if id == id' then info' else info)) sigs State.put (defs, sigs', n) + +-- vim: set ts=8 sw=2 sts=2 expandtab: