From 59575e6d40a276b984fdb4660610194959186bb3 Mon Sep 17 00:00:00 2001 From: Just van Westerveld Date: Thu, 22 Aug 2024 10:24:17 +0200 Subject: [PATCH] Attempt to fix plots --- bittide-experiments/src/Bittide/Hitl.hs | 27 +++++++- bittide-tools/clockcontrol/plot/Main.hs | 87 +++++++++++++------------ 2 files changed, 69 insertions(+), 45 deletions(-) diff --git a/bittide-experiments/src/Bittide/Hitl.hs b/bittide-experiments/src/Bittide/Hitl.hs index 7b7155a31..77eb26a2d 100644 --- a/bittide-experiments/src/Bittide/Hitl.hs +++ b/bittide-experiments/src/Bittide/Hitl.hs @@ -1,8 +1,11 @@ -- SPDX-FileCopyrightText: 2024 Google LLC -- -- SPDX-License-Identifier: Apache-2.0 +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} {- | Tooling to define hardware-in-the-loop (HITL) tests. HITL tests in the Bittide project involve FPGA designs that incorporate a @@ -43,6 +46,7 @@ module Bittide.Hitl ( -- * Test definition HitlTest (..), HitlTestIter (..), + MayHavePostProcData (..), Done, Success, hitlVio, @@ -65,6 +69,7 @@ import Clash.Cores.Xilinx.VIO (vioProbe) import Data.Containers.ListUtils (nubOrd) import Data.Map.Strict (Map) import Data.Maybe (isJust) +import Data.Typeable (Typeable) import Language.Haskell.TH.Syntax (Name) import Numeric.Natural (Natural) @@ -163,6 +168,7 @@ This must be accompanied by a @hitlVio \@NumberOfStages@ in the design. -} data HitlTest where HitlTest :: + (Typeable a, Typeable b) => { topEntity :: ClashTargetName , extraXdcFiles :: [String] , testIters :: [HitlTestIter HwTargetRef a b] @@ -176,7 +182,7 @@ associated with it. -} data HitlTestIter h a b where HitlTestIter :: - (Show h, Show a, BitPack a, Show b) => + (Show h, Show a, BitPack a, Show b, Typeable h) => { iterName :: String , hwTParamMap :: Map h a , postProcData :: b @@ -185,6 +191,23 @@ data HitlTestIter h a b where deriving instance Show (HitlTestIter h a b) +-- | A class for extracting optional post processing data from a test. +class MayHavePostProcData b where + -- | Returns the test names with some post processing data of type @c@, + -- if that data exists. + mGetPPD :: + forall h a. + [HitlTestIter h a b] -> + Map String (Maybe b) + +instance MayHavePostProcData a where + mGetPPD iters = + Map.fromList + [(iterName, Just postProcData) | HitlTestIter{..} <- iters] + +instance MayHavePostProcData () where + mGetPPD = Map.fromList . map ((,Nothing) . iterName) + -- | Obtain a list of the hardware targets that are relevant for a given HITL test. hwTRefsFromTest :: HitlTest -> [HwTargetRef] hwTRefsFromTest HitlTest{testIters} = @@ -213,7 +236,7 @@ to it and receives that constructur as test parameter. -} testItersFromEnum :: forall a b. - (Show a, Bounded a, Enum a, BitPack a, Show b) => + (Show a, Bounded a, Enum a, BitPack a, Show b, Typeable a, Typeable b) => [HwTargetRef] -> b -> [HitlTestIter HwTargetRef a b] diff --git a/bittide-tools/clockcontrol/plot/Main.hs b/bittide-tools/clockcontrol/plot/Main.hs index 91bfd0654..9377a0c9e 100644 --- a/bittide-tools/clockcontrol/plot/Main.hs +++ b/bittide-tools/clockcontrol/plot/Main.hs @@ -61,7 +61,6 @@ import Control.Exception (Exception (..), catch, throw) import Control.Monad (filterM, forM, forM_, unless, when) import Control.Monad.Extra (unlessM) import Data.Bifunctor (bimap) -import Data.Bool import Data.ByteString qualified as BS import Data.ByteString.Char8 qualified as BSC import Data.ByteString.Lazy qualified as BSL @@ -82,13 +81,14 @@ import Data.Csv.Conduit ( ) import Data.Functor ((<&>)) import Data.HashMap.Strict qualified as HashMap -import Data.List (find, isPrefixOf, isSuffixOf, uncons, unzip4) +import Data.List (isPrefixOf, isSuffixOf, uncons, unzip4) import Data.Map qualified as Map import Data.Maybe (catMaybes, fromJust, fromMaybe, mapMaybe) import Data.Proxy (Proxy (..)) import Data.Set qualified as Set import Data.String (fromString) import Data.Text qualified as Text +import Data.Typeable (cast) import Data.Vector qualified as Vector import GHC.IO.Exception (IOErrorType (..), IOException (..)) import GHC.Stack (HasCallStack) @@ -100,7 +100,6 @@ import System.Directory ( import System.Environment (getArgs, getProgName) import System.Exit (die) import System.FilePath ( - isExtensionOf, takeBaseName, takeExtensions, takeFileName, @@ -127,13 +126,13 @@ import Bittide.Hitl import Bittide.Instances.Domains import Bittide.Instances.Hitl.IlaPlot import Bittide.Instances.Hitl.Setup -import Bittide.Instances.Hitl.Tests import Bittide.Plot import Bittide.Report.ClockControl import Bittide.Simulate.Config (CcConf, saveCcConfig, simTopologyFileName) import Bittide.Topology import Bittide.Simulate.Config qualified as CcConf +import Bittide.Instances.Hitl.Tests (hitlTests) -- A newtype wrapper for working with hex encoded types. newtype Hex a = Hex {fromHex :: a} @@ -482,18 +481,21 @@ fromCsvDump t i links (csvHandle, csvFile) = {- | The HITL tests, whose post proc data offers a simulation config for plotting. -} -knownTestsWithCcConf :: (HasCallStack) => [(String, [(String, CcConf)])] -knownTestsWithCcConf = hasCcConf <$> hitlTests +knownTestsWithCcConf :: (HasCallStack) => [(ClashTargetName, [(String, CcConf)])] +knownTestsWithCcConf = mapMaybe go hitlTests where - hasCcConf = \case - LoadConfig name _ -> (name, []) - KnownType name test -> - let !simConfMap = Map.mapMaybeWithKey justOrDie (mGetPPD @_ @CcConf test) - in (name, first Text.unpack <$> Map.toList simConfMap) - justOrDie _ (Just x) = Just x justOrDie k Nothing = error $ "No CcConf for " <> show k + go HitlTest{topEntity, testIters = iters :: [HitlTestIter HwTargetRef q r]} = + case cast @[HitlTestIter HwTargetRef q r] @[HitlTestIter HwTargetRef q CcConf] iters of + Just q -> + Just + ( topEntity + , Map.toList (Map.mapMaybeWithKey justOrDie (mGetPPD @CcConf @HwTargetRef q)) + ) + Nothing -> Nothing + {- | Calculate an offset such that the clocks start at their set offsets. That is to say, we consider the reference clock to be at 0 fs by definition. The offsets of the other clocks are then measured relative to this reference clock. We don't @@ -739,47 +741,46 @@ main = unless (null zr) wrongNumberOfArguments return (plotDataDir, outDir, mA) - tests <- do - dirs <- listDirectory plotDataDir - let hitlDir = plotDataDir "hitl" - files <- - bool - (die $ "No 'hitl' folder in " <> fromMaybe plotDataDir mArtifactName) - (listDirectory hitlDir) - ("hitl" `elem` dirs) - case filter (".yml" `isExtensionOf`) files of - [] -> die $ "No YAML files in " <> hitlDir - [x] -> return $ getTestsWithCcConf $ takeBaseName x - _ -> die $ "Too many YAML files in " <> hitlDir - - (testDirs, testsDir) <- do + let tests = + [ (show topEntity <> ":" <> iterName, mCcConf) + | (topEntity, iters) <- knownTestsWithCcConf + , (iterName, mCcConf) <- iters + ] + -- tests <- do + -- dirs <- listDirectory plotDataDir + -- let hitlDir = plotDataDir "hitl" + -- files <- bool + -- (die $ "No 'hitl' folder in " <> fromMaybe plotDataDir mArtifactName) + -- (listDirectory hitlDir) + -- ("hitl" `elem` dirs) + -- case filter (".yml" `isExtensionOf`) files of + -- [] -> die $ "No YAML files in " <> hitlDir + -- [x] -> return $ getTestsWithCcConf $ takeBaseName x + -- _ -> die $ "Too many YAML files in " <> hitlDir + + (_, testsDir) <- do let epsfix = maybe (Left "Bittide.Instances.Hitl.") Right mArtifactName dir <- diveDownInto epsfix plotDataDir listDirectory dir >>= filterM (doesDirectoryExist . (dir )) <&> (,dir) - let sDirs = Set.fromList testDirs - sNames = Set.fromList $ fst <$> tests - when (sDirs /= sNames) $ - die $ - if sDirs `Set.isProperSubsetOf` sNames - then - "Missing tests " - <> show (Set.toList (sNames `Set.difference` sDirs)) - <> " in " - <> testsDir - else - "Unknown tests " - <> show (Set.toList (sDirs `Set.difference` sNames)) - <> " in " - <> testsDir + -- let sDirs = Set.fromList testDirs + -- sNames = Set.fromList $ fst <$> tests + -- when (sDirs /= sNames) $ die $ + -- if sDirs `Set.isProperSubsetOf` sNames + -- then "Missing tests " + -- <> show (Set.toList (sNames `Set.difference` sDirs)) + -- <> " in " <> testsDir + -- else "Unknown tests " + -- <> show (Set.toList (sDirs `Set.difference` sNames)) + -- <> " in " <> testsDir forM_ tests $ \(test, cfg) -> plotTest (Proxy @Basic125) test cfg (testsDir test) outDir where - getTestsWithCcConf name = - maybe [] snd $ find ((== name) . fst) knownTestsWithCcConf + -- getTestsWithCcConf name = + -- maybe [] snd $ find ((== name) . fst) knownTestsWithCcConf diveDownInto epsfix dir = listDirectory dir