From: Matthijs Kooijman Date: Fri, 13 Feb 2009 09:43:09 +0000 (+0100) Subject: Name signals in a function after flattening it. X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=790cb87bc728be4140ea7cf0d5444cc4cf96d0dc;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git Name signals in a function after flattening it. --- diff --git a/FlattenTypes.hs b/FlattenTypes.hs index 024db9b..b14ef38 100644 --- a/FlattenTypes.hs +++ b/FlattenTypes.hs @@ -76,7 +76,8 @@ data CondDef sigid = CondDef { -- | Information on a signal definition data Signal sigid = Signal { - id :: sigid + id :: sigid, + name :: Maybe String } deriving (Eq, Show) -- | A flattened function @@ -122,6 +123,7 @@ addCondDef c = do genSignalId :: FlattenState UnnamedSignal genSignalId = do (apps, conds, sigs, n) <- State.get - let s = Signal n + -- Generate a new numbered but unnamed signal + let s = Signal n Nothing State.put (apps, conds, s:sigs, n+1) return n diff --git a/Pretty.hs b/Pretty.hs index 21a3795..ee4b3be 100644 --- a/Pretty.hs +++ b/Pretty.hs @@ -43,7 +43,8 @@ instance Pretty id => Pretty (CondDef id) where pPrint _ = text "TODO" instance Pretty id => Pretty (Signal id) where - pPrint (Signal id) = pPrint id + pPrint (Signal id Nothing) = pPrint id + pPrint (Signal id (Just name)) = pPrint id <> text ":" <> text name instance Pretty VHDLSession where pPrint (VHDLSession mod nameCount funcs) = diff --git a/Translator.hs b/Translator.hs index d0738d3..bb5845b 100644 --- a/Translator.hs +++ b/Translator.hs @@ -68,6 +68,7 @@ main = mapM addBuiltIn builtin_funcs -- Create entities and architectures for them mapM processBind binds + modFuncs nameFlatFunction return $ AST.DesignFile [] [] @@ -166,6 +167,24 @@ mkHsFunction f ty = error $ "Input state type of function " ++ hsname ++ ": " ++ (showSDoc $ ppr state_ty) ++ " does not match output state type: " ++ (showSDoc $ ppr outstate_ty) otherwise -> error $ "Return type of top-level function " ++ hsname ++ " must be a two-tuple containing a state and output ports." +-- | Adds signal names to the given FlatFunction +nameFlatFunction :: + HsFunction + -> FuncData + -> FuncData + +nameFlatFunction hsfunc fdata = + let func = flatFunc fdata in + case func of + -- Skip (builtin) functions without a FlatFunction + Nothing -> fdata + -- Name the signals in all other functions + Just flatfunc -> + let s = sigs flatfunc in + let s' = map (\(Signal id Nothing) -> Signal id (Just $ "sig_" ++ (show id))) s in + let flatfunc' = flatfunc { sigs = s' } in + fdata { flatFunc = Just flatfunc' } + -- | Splits a tuple type into a list of element types, or Nothing if the type -- is not a tuple type. splitTupleType :: diff --git a/TranslatorTypes.hs b/TranslatorTypes.hs index 72cd398..271a5d3 100644 --- a/TranslatorTypes.hs +++ b/TranslatorTypes.hs @@ -46,10 +46,11 @@ setFlatFunc hsfunc flatfunc = do let fs'= Map.adjust (\d -> d { flatFunc = Just flatfunc }) hsfunc fs State.modify (\x -> x {funcs = fs' }) -modFunc :: HsFunction -> (HsFunction -> FuncData -> FuncData) -> VHDLState () -modFunc hsfunc f = do +-- | Modify all functions in the map using the given function +modFuncs :: (HsFunction -> FuncData -> FuncData) -> VHDLState () +modFuncs f = do fs <- State.gets funcs -- Get the funcs element from the session - let fs' = Map.adjustWithKey f hsfunc fs + let fs' = Map.mapWithKey f fs State.modify (\x -> x {funcs = fs' }) getModule :: VHDLState HscTypes.CoreModule