From: Christiaan Baaij Date: Thu, 13 Aug 2009 15:19:48 +0000 (+0200) Subject: Generate more unique variable names, generate truely unique entity names X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=aa2503aeb4cfa5540633db2cdd50bea20b5f1c50;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git Generate more unique variable names, generate truely unique entity names --- diff --git "a/c\316\273ash/CLasH/Translator.hs" "b/c\316\273ash/CLasH/Translator.hs" index f60d225..6528f54 100644 --- "a/c\316\273ash/CLasH/Translator.hs" +++ "b/c\316\273ash/CLasH/Translator.hs" @@ -120,7 +120,7 @@ runTranslatorSession env session = do -- a unique supply anywhere. uniqSupply <- UniqSupply.mkSplitUniqSupply 'z' let init_typestate = TypeState Map.empty [] Map.empty Map.empty env - let init_state = TranslatorState uniqSupply init_typestate Map.empty Map.empty Map.empty Map.empty + let init_state = TranslatorState uniqSupply init_typestate Map.empty Map.empty 0 Map.empty Map.empty return $ State.evalState session init_state -- | Prepares the directory for writing VHDL files. This means creating the diff --git "a/c\316\273ash/CLasH/Translator/TranslatorTypes.hs" "b/c\316\273ash/CLasH/Translator/TranslatorTypes.hs" index 280a217..7483504 100644 --- "a/c\316\273ash/CLasH/Translator/TranslatorTypes.hs" +++ "b/c\316\273ash/CLasH/Translator/TranslatorTypes.hs" @@ -86,6 +86,7 @@ data TranslatorState = TranslatorState { , tsType_ :: TypeState , tsBindings_ :: Map.Map CoreSyn.CoreBndr CoreSyn.CoreExpr , tsNormalized_ :: Map.Map CoreSyn.CoreBndr CoreSyn.CoreExpr + , tsEntityCounter_ :: Integer , tsEntities_ :: Map.Map CoreSyn.CoreBndr Entity , tsArchitectures_ :: Map.Map CoreSyn.CoreBndr (Architecture, [CoreSyn.CoreBndr]) } diff --git "a/c\316\273ash/CLasH/Utils/GhcTools.hs" "b/c\316\273ash/CLasH/Utils/GhcTools.hs" index 9139c78..6e9a6dc 100644 --- "a/c\316\273ash/CLasH/Utils/GhcTools.hs" +++ "b/c\316\273ash/CLasH/Utils/GhcTools.hs" @@ -89,7 +89,7 @@ loadModules libdir filenames finder = GHC.runGhc (Just libdir) $ do dflags <- GHC.getSessionDynFlags GHC.setSessionDynFlags dflags - cores <- mapM GHC.compileToCoreSimplified filenames + cores <- mapM GHC.compileToCoreModule filenames env <- GHC.getSession specs <- case finder of Nothing -> return [] diff --git "a/c\316\273ash/CLasH/VHDL/Generate.hs" "b/c\316\273ash/CLasH/VHDL/Generate.hs" index 0e147b3..99d5d27 100644 --- "a/c\316\273ash/CLasH/VHDL/Generate.hs" +++ "b/c\316\273ash/CLasH/VHDL/Generate.hs" @@ -52,7 +52,9 @@ getEntity fname = Utils.makeCached fname tsEntities $ do let (CoreSyn.Let binds (CoreSyn.Var res)) = letexpr -- TODO: Handle Nothing res' <- mkMap res - let vhdl_id = mkVHDLBasicId $ varToString fname ++ "_" ++ varToStringUniq fname + count <- getA tsEntityCounter + let vhdl_id = mkVHDLBasicId $ varToString fname ++ "Component_" ++ show count + putA tsEntityCounter (count + 1) let ent_decl = createEntityAST vhdl_id args' res' let signature = Entity vhdl_id args' res' ent_decl return signature diff --git "a/c\316\273ash/CLasH/VHDL/VHDLTools.hs" "b/c\316\273ash/CLasH/VHDL/VHDLTools.hs" index 4c41d8f..2cd647b 100644 --- "a/c\316\273ash/CLasH/VHDL/VHDLTools.hs" +++ "b/c\316\273ash/CLasH/VHDL/VHDLTools.hs" @@ -183,7 +183,7 @@ dataconToVHDLExpr dc = AST.PrimLit lit varToVHDLId :: CoreSyn.CoreBndr -> AST.VHDLId -varToVHDLId = mkVHDLExtId . varToString +varToVHDLId var = mkVHDLExtId $ (varToString var ++ varToStringUniq var) -- Creates a VHDL Name from a binder varToVHDLName :: diff --git a/reducer.hs b/reducer.hs index 7c224f2..65730f4 100644 --- a/reducer.hs +++ b/reducer.hs @@ -50,6 +50,7 @@ type InputState = State ( Vector (AdderDepth :+: D1) ReducerSignal type FpAdderState = State (Vector AdderDepth ReducerSignal) type OutputState = State ( MemState DataInt + , MemState DataInt , RAM ArrayIndex , RAM Bit ) @@ -193,22 +194,22 @@ wrenable: write enable flag Output: data_out: value of 'mem' at location 'rdaddr' -} +{-# NOINLINE blockRAM #-} blockRAM :: (MemState a) -> ( a , Discr , Discr - , Discr , Bit ) -> - (MemState a, (a, a) ) -blockRAM (State mem) (data_in, rdaddr1, rdaddr2, wraddr, wrenable) = - ((State mem'), (data_out1,data_out2)) + ((MemState a), a ) +blockRAM (State mem) (data_in, rdaddr, wraddr, wrenable) = + ((State mem'), data_out) where - data_out1 = mem!rdaddr1 - data_out2 = mem!rdaddr2 + data_out = mem!rdaddr -- Only write data_in to memory if write is enabled - mem' | wrenable == Low = mem - | otherwise = replace mem wraddr data_in + mem' = case wrenable of + Low -> mem + High -> replace mem wraddr data_in {- Output logic - Determines when values are released from blockram to the output @@ -241,9 +242,9 @@ outputter :: OutputState -> , Bit ) -> (OutputState, (ReducerSignal, OutputSignal)) -outputter (State (mem, lut, valid)) +outputter (State (mem1, mem2, lut, valid)) (discr, index, new_discr, data_in, rdaddr, wraddr, wrenable) = - ((State (mem', lut', valid')), (data_out, output)) + ((State (mem1', mem2', lut', valid')), (data_out, output)) where -- Lut is updated when new discriminator/index combination enters system lut' | new_discr /= Low = replace lut discr index @@ -255,20 +256,24 @@ outputter (State (mem, lut, valid)) -- Location becomes invalid when it is fed back into the pipeline valid' | wrenable == Low = replace valid'' rdaddr Low | otherwise = replace valid'' wraddr High - (mem', mem_out) = blockRAM mem ( data_in + (mem1', mem_out1) = blockRAM mem1 ( data_in , rdaddr - , discr , wraddr , wrenable ) - data_out = ( ( (fst mem_out) + (mem2', mem_out2) = blockRAM mem2 ( data_in + , discr + , wraddr + , wrenable + ) + data_out = ( ( (mem_out1) , rdaddr ) , (valid!rdaddr) ) -- Reduced row is released when new discriminator enters system -- And the position at the discriminator holds a valid value - output = ( ( (snd mem_out) + output = ( ( (mem_out2) , (lut!discr) ) , (new_discr `hwand` (valid!discr)) @@ -478,6 +483,7 @@ initstate = State ) , State (copy ((0::DataInt,0::Discr),Low)) , State ( State (copy (0::DataInt)) + , State (copy (0::DataInt)) , (copy (0::ArrayIndex)) , (copy Low) )