From: Matthijs Kooijman Date: Fri, 13 Feb 2009 08:55:29 +0000 (+0100) Subject: Remove NamedFlatFunction again. X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=535eeae192a34920407f47626fea2534bb5c263b;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git Remove NamedFlatFunction again. We'll use another way to represent names in FlatFunctions. --- diff --git a/Pretty.hs b/Pretty.hs index 3c6e9fc..21a3795 100644 --- a/Pretty.hs +++ b/Pretty.hs @@ -45,9 +45,6 @@ instance Pretty id => Pretty (CondDef id) where instance Pretty id => Pretty (Signal id) where pPrint (Signal id) = pPrint id -instance Pretty NamedSignal where - pPrint (NamedSignal name) = pPrint name - instance Pretty VHDLSession where pPrint (VHDLSession mod nameCount funcs) = text "Module: " $$ nest 15 (text modname) @@ -56,9 +53,8 @@ instance Pretty VHDLSession where where ppfunc (hsfunc, (FuncData flatfunc)) = pPrint hsfunc $+$ (text "Flattened: " $$ nest 15 (ppffunc flatfunc)) - ppffunc (Just (Left f)) = pPrint f - ppffunc (Just (Right f)) = pPrint f - ppffunc Nothing = text "Nothing" + ppffunc (Just f) = pPrint f + ppffunc Nothing = text "Nothing" modname = showSDoc $ Module.pprModule (HscTypes.cm_module mod) instance (OutputableBndr b) => Pretty (CoreSyn.Bind b) where diff --git a/Translator.hs b/Translator.hs index 3b08860..d0738d3 100644 --- a/Translator.hs +++ b/Translator.hs @@ -108,7 +108,7 @@ flattenBind hsfunc bind@(NonRec var expr) = do -- Flatten the function let flatfunc = flattenFunction hsfunc bind addFunc hsfunc - setFlatFunc hsfunc (Left flatfunc) + setFlatFunc hsfunc flatfunc let used_hsfuncs = map appFunc (apps flatfunc) State.mapM resolvFunc used_hsfuncs return () diff --git a/TranslatorTypes.hs b/TranslatorTypes.hs index cad096b..4ced7de 100644 --- a/TranslatorTypes.hs +++ b/TranslatorTypes.hs @@ -15,15 +15,9 @@ import HsValueMap -- function along the way. type FuncMap = Map.Map HsFunction FuncData --- | A signal that has been assigned a (unique) name -data NamedSignal = NamedSignal String - --- | A function in which all signals have been assigned unique names -type NamedFlatFunction = FlatFunction' NamedSignal - -- | Some stuff we collect about a function along the way. data FuncData = FuncData { - flatFunc :: Maybe (Either FlatFunction NamedFlatFunction) + flatFunc :: Maybe FlatFunction } data VHDLSession = VHDLSession { @@ -46,7 +40,7 @@ getFunc hsfunc = do return $ Map.lookup hsfunc fs -- | Sets the FlatFunction for the given HsFunction in the given setting. -setFlatFunc :: HsFunction -> (Either FlatFunction NamedFlatFunction) -> VHDLState () +setFlatFunc :: HsFunction -> FlatFunction -> VHDLState () setFlatFunc hsfunc flatfunc = do fs <- State.gets funcs -- Get the funcs element from the session let fs'= Map.adjust (\d -> d { flatFunc = Just flatfunc }) hsfunc fs diff --git a/VHDL.hs b/VHDL.hs index f1c7500..c5e7cbc 100644 --- a/VHDL.hs +++ b/VHDL.hs @@ -36,4 +36,3 @@ vhdl_ty_maybe ty = -- Shortcut mkVHDLId :: String -> AST.VHDLId mkVHDLId = AST.unsafeVHDLBasicId -