From: Christiaan Baaij Date: Fri, 7 Aug 2009 13:58:14 +0000 (+0200) Subject: Add support for translating designs defined over multiple modules X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=579289ed9e6b89fcf1da4f6ee4234332f2905195;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git Add support for translating designs defined over multiple modules Have to test the stability, it works for HighOrdAlu --- diff --git a/HighOrdAlu.hs b/HighOrdAlu.hs index e5dcbfd..bdbdc3c 100644 --- a/HighOrdAlu.hs +++ b/HighOrdAlu.hs @@ -6,28 +6,7 @@ import qualified Prelude as P import CLasH.HardwareTypes import CLasH.Translator.Annotations -constant :: NaturalT n => e -> Op n e -constant e a b = copy e - -invop :: Op n Bit -invop a b = map hwnot a - -andop :: (e -> e -> e) -> Op n e -andop f a b = zipWith f a b - --- Is any bit set? ---anyset :: (PositiveT n) => Op n Bit -anyset :: NaturalT n => (e -> e -> e) -> e -> Op n e ---anyset a b = copy undefined (a' `hwor` b') -anyset f s a b = constant (f a' b') a b - where - a' = foldl f s a - b' = foldl f s b - -xhwor = hwor - -type Op n e = (Vector n e -> Vector n e -> Vector n e) -type Opcode = Bit +import HighOrdAluOps {-# ANN sim_input TestInput#-} sim_input :: [(Opcode, Vector D4 (SizedInt D8), Vector D4 (SizedInt D8))] diff --git a/HighOrdAluOps.hs b/HighOrdAluOps.hs new file mode 100644 index 0000000..3d05ab9 --- /dev/null +++ b/HighOrdAluOps.hs @@ -0,0 +1,28 @@ +module HighOrdAluOps where + +import qualified Prelude as P +import CLasH.HardwareTypes +import CLasH.Translator.Annotations + +constant :: NaturalT n => e -> Op n e +constant e a b = copy e + +invop :: Op n Bit +invop a b = map hwnot a + +andop :: (e -> e -> e) -> Op n e +andop f a b = zipWith f a b + +-- Is any bit set? +--anyset :: (PositiveT n) => Op n Bit +anyset :: NaturalT n => (e -> e -> e) -> e -> Op n e +--anyset a b = copy undefined (a' `hwor` b') +anyset f s a b = constant (f a' b') a b + where + a' = foldl f s a + b' = foldl f s b + +xhwor = hwor + +type Op n e = (Vector n e -> Vector n e -> Vector n e) +type Opcode = Bit \ No newline at end of file diff --git "a/c\316\273ash/CLasH/Translator.hs" "b/c\316\273ash/CLasH/Translator.hs" index c120edc..f60d225 100644 --- "a/c\316\273ash/CLasH/Translator.hs" +++ "b/c\316\273ash/CLasH/Translator.hs" @@ -76,7 +76,7 @@ makeVHDL libdir filenames finder = do -- Translate to VHDL vhdl <- moduleToVHDL env cores specs -- Write VHDL to file. Just use the first entity for the name - let top_entity = (\(t, _, _) -> t) $ head specs + let top_entity = head $ Maybe.catMaybes $ map (\(t, _, _) -> t) specs let dir = "./vhdl/" ++ (show top_entity) ++ "/" prepareDir dir mapM (writeVHDL dir) vhdl @@ -94,15 +94,18 @@ moduleToVHDL env cores specs = do -- Store the bindings we loaded tsBindings %= Map.fromList all_bindings test_binds <- catMaybesM $ Monad.mapM mkTest specs - let topbinds = map (\(top, _, _) -> top) specs - createDesignFiles (topbinds ++ test_binds) + let topbinds = Maybe.catMaybes $ map (\(top, _, _) -> top) specs + case topbinds of + [] -> error $ "Could not find top entity requested" + tops -> createDesignFiles (tops ++ test_binds) mapM (putStr . render . Ppr.ppr . snd) vhdl return vhdl where mkTest :: EntitySpec -> TranslatorSession (Maybe CoreSyn.CoreBndr) -- Create a testbench for any entry that has test input mkTest (_, _, Nothing) = return Nothing - mkTest (top, _, Just input) = do + mkTest (Nothing, _, _) = return Nothing + mkTest (Just top, _, Just input) = do bndr <- createTestbench Nothing cores input top return $ Just bndr diff --git "a/c\316\273ash/CLasH/Translator/TranslatorTypes.hs" "b/c\316\273ash/CLasH/Translator/TranslatorTypes.hs" index 47deeef..280a217 100644 --- "a/c\316\273ash/CLasH/Translator/TranslatorTypes.hs" +++ "b/c\316\273ash/CLasH/Translator/TranslatorTypes.hs" @@ -27,7 +27,7 @@ import CLasH.VHDL.VHDLTypes -- | A specification of an entity we can generate VHDL for. Consists of the -- binder of the top level entity, an optional initial state and an optional -- test input. -type EntitySpec = (CoreSyn.CoreBndr, Maybe CoreSyn.CoreExpr, Maybe CoreSyn.CoreExpr) +type EntitySpec = (Maybe CoreSyn.CoreBndr, Maybe CoreSyn.CoreExpr, Maybe CoreSyn.CoreExpr) -- | A function that knows which parts of a module to compile type Finder = diff --git "a/c\316\273ash/CLasH/Utils/GhcTools.hs" "b/c\316\273ash/CLasH/Utils/GhcTools.hs" index 5b9bc35..9139c78 100644 --- "a/c\316\273ash/CLasH/Utils/GhcTools.hs" +++ "b/c\316\273ash/CLasH/Utils/GhcTools.hs" @@ -161,6 +161,7 @@ findSpec topc statec testc mod = do top <- findBind topc mod state <- findExpr statec mod test <- findExpr testc mod - case top of - Just t -> return [(t, state, test)] - Nothing -> error $ "Could not find top entity requested" + return [(top, state, test)] + -- case top of + -- Just t -> return [(t, state, test)] + -- Nothing -> return error $ "Could not find top entity requested"