From c61b6edd0a737aa0be664f6b070d5aed8ee42bfb Mon Sep 17 00:00:00 2001 From: artyom Date: Wed, 16 Jun 2021 21:02:51 +0300 Subject: [PATCH 1/3] dsl_upd: prototype for TargetSyntesis support dsl_upd: fixed func assign dsl_upd: wip add to UnitTestState TargetSynthesis possibility dsl_upd: removed separate data for TargetSynthesis, now only UnitTestState keep dsl data dsl_upd: updated structure, now able to assign tRecievedValues with assignNaive dsl_upd: added prototype of Lua tests. Removed algTestCase dsl_upd: updated typedIOLuaTestCase implementation with DSL dsl_upd: refactored function location, added traceDataflow dsl_upd: unified unitTestCase and nittaTestCase, added setRecievedValues functions, refactored tests with new functions dsl_upd: renamed function to `setNetwork`; refactored setRecievedValue; refactored `setBusType` implementation; refactored `test_add_and_io` test dsl_upd: renamed `assertSynthesisFinished` to `assertSynthesisDoneT` dsl WIP: assertSynthesisInclude prototype dsl WIP: updated `assertSynthesisDoneT` now it saves tDFG from functions; in optimisation check tDFG could be formed from tSourceCode dsl: written test for optimisation, negative is WIP. Added to DSL toDfg function, added synthesis function for Bus without testbench run dsl WIP: added Bind function (actually only activate BindOptions show); added trace for DataFlow and BindOptions. wip DSL: added bind variables and transfer variables wip(DSL): made transfer variables via filter to catch define cases more than one decision or none wip(DSL): added trace Refactor test(DSL): wip detailed test of BusNetwork wip DSL: renamed DSL functions; added list implementation for bind; added BreakLoop assertion function and some test for it; added getCADs to Utils. wip DSL: made UnitTestCase readable wip DSL: added assignFunction for BusNetwork (instead assignNaive) to fix bug with DFG transformation; fixed tests wip DSL: refactored traceRefactor, fixed hlint let warn; extracted lua code into separate function. wip DSL: renamed assertSynthesisRun method wip DSL: refactor auto test breakloop wip DSL: refactored auto synthesis --- nitta.cabal | 1 + src/NITTA/Utils.hs | 6 + test/NITTA/LuaFrontend/Tests.hs | 19 +- test/NITTA/LuaFrontend/Tests/Providers.hs | 45 +--- .../NITTA/Model/ProcessorUnits/Accum/Tests.hs | 84 +++++- test/NITTA/Model/ProcessorUnits/Tests/DSL.hs | 248 +++++++++++++++++- .../Model/ProcessorUnits/Tests/DSL/Tests.hs | 73 ++++++ test/NITTA/Model/Tests/Internals.hs | 5 + test/NITTA/Model/Tests/Providers.hs | 12 - test/NITTA/Tests.hs | 68 ++--- 10 files changed, 456 insertions(+), 105 deletions(-) diff --git a/nitta.cabal b/nitta.cabal index cc5628ce5..ed0656f29 100644 --- a/nitta.cabal +++ b/nitta.cabal @@ -237,6 +237,7 @@ test-suite nitta-test NITTA.Model.ProcessorUnits.Shift.Tests NITTA.Model.ProcessorUnits.Tests.DSL NITTA.Model.ProcessorUnits.Tests.DSL.Tests + NITTA.Model.ProcessorUnits.Tests.OptimisationInclude NITTA.Model.ProcessorUnits.Tests.Providers NITTA.Model.ProcessorUnits.Tests.Utils NITTA.Model.Tests.Internals diff --git a/src/NITTA/Utils.hs b/src/NITTA/Utils.hs index 9bca3d63f..56049711c 100644 --- a/src/NITTA/Utils.hs +++ b/src/NITTA/Utils.hs @@ -36,6 +36,7 @@ module NITTA.Utils ( relatedEndpoints, isFB, getFBs, + getCADs, isInstruction, module NITTA.Utils.Base, @@ -121,6 +122,11 @@ getFB _ = Nothing getFBs p = mapMaybe getFB $ sortOn stepStart $ steps p +getCADs p = mapMaybe getCAD $ steps p + +getCAD Step{pDesc} | CADStep fb <- descent pDesc = Just fb +getCAD _ = Nothing + getEndpoint Step{pDesc} | EndpointRoleStep role <- descent pDesc = Just role getEndpoint _ = Nothing diff --git a/test/NITTA/LuaFrontend/Tests.hs b/test/NITTA/LuaFrontend/Tests.hs index 5fe158df1..7e0b47f3a 100644 --- a/test/NITTA/LuaFrontend/Tests.hs +++ b/test/NITTA/LuaFrontend/Tests.hs @@ -23,6 +23,11 @@ module NITTA.LuaFrontend.Tests ( tests, ) where +import Control.Exception (ErrorCall, catch) +import Data.Default +import Data.FileEmbed (embedStringFile) +import Data.String.Interpolate +import qualified Data.Text as T import Control.Monad.State import Data.FileEmbed (embedStringFile) import qualified Data.HashMap.Strict as HM @@ -33,6 +38,8 @@ import NITTA.Intermediate.Functions import NITTA.Intermediate.Types import NITTA.LuaFrontend import NITTA.LuaFrontend.Tests.Providers +import NITTA.Model.ProcessorUnits.Tests.Providers +import NITTA.Synthesis (TargetSynthesis) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit import Test.Tasty.TH @@ -572,11 +579,11 @@ test_trace_features = ] test_examples = - [ typedLuaTestCase - (microarch Sync SlaveSPI) - pFX22_32 - "teacup io wait" - $(embedStringFile "examples/teacup.lua") + [ unitTestCase "teacup io wait" ts $ do + setNetwork $ microarch Sync SlaveSPI + setBusType pFX22_32 + assignLua $(embedStringFile "examples/teacup.lua") + assertSynthesisDoneAuto , typedLuaTestCase (microarch ASync SlaveSPI) pFX22_32 @@ -698,5 +705,7 @@ test_examples = $(embedStringFile "examples/spi3.lua") ] +ts = def :: Val x => TargetSynthesis T.Text T.Text x Int + tests :: TestTree tests = $(testGroupGenerator) diff --git a/test/NITTA/LuaFrontend/Tests/Providers.hs b/test/NITTA/LuaFrontend/Tests/Providers.hs index 42ec7a06d..d6d998e14 100644 --- a/test/NITTA/LuaFrontend/Tests/Providers.hs +++ b/test/NITTA/LuaFrontend/Tests/Providers.hs @@ -34,11 +34,9 @@ import NITTA.Intermediate.Types import NITTA.LuaFrontend import NITTA.Model.Networks.Bus import NITTA.Model.Networks.Types -import NITTA.Model.Tests.Internals +import NITTA.Model.ProcessorUnits.Tests.Providers import NITTA.Model.Tests.Microarchitecture -import NITTA.Project import NITTA.Synthesis -import NITTA.Utils import Test.Tasty (TestTree) import Test.Tasty.HUnit @@ -77,38 +75,11 @@ typedIOLuaTestCase :: [(T.Text, [x])] -> T.Text -> TestTree -typedIOLuaTestCase arch proxy name received src = testCase name $ do - let wd = "lua_" <> toModuleName name - status <- runLua arch proxy wd received src - case status of - Left err -> assertFailure err - Right _ -> return () +typedIOLuaTestCase arch proxy name received src = unitTestCase name ts $ do + setNetwork arch + setBusType proxy + setRecievedValues received + assignLua src + assertSynthesisDoneAuto --- Internals - -runLua :: - forall x. - (Val x, Integral x) => - BusNetwork T.Text T.Text x Int -> - Proxy x -> - String -> - [(T.Text, [x])] -> - T.Text -> - IO (Either String ()) -runLua arch _proxy wd received src = do - reportE <- - runTargetSynthesisWithUniqName - (def :: TargetSynthesis T.Text T.Text x Int) - { tName = wd - , tMicroArch = arch - , tSourceCode = Just src - , tReceivedValues = received - } - return $ case reportE of - Left err -> Left $ "synthesis process fail: " <> err - Right TestbenchReport{tbStatus = True} -> Right () - Right report@TestbenchReport{tbCompilerDump} - | T.length tbCompilerDump > 2 -> - Left $ "icarus synthesis error:\n" <> show report - Right report@TestbenchReport{} -> - Left $ "icarus simulation error:\n" <> show report +ts = def :: Val x => TargetSynthesis T.Text T.Text x Int diff --git a/test/NITTA/Model/ProcessorUnits/Accum/Tests.hs b/test/NITTA/Model/ProcessorUnits/Accum/Tests.hs index cfcf12dc8..2efb39eef 100644 --- a/test/NITTA/Model/ProcessorUnits/Accum/Tests.hs +++ b/test/NITTA/Model/ProcessorUnits/Accum/Tests.hs @@ -21,10 +21,11 @@ import Data.Default import qualified Data.Set as S import Data.String.Interpolate import qualified Data.Text as T -import NITTA.Intermediate.Functions as F +import qualified NITTA.Intermediate.Functions as F import NITTA.LuaFrontend.Tests.Providers import NITTA.Model.ProcessorUnits.Tests.Providers import NITTA.Model.Tests.Providers +import NITTA.Synthesis import Test.QuickCheck import Test.Tasty (testGroup) @@ -126,18 +127,63 @@ tests = [("a", 1), ("b", 2), ("e", 4), ("f", -4), ("j", 8)] [ accFromStr "+a +b = c = d; +e -f = g; +j = k" ] - , luaTestCase - "test_accum_optimization_and_deadlock_resolve" + , unitTestCase "test_accum_optimization_and_deadlock_resolve" ts2 $ do -- TODO: We need to check that synthesis process do all needed refactoring - [__i| - function sum(a, b, c) - local d = a + b + c -- should AccumOptimization - local e = d + 1 -- e and d should be buffered - local f = d + 2 - sum(d, f, e) - end - sum(0,0,0) - |] + setNetwork $ microarch ASync SlaveSPI + setBusType pAttrIntX32 + assignLua luaTemplate + assertSynthesisRunAuto + traceDataflow + traceBus + , unitTestCase "negative optimisation test" tbr $ do + setNetwork $ maBroken ubr{wrongAttr = True} + setBusType pAttrIntX32 + assignLua luaTemplate + traceDataflow + traceTransferOptions + , unitTestCase "bus network detailed test" tbr $ do + setNetwork $ maBroken ubr + setBusType pAttrIntX32 + assignLua luaTemplate + bindInit + let loopDA = F.loop 0 "d#0" ["a#0"] + loopEC = F.loop 0 "e#0" ["c#0"] + loopFB = F.loop 0 "f#0" ["b#0"] + bindVariables [loopDA, loopEC, loopFB] + bindVariable (F.constant 1 ["1@const#0"]) + bindVariable (F.constant 2 ["2@const#0"]) + traceBindVariables + -- TODO: Does it bind both? + bindVariable (F.add "d#1" "2@const#0" ["f#0"]) + traceBindVariables + -- works both variants + --transferVariables $ provide ["2@const#0"] + bindVariable (F.add "d#2" "1@const#0" ["e#0"]) + bindVariable (F.add "a#0" "b#0" ["tmp_0#0"]) + bindVariable (F.add "tmp_0#0" "c#0" ["d#0", "d#1", "d#2"]) + transferVariables $ consume "2@const#0" + traceAvailableRefactor + applyBreakLoops [loopDA, loopEC, loopFB] + assertLoopBroken [loopDA, loopEC, loopFB] + , unitTestCase "transfer variable test" tbr $ do + setNetwork $ microarch ASync SlaveSPI + setBusType pAttrIntX32 + assignLua luaTemplate + assertSynthesisRunAuto + traceDataflow + traceBus + , unitTestCase "fixpoint 22 32" ts $ do + setNetwork $ microarch ASync SlaveSPI + setBusType pFX22_32 + assignLua + [__i| + function f() + send(0.5 - 0.25) + send(-1.25 + 2.5) + end + f() + |] + assertSynthesisDoneAuto , typedLuaTestCase (microarch ASync SlaveSPI) pFX22_32 @@ -303,6 +349,20 @@ tests = assertCoSimulation ] where + ts = def :: Val x => TargetSynthesis T.Text T.Text x Int + ts2 = def :: Val x => TargetSynthesis T.Text T.Text x Int + tbr = def :: Val x => TargetSynthesis T.Text T.Text x Int + ubr = def :: Broken T.Text (Attr (IntX 32)) Int accumDef = def :: Accum T.Text Int Int u2 = def :: Accum T.Text (Attr (IntX 8)) Int fsGen = algGen [packF <$> (arbitrary :: Gen (Acc _ _))] + luaTemplate = + [__i| + function sum(a, b, c) + local d = a + b + c -- should AccumOptimization + local e = d + 1 -- e and d should be buffered + local f = d + 2 + sum(d, f, e) + end + sum(0,0,0) + |] diff --git a/test/NITTA/Model/ProcessorUnits/Tests/DSL.hs b/test/NITTA/Model/ProcessorUnits/Tests/DSL.hs index 663f1ea33..d7d9170bf 100644 --- a/test/NITTA/Model/ProcessorUnits/Tests/DSL.hs +++ b/test/NITTA/Model/ProcessorUnits/Tests/DSL.hs @@ -127,21 +127,60 @@ module NITTA.Model.ProcessorUnits.Tests.DSL ( traceFunctions, traceEndpoints, traceProcess, + + -- *Target synthesis + setNetwork, + setBusType, + setRecievedValue, + setRecievedValues, + assignLua, + bindInit, + bindVariable, + bindVariables, + traceBindVariables, + traceDataflow, + traceTransferOptions, + traceAvailableRefactor, + traceBus, + assertSynthesisDoneAuto, + assertSynthesisRunAuto, + transferVariables, + transferVariablesAt, + getLoopFunctions, + applyBreakLoop, + applyBreakLoops, + assertLoopBroken, + assignFunction, + assignFunctions, + applyConstantFolding, + assertConstantFolded, + applyOptimizeAccum, + assertOptimizeAccum, ) where import Control.Monad.Identity import Control.Monad.State.Lazy import Data.CallStack -import Data.List (find) +import Data.Either +import Data.List (find, isSubsequenceOf) +import Data.Maybe +import Data.Proxy import qualified Data.Set as S import Data.String.ToString import qualified Data.String.Utils as S +import qualified Data.Text as T +import NITTA.Intermediate.DataFlow +import NITTA.Intermediate.Functions import NITTA.Intermediate.Types +import NITTA.LuaFrontend +import NITTA.Model.Networks.Bus import NITTA.Model.Networks.Types (PUClasses) import NITTA.Model.Problems import NITTA.Model.ProcessorUnits import NITTA.Model.ProcessorUnits.Tests.Utils +import NITTA.Model.Tests.Internals import NITTA.Project +import NITTA.Synthesis import NITTA.Utils import Numeric.Interval.NonEmpty hiding (elem) import Prettyprinter (pretty) @@ -149,10 +188,10 @@ import Test.Tasty (TestTree) import Test.Tasty.HUnit (assertBool, assertFailure, testCase) unitTestCase :: - (HasCallStack, ProcessorUnit pu v x t, EndpointProblem pu v t) => + HasCallStack => String -> - pu -> - DSLStatement pu v x t () -> + u -> + StateT (UnitTestState u v x) IO () -> TestTree unitTestCase name pu alg = testCase name $ do void $ evalUnitTestState name pu alg @@ -169,15 +208,28 @@ data UnitTestState pu v x = UnitTestState functs :: [F v x] , -- | Initial values for coSimulation cntxCycle :: [(v, x)] + , -- | TODO: add suitable type + busType :: Maybe (Proxy x) + , report :: Either String (TestbenchReport v x) } deriving (Show) type DSLStatement pu v x t r = (HasCallStack, ProcessorUnit pu v x t, EndpointProblem pu v t) => StateT (UnitTestState pu v x) IO r -evalUnitTestState name st alg = evalStateT alg (UnitTestState name st [] []) +evalUnitTestState name st alg = + evalStateT + alg + UnitTestState + { testName = name + , unit = st + , functs = [] + , cntxCycle = [] + , busType = Nothing + , report = Left "Report not ready!" + } -- | Binds several provided functions to PU -assigns alg = mapM_ assign alg +assigns = mapM_ assign -- | Binds provided function to PU assign :: F v x -> DSLStatement pu v x t () @@ -197,11 +249,12 @@ for naive coSimulation -} assignNaive f cntxs = do st@UnitTestState{functs, cntxCycle} <- get + -- TODO: add if value is present put st{functs = f : functs, cntxCycle = cntxs <> cntxCycle} -- | set initital values for coSimulation input variables setValues :: (Function f v, WithFunctions pu f) => [(v, x)] -> DSLStatement pu v x t () -setValues = mapM_ (uncurry setValue) +setValues = mapM_ $ uncurry setValue -- | set initital value for coSimulation input variables setValue :: (Var v, Function f v, WithFunctions pu f) => v -> x -> DSLStatement pu v x t () @@ -215,6 +268,76 @@ setValue var val = do where isVarAvailable v pu = S.isSubsetOf (S.fromList [v]) $ inpVars $ functions pu +assignFunction f = assignFunctions [f] + +assignFunctions fs = do + st@UnitTestState{functs, unit = ts@TargetSynthesis{}} <- get + let tDFG' = fsToDataFlowGraph $ fs <> functs + put st{functs = fs <> functs, unit = ts{tDFG = tDFG'}} + +-- TODO u can keep this variant, but not recommend +assignLua src = + let translateToIntermediate = return . frDataFlow . lua2functions + in do + st@UnitTestState{functs, unit = ts@TargetSynthesis{}} <- get + tDFG' <- maybe (return $ fsToDataFlowGraph functs) translateToIntermediate $ Just src + put st{unit = ts{tSourceCode = Just src, tDFG = tDFG'}} + +setBusType busType = modify' $ \st -> st{busType = Just busType} + +setRecievedValues = mapM_ $ uncurry setRecievedValue + +setRecievedValue var val = do + st@UnitTestState{unit = ts@TargetSynthesis{tReceivedValues = vs}} <- get + put st{unit = ts{tReceivedValues = (var, val) : vs}} + +setNetwork network = do + st@UnitTestState{unit = ts@TargetSynthesis{}} <- get + put st{unit = ts{tMicroArch = network}} + +-- | Allows manual binding function. Incompatible with auto synthesis. +bindInit = do + st@UnitTestState{unit = ts@TargetSynthesis{tMicroArch, tDFG}} <- get + root <- lift $ getTreeUnit tMicroArch tDFG + put st{unit = ts{tMicroArch = root}} + +bindVariable f = do + st@UnitTestState{unit = ts@TargetSynthesis{tMicroArch}, functs} <- get + case find (\(Bind f' _) -> f == f') $ bindOptions tMicroArch of + Just decision -> put st{unit = ts{tMicroArch = bindDecision tMicroArch decision}, functs = f : functs} + Nothing -> lift $ assertFailure ("Cannot bind variable: " <> show f) + +bindVariables = mapM_ bindVariable + +-- TODO: don't run it more than once +getTreeUnit tMicroArch tDfg = targetUnit <$> synthesisTreeRootIO (mkModelWithOneNetwork tMicroArch tDfg) + +transferVariables v = transferVariables' v Nothing + +transferVariablesAt v from to = transferVariables' v $ Just (from, to) + +-- TODO: is it possible to use unsafe parameter? +transferVariables' v intrvl = do + st@UnitTestState{unit = ts@TargetSynthesis{tMicroArch = ma@BusNetwork{}}} <- get + let res = findDecision ma v intrvl + unless (length res == 1) $ + lift $ assertFailure ("Cannot transfer variable: " <> show v) + case length res of + 1 -> put st{unit = ts{tMicroArch = dataflowDecision ma $ dataflowOption2decision $ head res}} + 0 -> lift $ assertFailure ("Cannot transfer variable: " <> show v <> "; Haven't found any decisions.") + _ -> lift $ assertFailure ("Cannot transfer variable: " <> show v <> "; There are more than one possible decision: " <> show res) + +findDecision u v intrvl = + let isSame dfo = any (isSubroleOf v) $ provider dfo : consumer dfo + provider dfo = epRole $ snd $ dfSource dfo + consumer dfo = map (epRole . snd) $ dfTargets dfo + isIntrvl Nothing _ = True + isIntrvl (Just (a, b)) dfo = isValidInterval (a ... b) $ epAt $ snd $ dfSource dfo + isValidInterval atA atB = + atA `isSubsetOf` tcAvailable atB + && member (width atA + 1) (tcDuration atB) + in filter (\dfo -> isSame dfo && isIntrvl intrvl dfo) $ dataflowOptions u + -- | Make synthesis decision with provided Endpoint Role and automatically assigned time decide :: EndpointRole v -> DSLStatement pu v x t () decide role = do @@ -320,6 +443,36 @@ assertSynthesisDone = do unless (isProcessComplete unit functs && null (endpointOptions unit)) $ lift $ assertFailure $ testName <> " Process is not done: " <> incompleteProcessMsg unit functs +-- | Run both automatic synthesis and Testbench. +assertSynthesisDoneAuto = assertSynthesis True + +-- | Run only automatic synthesis without Testbench. +assertSynthesisRunAuto = assertSynthesis False + +assertSynthesis isTestbench = do + st@UnitTestState{testName, functs, unit = ts@TargetSynthesis{tSourceCode}} <- get + when (null functs && isNothing tSourceCode) $ + lift $ assertFailure "Can't run target synthesis, you haven't provided any functions or source code" + let wd = toModuleName $ toString testName + let namedTs = ts{tName = if isJust tSourceCode then "lua_" <> wd else wd} + result <- lift $ synthesizeTargetSystemWithUniqName namedTs + case result of + Left l -> lift $ assertFailure $ "target synthesis failed" <> show l + Right r -> put st{unit = namedTs{tMicroArch = pUnit r}} + when isTestbench $ + lift $ getTestbenchReport result + +getTestbenchReport project = do + reportTestbench <- traverse runTestbench project + case reportTestbench of + Left err -> assertFailure ("synthesis process fail " <> err) + Right TestbenchReport{tbStatus = True} -> return () + Right report@TestbenchReport{tbCompilerDump} + | T.length tbCompilerDump > 2 -> + assertFailure ("icarus synthesis error:\n" <> show report) + Right report@TestbenchReport{} -> + assertFailure ("icarus simulation error:\n" <> show report) + assertLocks :: (Locks pu v) => [Lock v] -> DSLStatement pu v x t () assertLocks expectLocks = do UnitTestState{unit} <- get @@ -374,3 +527,84 @@ traceProcess = do UnitTestState{unit} <- get lift $ putStrLn $ "Process: " <> show (pretty $ process unit) return () + +traceDataflow = do + UnitTestState{unit = TargetSynthesis{tDFG}} <- get + lift $ putStrLn $ "Dataflow: " <> show tDFG + return () + +traceBus = do + UnitTestState{unit = TargetSynthesis{tMicroArch = b@BusNetwork{}}} <- get + lift $ putStrLn $ "Bus: " <> show (pretty $ process b) + return () + +traceTransferOptions = do + UnitTestState{unit = TargetSynthesis{tMicroArch = ma@BusNetwork{}}} <- get + lift $ putStrLn $ "Dataflow options: " <> show (dataflowOptions ma) + return () + +traceBindVariables = do + UnitTestState{unit = TargetSynthesis{tMicroArch}} <- get + lift $ putStrLn $ "BindVariables: " <> show (bindOptions tMicroArch) + return () + +traceAvailableRefactor = do + UnitTestState{unit = TargetSynthesis{tMicroArch = bus}} <- get + lift $ putStrLn "Available refactor" + lift $ putStrLn $ " breakLoopOptions: " <> show (breakLoopOptions bus) + lift $ putStrLn $ " constantFoldingOptions : " <> show (constantFoldingOptions bus) + lift $ putStrLn $ " optimizeAccumOptions: " <> show (optimizeAccumOptions bus) + lift $ putStrLn $ " resolveDeadlockOptions: " <> show (resolveDeadlockOptions bus) + return () + +-- | Get all loop function. Can be used as value to assertLoopBroken after auto synthesis. +getLoopFunctions = do + UnitTestState{unit = TargetSynthesis{tMicroArch, tDFG}} <- get + root <- lift $ getTreeUnit tMicroArch tDFG + let loopFs = filter isLoop $ map (\(Bind f _) -> f) $ bindOptions root + return loopFs + +applyBreakLoop f = do + st@UnitTestState{unit = ts@TargetSynthesis{tMicroArch}} <- get + case find (\l@BreakLoop{} -> recLoop l == f) $ breakLoopOptions tMicroArch of + Just refactor -> put st{unit = ts{tMicroArch = breakLoopDecision tMicroArch refactor}} + Nothing -> lift $ assertFailure $ "Can't find refactor for such function: " <> show f + +applyBreakLoops fs = mapM_ applyBreakLoop fs + +-- TODO combine with assertSynthesisInclude?? +assertLoopBroken [] = lift $ assertFailure "Can't check is loop broken for empty list!" +assertLoopBroken fs = do + UnitTestState{unit = TargetSynthesis{tMicroArch = ma@BusNetwork{}}} <- get + -- TODO add loop filter to check that there is no other func + let fs' = S.fromList $ concatMap (concatBind . loopExtract) fs + let cad = S.fromList $ getCADs $ process ma + unless (S.isSubsetOf fs' cad) $ + lift $ + assertFailure $ + "Can't find refactor for such functions: " + <> show (S.difference fs' cad) + <> "\n in: " + <> show cad + where + loopExtract f + | Just f_@(Loop _ (O ov) (I iv)) <- castF f = Just (f_, ov, iv) + | otherwise = Nothing + concatBind (Just (f, ov, iv)) = ["bind LoopBegin " <> label f <> " " <> concatMap label (S.elems ov), "bind LoopEnd " <> label f <> " " <> label iv] + concatBind Nothing = [] + +applyConstantFolding fs = do + st@UnitTestState{unit = ts@TargetSynthesis{tMicroArch}} <- get + case find (\ConstantFolding{cRefOld} -> isSubsequenceOf fs cRefOld) $ constantFoldingOptions tMicroArch of + Just refactor -> put st{unit = ts{tMicroArch = constantFoldingDecision tMicroArch refactor}} + Nothing -> lift $ assertFailure $ "Can't find refactor for such function: " <> show fs + +assertConstantFolded = undefined + +applyOptimizeAccum fs = do + st@UnitTestState{unit = ts@TargetSynthesis{tMicroArch}} <- get + case find (\OptimizeAccum{refOld} -> isSubsequenceOf fs refOld) $ optimizeAccumOptions tMicroArch of + Just refactor -> put st{unit = ts{tMicroArch = optimizeAccumDecision tMicroArch refactor}} + Nothing -> lift $ assertFailure $ "Can't find refactor for such function: " <> show fs + +assertOptimizeAccum = undefined diff --git a/test/NITTA/Model/ProcessorUnits/Tests/DSL/Tests.hs b/test/NITTA/Model/ProcessorUnits/Tests/DSL/Tests.hs index e3a5b934f..1b52fdd7e 100644 --- a/test/NITTA/Model/ProcessorUnits/Tests/DSL/Tests.hs +++ b/test/NITTA/Model/ProcessorUnits/Tests/DSL/Tests.hs @@ -1,5 +1,7 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE QuasiQuotes #-} {-# OPTIONS -fno-warn-partial-type-signatures #-} @@ -16,7 +18,11 @@ module NITTA.Model.ProcessorUnits.Tests.DSL.Tests ( ) where import Data.Default +import Data.String.Interpolate +import qualified Data.Text as T import NITTA.Model.ProcessorUnits.Tests.Providers +import NITTA.Model.Tests.Providers +import NITTA.Synthesis import Test.Tasty (testGroup) import Test.Tasty.ExpectedFailure @@ -150,7 +156,74 @@ tests = decide $ consume "a" assertLocks [Lock{locked = "c", lockBy = "b"}] ] + , testGroup + "BusNetwork positive tests" + [ unitTestCase "assertLoopBroken ok when break applied" tbr $ do + breakLoopTemplate + bindInit + let loopEC = loop 0 "e#0" ["c#0"] + bindVariable loopEC + applyBreakLoop loopEC + assertLoopBroken [loopEC] + , unitTestCase "assertLoopBroken ok when auto synthesis" tbr $ do + setNetwork march + setBusType pInt + assignLua + [__i| + function sum(a, b, c) + local d = a + b + c -- should AccumOptimization + local e = d + 1 -- e and d should be buffered + local f = d + 2 + sum(d, f, e) + end + sum(0,0,0) + |] + loopFs <- getLoopFunctions + assertSynthesisRunAuto + assertLoopBroken loopFs + ] + , testGroup + "BusNetwork negative tests" + [ expectFail $ + unitTestCase "assertLoopBroken fail when func not binded" tbr $ do + breakLoopTemplate + bindInit + let loopEC = loop 0 "e#0" ["c#0"] + let loopDA = loop 0 "d#0" ["a#0"] + bindVariables [loopEC, loopDA] + assertLoopBroken [loopEC, loopDA] + , expectFail $ + unitTestCase "assertLoopBroken fail when func binded" tbr $ do + breakLoopTemplate + bindInit + let loopEC = loop 0 "e#0" ["c#0"] + bindVariable loopEC + assertLoopBroken [loopEC] + , expectFail $ + unitTestCase "assertLoopBroken when func binded" tbr $ do + -- TODO fix case: for unknown reason loop e -> c is not present in process: + -- ["bind LoopBegin loop(0, e#0) = c#0 c#0","bind LoopEnd loop(0, e#0) = c#0 e#0"] + breakLoopTemplate + loopFs <- getLoopFunctions + assertSynthesisRunAuto + traceBus + assertLoopBroken loopFs + ] ] where + tbr = def :: Val x => TargetSynthesis T.Text T.Text x Int u = multiplier True :: Multiplier String Int Int broken = def :: Broken String Int Int + breakLoopTemplate = do + setNetwork march + setBusType pInt + assignLua + [__i| + function sum(a, c) + local d = a + c + local m = 100 + local e = m + 1 + sum(d, e) + end + sum(0,0) + |] diff --git a/test/NITTA/Model/Tests/Internals.hs b/test/NITTA/Model/Tests/Internals.hs index 116c0eef0..ad7b350e5 100644 --- a/test/NITTA/Model/Tests/Internals.hs +++ b/test/NITTA/Model/Tests/Internals.hs @@ -11,6 +11,7 @@ Stability : experimental module NITTA.Model.Tests.Internals ( runTargetSynthesisWithUniqName, uniqTestPath, + synthesizeTargetSystemWithUniqName, ) where import Control.Concurrent.STM.TVar @@ -37,3 +38,7 @@ uniqTestPath name = runTargetSynthesisWithUniqName t@TargetSynthesis{tName} = do name <- uniqTestPath tName runTargetSynthesis t{tName = name} + +synthesizeTargetSystemWithUniqName t@TargetSynthesis{tName} = do + name <- uniqTestPath tName + synthesizeTargetSystem t{tName = name} diff --git a/test/NITTA/Model/Tests/Providers.hs b/test/NITTA/Model/Tests/Providers.hs index fae14754a..b52680246 100644 --- a/test/NITTA/Model/Tests/Providers.hs +++ b/test/NITTA/Model/Tests/Providers.hs @@ -20,12 +20,10 @@ Stability : experimental -} module NITTA.Model.Tests.Providers ( nittaCoSimTestCase, - algTestCase, module NITTA.Intermediate.Functions, module NITTA.Model.Tests.Microarchitecture, ) where -import Control.Monad (void) import Data.CallStack import Data.Default import qualified Data.String.Utils as S @@ -64,13 +62,3 @@ nittaCoSimTestCase n tMicroArch alg = Right report@TestbenchReport{tbStatus} -> assertBool ("report with bad status:\n" <> show report) tbStatus Left err -> assertFailure $ "can't get report: " <> err - -algTestCase n tMicroArch alg = - testCase n $ - void $ - runTargetSynthesisWithUniqName - (def :: TargetSynthesis _ _ _ Int) - { tName = n - , tMicroArch - , tDFG = fsToDataFlowGraph alg - } diff --git a/test/NITTA/Tests.hs b/test/NITTA/Tests.hs index 070ba79dc..3fa8623a3 100644 --- a/test/NITTA/Tests.hs +++ b/test/NITTA/Tests.hs @@ -24,18 +24,16 @@ module NITTA.Tests ( tests, ) where -import Control.Monad (void) import Data.Default import Data.Map.Strict (fromList) import qualified Data.Set as S import qualified Data.Text as T -import NITTA.Intermediate.DataFlow import qualified NITTA.Intermediate.Functions as F import NITTA.Intermediate.Types import NITTA.Model.Networks.Types import NITTA.Model.Problems import NITTA.Model.ProcessorUnits -import NITTA.Model.Tests.Internals +import NITTA.Model.ProcessorUnits.Tests.Providers import NITTA.Model.Tests.Providers import NITTA.Synthesis import Test.Tasty (TestTree, testGroup) @@ -45,15 +43,20 @@ import Test.Tasty.TH -- FIXME: avoid NITTA.Model.Tests.Internals usage test_fibonacci = - [ algTestCase - "simple" - march - [ F.loop 0 "b2" ["a1"] - , F.loop 1 "c" ["b1", "b2"] - , F.add "a1" "b1" ["c"] - ] - , algTestCase "io_drop_data" (marchSPIDropData "spi" True pInt) algWithSend - , algTestCase "io_no_drop_data" (marchSPI "spi" True pInt) algWithSend + [ unitTestCase "simple" ts $ do + setNetwork march + assignFunction $ F.loop (0 :: Int) "b2" ["a1"] + assignFunction $ F.loop (1 :: Int) "c" ["b1", "b2"] + assignFunction $ F.add "a1" "b1" ["c"] + assertSynthesisDoneAuto + , unitTestCase "io_drop_data" ts $ do + setNetwork $ marchSPIDropData True pInt + assignFunctions algWithSend + assertSynthesisDoneAuto + , unitTestCase "io_no_drop_data" ts $ do + setNetwork $ marchSPI True pInt + assignFunctions algWithSend + assertSynthesisDoneAuto ] where algWithSend = @@ -64,28 +67,29 @@ test_fibonacci = ] test_add_and_io = - [ testCase "receive 4 variables" $ - void $ - runTargetSynthesisWithUniqName - (def :: TargetSynthesis _ _ _ Int) - { tName = "receive_4_variables" - , tMicroArch = marchSPI "spi" True pInt - , tReceivedValues = [("a", [10 .. 15]), ("b", [20 .. 25]), ("e", [0 .. 25]), ("f", [20 .. 30])] - , tDFG = - fsToDataFlowGraph - [ F.receive ["a"] - , F.receive ["b"] - , F.receive ["e"] - , F.receive ["f"] - , F.accFromStr "+a +b = c = d; +e - f = g = h" - , F.send "d" - , F.send "c" - , F.send "g" - , F.send "h" - ] - } + [ unitTestCase "receive 4 variables" ts $ do + setNetwork $ marchSPI True pInt + assignFunctions + [ F.receive ["a"] + , F.receive ["b"] + , F.receive ["e"] + , F.receive ["f"] + , F.accFromStr "+a +b = c = d; +e - f = g = h" + , F.send "d" + , F.send "c" + , F.send "g" + , F.send "h" + ] + setRecievedValues + [ ("a", [10 .. 15]) + , ("b", [20 .. 25]) + , ("e", [0 .. 25]) + , ("f", [20 .. 30]) + ] + assertSynthesisDoneAuto ] +ts = def :: TargetSynthesis _ _ _ _ f1 = F.add "a" "b" ["c", "d"] :: F T.Text Int patchP :: (Patch a (T.Text, T.Text)) => (T.Text, T.Text) -> a -> a From 0345bd729080e69393d8eb195843f38edb68f28f Mon Sep 17 00:00:00 2001 From: Aleksandr Penskoi Date: Sat, 9 Oct 2021 23:43:50 +0300 Subject: [PATCH 2/3] Rework test DSL based on TargetSynthesis onto TargetSystem. Including: - refactoring for test DSL - Refactors scheduling for process --- nitta.cabal | 1 - src/NITTA/Intermediate/DataFlow.hs | 4 + src/NITTA/Model/Networks/Bus.hs | 48 +- src/NITTA/Model/Problems/Bind.hs | 2 +- src/NITTA/Model/Problems/Dataflow.hs | 5 + src/NITTA/Model/Problems/Endpoint.hs | 6 +- src/NITTA/Model/ProcessorUnits/Fram.hs | 6 +- src/NITTA/Model/ProcessorUnits/Types.hs | 9 +- src/NITTA/Model/TargetSystem.hs | 13 + src/NITTA/Synthesis.hs | 5 + src/NITTA/Synthesis/ConstantFolding.hs | 3 +- src/NITTA/Synthesis/OptimizeAccum.hs | 3 +- src/NITTA/UIBackend/Timeline.hs | 1 + src/NITTA/Utils.hs | 6 - src/NITTA/Utils/ProcessDescription.hs | 10 +- test/NITTA/LuaFrontend/Tests.hs | 19 +- test/NITTA/LuaFrontend/Tests/Providers.hs | 9 +- .../NITTA/Model/ProcessorUnits/Accum/Tests.hs | 79 +- .../Model/ProcessorUnits/Broken/Tests.hs | 4 +- .../Model/ProcessorUnits/Divider/Tests.hs | 10 +- test/NITTA/Model/ProcessorUnits/Fram/Tests.hs | 4 +- .../Model/ProcessorUnits/IO/SPI/Tests.hs | 6 +- .../Model/ProcessorUnits/Multiplier/Tests.hs | 4 +- test/NITTA/Model/ProcessorUnits/Tests/DSL.hs | 701 ++++++++---------- .../Model/ProcessorUnits/Tests/DSL/Tests.hs | 187 +++-- .../Model/ProcessorUnits/Tests/Providers.hs | 4 +- test/NITTA/Model/Tests/Internals.hs | 5 - test/NITTA/Model/Tests/Microarchitecture.hs | 6 +- test/NITTA/Tests.hs | 91 ++- 29 files changed, 659 insertions(+), 592 deletions(-) diff --git a/nitta.cabal b/nitta.cabal index ed0656f29..cc5628ce5 100644 --- a/nitta.cabal +++ b/nitta.cabal @@ -237,7 +237,6 @@ test-suite nitta-test NITTA.Model.ProcessorUnits.Shift.Tests NITTA.Model.ProcessorUnits.Tests.DSL NITTA.Model.ProcessorUnits.Tests.DSL.Tests - NITTA.Model.ProcessorUnits.Tests.OptimisationInclude NITTA.Model.ProcessorUnits.Tests.Providers NITTA.Model.ProcessorUnits.Tests.Utils NITTA.Model.Tests.Internals diff --git a/src/NITTA/Intermediate/DataFlow.hs b/src/NITTA/Intermediate/DataFlow.hs index 9539da7cc..fc9c3e728 100644 --- a/src/NITTA/Intermediate/DataFlow.hs +++ b/src/NITTA/Intermediate/DataFlow.hs @@ -21,6 +21,7 @@ module NITTA.Intermediate.DataFlow ( addFuncToDataFlowGraph, ) where +import Data.Default import qualified Data.List as L import qualified Data.Set as S import GHC.Generics @@ -37,6 +38,9 @@ data DataFlowGraph v x | DFCluster [DataFlowGraph v x] deriving (Show, Generic) +instance Default (DataFlowGraph v x) where + def = DFCluster [] + instance Eq (DataFlowGraph v x) where -- `show` used for avoid `Ord (DataFlowGraph v x)` (DFCluster c1) == (DFCluster c2) = S.fromList (map show c1) == S.fromList (map show c2) diff --git a/src/NITTA/Model/Networks/Bus.hs b/src/NITTA/Model/Networks/Bus.hs index 8cd3eb961..0831eeb3e 100644 --- a/src/NITTA/Model/Networks/Bus.hs +++ b/src/NITTA/Model/Networks/Bus.hs @@ -39,6 +39,7 @@ import qualified Data.List as L import qualified Data.Map.Strict as M import Data.Maybe import qualified Data.Set as S +import Data.String import Data.String.Interpolate import Data.String.ToString import qualified Data.Text as T @@ -86,6 +87,9 @@ busNetwork name iosync = , bnEnv = def } +instance (Default t, IsString tag) => Default (BusNetwork tag v x t) where + def = busNetwork "defaultBus" ASync + instance (Var v) => Variables (BusNetwork tag v x t) v where variables BusNetwork{bnBinded} = unionsMap variables $ concat $ M.elems bnBinded @@ -305,17 +309,25 @@ instance (UnitTag tag, VarValTime v x t) => BreakLoopProblem (BusNetwork tag v x , bnBinded = M.insert puTag bindedToPU' bnBinded } -instance (VarValTime v x t) => OptimizeAccumProblem (BusNetwork tag v x t) v x where +instance (UnitTag tag, VarValTime v x t) => OptimizeAccumProblem (BusNetwork tag v x t) v x where optimizeAccumOptions BusNetwork{bnRemains} = optimizeAccumOptions bnRemains - optimizeAccumDecision bn@BusNetwork{bnRemains} oa@OptimizeAccum{} = - bn{bnRemains = optimizeAccumDecision bnRemains oa} + optimizeAccumDecision bn@BusNetwork{bnRemains, bnProcess} oa@OptimizeAccum{} = + bn + { bnRemains = optimizeAccumDecision bnRemains oa + , bnProcess = execScheduleWithProcess bn bnProcess $ do + scheduleRefactoring (I.singleton $ nextTick bn) oa + } -instance (VarValTime v x t) => ConstantFoldingProblem (BusNetwork tag v x t) v x where +instance (UnitTag tag, VarValTime v x t) => ConstantFoldingProblem (BusNetwork tag v x t) v x where constantFoldingOptions BusNetwork{bnRemains} = constantFoldingOptions bnRemains - constantFoldingDecision bn@BusNetwork{bnRemains} cf@ConstantFolding{} = - bn{bnRemains = constantFoldingDecision bnRemains cf} + constantFoldingDecision bn@BusNetwork{bnRemains, bnProcess} cf@ConstantFolding{} = + bn + { bnRemains = constantFoldingDecision bnRemains cf + , bnProcess = execScheduleWithProcess bn bnProcess $ do + scheduleRefactoring (I.singleton $ nextTick bn) cf + } instance (UnitTag tag, VarValTime v x t) => ResolveDeadlockProblem (BusNetwork tag v x t) v x where resolveDeadlockOptions bn@BusNetwork{bnPus, bnBinded} = @@ -371,16 +383,20 @@ instance (UnitTag tag, VarValTime v x t) => ResolveDeadlockProblem (BusNetwork t maybeSended = M.keysSet var2endpointRole - resolveDeadlockDecision bn@BusNetwork{bnRemains, bnBinded, bnPus} ResolveDeadlock{newBuffer, changeset} = - let Just (tag, _) = - L.find - (\(_, f) -> not $ null $ S.intersection (outputs newBuffer) $ unionsMap outputs f) - $ M.assocs bnBinded - in bn - { bnRemains = newBuffer : patch changeset bnRemains - , bnPus = M.adjust (patch changeset) tag bnPus - , bnBinded = M.map (patch changeset) bnBinded - } + resolveDeadlockDecision + bn@BusNetwork{bnRemains, bnBinded, bnPus, bnProcess} + ref@ResolveDeadlock{newBuffer, changeset} = + let Just (tag, _) = + L.find + (\(_, f) -> not $ null $ S.intersection (outputs newBuffer) $ unionsMap outputs f) + $ M.assocs bnBinded + in bn + { bnRemains = newBuffer : patch changeset bnRemains + , bnPus = M.adjust (patch changeset) tag bnPus + , bnBinded = M.map (patch changeset) bnBinded + , bnProcess = execScheduleWithProcess bn bnProcess $ do + scheduleRefactoring (I.singleton $ nextTick bn) ref + } -------------------------------------------------------------------------- diff --git a/src/NITTA/Model/Problems/Bind.hs b/src/NITTA/Model/Problems/Bind.hs index 9e392a8d2..dbb2c89fa 100644 --- a/src/NITTA/Model/Problems/Bind.hs +++ b/src/NITTA/Model/Problems/Bind.hs @@ -24,7 +24,7 @@ import NITTA.Intermediate.Types data Bind tag v x = Bind (F v x) tag - deriving (Generic) + deriving (Generic, Eq) instance (ToString tag) => Show (Bind tag v x) where show (Bind f tag) = "Bind " <> show f <> " " <> toString tag diff --git a/src/NITTA/Model/Problems/Dataflow.hs b/src/NITTA/Model/Problems/Dataflow.hs index 3a94f7756..62e05b1ec 100644 --- a/src/NITTA/Model/Problems/Dataflow.hs +++ b/src/NITTA/Model/Problems/Dataflow.hs @@ -24,8 +24,10 @@ module NITTA.Model.Problems.Dataflow ( import Data.Bifunctor import Data.String.ToString import GHC.Generics +import NITTA.Intermediate.Variable import NITTA.Model.Problems.Endpoint import NITTA.Model.Time +import NITTA.Utils import Numeric.Interval.NonEmpty {- |Dataflow option (@tp ~ TimeConstraint t@) or decision (@tp Z Interval t@) @@ -47,6 +49,9 @@ instance (ToString tag, Show (EndpointSt v tp)) => Show (DataflowSt tag v tp) wh where show' (tag, ep) = "(" <> toString tag <> ", " <> show ep <> ")" +instance (Ord v) => Variables (DataflowSt tag v tp) v where + variables DataflowSt{dfTargets} = unionsMap (variables . snd) dfTargets + {- |Implemented for any things, which can send data between processor units over the network. -} diff --git a/src/NITTA/Model/Problems/Endpoint.hs b/src/NITTA/Model/Problems/Endpoint.hs index 4c93ffffa..f46f7a61c 100644 --- a/src/NITTA/Model/Problems/Endpoint.hs +++ b/src/NITTA/Model/Problems/Endpoint.hs @@ -51,9 +51,9 @@ data EndpointSt v tp = EndpointSt instance Variables (EndpointSt v t) v where variables EndpointSt{epRole} = variables epRole -instance (Var v, Time t) => Show (EndpointSt v (TimeConstraint t)) where +instance (ToString v, Time t) => Show (EndpointSt v (TimeConstraint t)) where show EndpointSt{epRole, epAt} = "?" <> show epRole <> "@(" <> show epAt <> ")" -instance (Var v, Time t) => Show (EndpointSt v (Interval t)) where +instance (ToString v, Time t) => Show (EndpointSt v (Interval t)) where show EndpointSt{epRole, epAt} = "!" <> show epRole <> "@(" <> show epAt <> ")" instance (Ord v) => Patch (EndpointSt v tp) (Changeset v) where @@ -81,7 +81,7 @@ data EndpointRole v Target v deriving (Eq, Ord, Generic) -instance (Var v) => Show (EndpointRole v) where +instance (ToString v) => Show (EndpointRole v) where show (Source vs) = "Source " <> S.join "," (vsToStringList vs) show (Target v) = "Target " <> toString v diff --git a/src/NITTA/Model/ProcessorUnits/Fram.hs b/src/NITTA/Model/ProcessorUnits/Fram.hs index f0b4da96a..49a03c4fe 100644 --- a/src/NITTA/Model/ProcessorUnits/Fram.hs +++ b/src/NITTA/Model/ProcessorUnits/Fram.hs @@ -46,7 +46,7 @@ import NITTA.Model.Time import NITTA.Project import NITTA.Utils import NITTA.Utils.ProcessDescription -import Numeric.Interval.NonEmpty (inf, sup, (...)) +import Numeric.Interval.NonEmpty (inf, singleton, sup, (...)) import Prettyprinter data Fram v x t = Fram @@ -275,7 +275,9 @@ instance (VarValTime v x t) => BreakLoopProblem (Fram v x t) v x where revoke <- scheduleFunctionRevoke $ recLoop bl f1 <- scheduleFunctionBind $ recLoopOut bl f2 <- scheduleFunctionBind $ recLoopIn bl - establishVerticalRelations binds (f1 ++ f2 ++ revoke) + ref <- scheduleRefactoring (singleton $ nextTick fram) bl + establishVerticalRelations ref (f1 ++ f2 ++ revoke) + establishVerticalRelations binds ref return (f1, f2) iJob = (defJob $ recLoopOut bl){binds = iPid, startAt = Just 0} oJob = (defJob $ recLoopIn bl){binds = oPid} diff --git a/src/NITTA/Model/ProcessorUnits/Types.hs b/src/NITTA/Model/ProcessorUnits/Types.hs index 1b1a128c8..fa3c5878c 100644 --- a/src/NITTA/Model/ProcessorUnits/Types.hs +++ b/src/NITTA/Model/ProcessorUnits/Types.hs @@ -38,6 +38,7 @@ module NITTA.Model.ProcessorUnits.Types ( whatsHappen, extractInstructionAt, withShift, + isRefactorStep, -- *Control Controllable (..), @@ -185,7 +186,9 @@ instance (Ord v) => Patch (Step t (StepInfo v x t)) (Changeset v) where data StepInfo v x t where -- |CAD level step CADStep :: String -> StepInfo v x t - -- |intermidiate level step (funcution execution) + -- |Apply refactoring + RefactorStep :: (Typeable ref, Show ref, Eq ref) => ref -> StepInfo v x t + -- |intermidiate level step (function execution) FStep :: F v x -> StepInfo v x t -- |endpoint level step (source or target) EndpointRoleStep :: EndpointRole v -> StepInfo v x t @@ -200,8 +203,12 @@ data StepInfo v x t where descent (NestedStep _ step) = descent $ pDesc step descent desc = desc +isRefactorStep RefactorStep{} = True +isRefactorStep _ = False + instance (Var v, Show (Step t (StepInfo v x t))) => Show (StepInfo v x t) where show (CADStep msg) = "CAD: " <> msg + show (RefactorStep ref) = "Refactor: " <> show ref show (FStep F{fun}) = "Intermediate: " <> show fun show (EndpointRoleStep eff) = "Endpoint: " <> show eff show (InstructionStep instr) = "Instruction: " <> show instr diff --git a/src/NITTA/Model/TargetSystem.hs b/src/NITTA/Model/TargetSystem.hs index 1af24ea71..c2a0b556b 100644 --- a/src/NITTA/Model/TargetSystem.hs +++ b/src/NITTA/Model/TargetSystem.hs @@ -21,6 +21,7 @@ module NITTA.Model.TargetSystem ( ) where import Control.Exception (assert) +import Data.Default import qualified Data.Set as S import GHC.Generics import NITTA.Intermediate.DataFlow @@ -40,6 +41,9 @@ data TargetSystem u tag v x t = TargetSystem } deriving (Generic) +instance (Default u) => Default (TargetSystem u tag v x t) where + def = TargetSystem def def + instance (WithFunctions u (F v x)) => WithFunctions (TargetSystem u tag v x t) (F v x) where functions TargetSystem{mUnit, mDataFlowGraph} = assert (S.fromList (functions mUnit) == S.fromList (functions mDataFlowGraph)) $ -- inconsistent TargetSystem @@ -51,6 +55,15 @@ isSynthesisComplete :: (ProcessorUnit u v x t) => TargetSystem u tag v x t -> Bo isSynthesisComplete TargetSystem{mUnit, mDataFlowGraph} = transferred mUnit == variables mDataFlowGraph +instance + ( VarValTime v x t + , ProcessorUnit u v x t + ) => + ProcessorUnit (TargetSystem u tag v x t) v x t + where + tryBind f ts@TargetSystem{mUnit} = (\u -> ts{mUnit = u}) <$> tryBind f mUnit + process TargetSystem{mUnit} = process mUnit + instance (BindProblem u tag v x) => BindProblem (TargetSystem u tag v x t) tag v x where bindOptions TargetSystem{mUnit} = bindOptions mUnit diff --git a/src/NITTA/Synthesis.hs b/src/NITTA/Synthesis.hs index 6a7c6bde6..59b89c4a2 100644 --- a/src/NITTA/Synthesis.hs +++ b/src/NITTA/Synthesis.hs @@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} {- | @@ -153,6 +154,10 @@ instance (UnitTag tag, VarValTime v x t) => Default (TargetSynthesis tag v x t) , tSimulationCycleN = 5 } +instance (UnitTag tag, VarValTime v x t) => ProcessorUnit (TargetSynthesis tag v x t) v x t where + tryBind _ _ = error "Not Implemented" + process TargetSynthesis{tMicroArch} = process tMicroArch + runTargetSynthesis leaf = do prj <- synthesizeTargetSystem leaf traverse runTestbench prj diff --git a/src/NITTA/Synthesis/ConstantFolding.hs b/src/NITTA/Synthesis/ConstantFolding.hs index 8bae907ce..2d9fb1e2d 100644 --- a/src/NITTA/Synthesis/ConstantFolding.hs +++ b/src/NITTA/Synthesis/ConstantFolding.hs @@ -24,6 +24,7 @@ import Data.Aeson (ToJSON) import GHC.Generics import NITTA.Model.Networks.Bus import NITTA.Model.Problems.Refactor +import NITTA.Model.ProcessorUnits.Types import NITTA.Model.TargetSystem import NITTA.Model.Time import NITTA.Synthesis.Types @@ -34,7 +35,7 @@ data ConstantFoldingMetrics = ConstantFoldingMetrics instance ToJSON ConstantFoldingMetrics instance - (VarValTime v x t) => + (UnitTag tag, VarValTime v x t) => SynthesisDecisionCls (SynthesisState (TargetSystem (BusNetwork tag v x t) tag v x t) tag v x t) (TargetSystem (BusNetwork tag v x t) tag v x t) diff --git a/src/NITTA/Synthesis/OptimizeAccum.hs b/src/NITTA/Synthesis/OptimizeAccum.hs index b868a37a8..b8b7a5bed 100644 --- a/src/NITTA/Synthesis/OptimizeAccum.hs +++ b/src/NITTA/Synthesis/OptimizeAccum.hs @@ -24,6 +24,7 @@ import Data.Aeson (ToJSON) import GHC.Generics import NITTA.Model.Networks.Bus import NITTA.Model.Problems.Refactor +import NITTA.Model.ProcessorUnits.Types import NITTA.Model.TargetSystem import NITTA.Model.Time import NITTA.Synthesis.Types @@ -34,7 +35,7 @@ data OptimizeAccumMetrics = OptimizeAccumMetrics instance ToJSON OptimizeAccumMetrics instance - (VarValTime v x t) => + (UnitTag tag, VarValTime v x t) => SynthesisDecisionCls (SynthesisState (TargetSystem (BusNetwork tag v x t) tag v x t) tag v x t) (TargetSystem (BusNetwork tag v x t) tag v x t) diff --git a/src/NITTA/UIBackend/Timeline.hs b/src/NITTA/UIBackend/Timeline.hs index 17e76de62..09a68f43f 100644 --- a/src/NITTA/UIBackend/Timeline.hs +++ b/src/NITTA/UIBackend/Timeline.hs @@ -98,6 +98,7 @@ processTimelines Process{steps, relations} = } viewpoint FStep{} = ViewPointID{level = "Fun", component = []} +viewpoint RefactorStep{} = ViewPointID{level = "Ref", component = []} viewpoint CADStep{} = ViewPointID{level = "CAD", component = []} viewpoint EndpointRoleStep{} = ViewPointID{level = "EndPoint", component = []} viewpoint InstructionStep{} = ViewPointID{level = "INST", component = []} diff --git a/src/NITTA/Utils.hs b/src/NITTA/Utils.hs index 56049711c..9bca3d63f 100644 --- a/src/NITTA/Utils.hs +++ b/src/NITTA/Utils.hs @@ -36,7 +36,6 @@ module NITTA.Utils ( relatedEndpoints, isFB, getFBs, - getCADs, isInstruction, module NITTA.Utils.Base, @@ -122,11 +121,6 @@ getFB _ = Nothing getFBs p = mapMaybe getFB $ sortOn stepStart $ steps p -getCADs p = mapMaybe getCAD $ steps p - -getCAD Step{pDesc} | CADStep fb <- descent pDesc = Just fb -getCAD _ = Nothing - getEndpoint Step{pDesc} | EndpointRoleStep role <- descent pDesc = Just role getEndpoint _ = Nothing diff --git a/src/NITTA/Utils/ProcessDescription.hs b/src/NITTA/Utils/ProcessDescription.hs index 04f2c708d..eeaeaff5b 100644 --- a/src/NITTA/Utils/ProcessDescription.hs +++ b/src/NITTA/Utils/ProcessDescription.hs @@ -27,6 +27,7 @@ module NITTA.Utils.ProcessDescription ( scheduleFunctionBind, scheduleFunctionRevoke, scheduleFunction, + scheduleRefactoring, scheduleInstructionUnsafe, scheduleInstructionUnsafe_, scheduleNestedStep, @@ -60,8 +61,11 @@ from the PU by the 'process' function. -} execSchedule pu st = snd $ runSchedule pu st -{- |Execute process builder and return new process description. The initial process state is passed -explicetly. +{- |Execute process builder and return new process description. The initial +process state is passed explicetly. + +Why can not we get a process here? In the case of Bus Network, it also fetches +processes from underlying units. -} execScheduleWithProcess pu p st = snd $ runScheduleWithProcess pu p st @@ -137,6 +141,8 @@ scheduleFunctionRevoke f = do -- |Add to the process description information about function evaluation. scheduleFunction ti f = scheduleStep ti $ FStep f +scheduleRefactoring ti ref = scheduleStep ti $ RefactorStep ref + {- |Add to the process description information about endpoint behaviour, and it's low-level implementation (on instruction level). Vertical relations connect endpoint level and instruction level steps. diff --git a/test/NITTA/LuaFrontend/Tests.hs b/test/NITTA/LuaFrontend/Tests.hs index 7e0b47f3a..b26feaaab 100644 --- a/test/NITTA/LuaFrontend/Tests.hs +++ b/test/NITTA/LuaFrontend/Tests.hs @@ -23,23 +23,18 @@ module NITTA.LuaFrontend.Tests ( tests, ) where -import Control.Exception (ErrorCall, catch) -import Data.Default -import Data.FileEmbed (embedStringFile) -import Data.String.Interpolate -import qualified Data.Text as T import Control.Monad.State +import Data.Default import Data.FileEmbed (embedStringFile) import qualified Data.HashMap.Strict as HM import Data.String.Interpolate -import Data.Text as T +import qualified Data.Text as T import qualified Language.Lua as Lua -import NITTA.Intermediate.Functions +import qualified NITTA.Intermediate.Functions as F import NITTA.Intermediate.Types import NITTA.LuaFrontend import NITTA.LuaFrontend.Tests.Providers import NITTA.Model.ProcessorUnits.Tests.Providers -import NITTA.Synthesis (TargetSynthesis) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit import Test.Tasty.TH @@ -233,7 +228,7 @@ case_lua_negative_operator = sum(0) |] dfg = - [ neg "a^0#0" ["b^0#0"] :: F T.Text Int + [ F.neg "a^0#0" ["b^0#0"] :: F T.Text Int , loop 0 "b^0#0" ["a^0#0"] ] in functions (frDataFlow $ lua2functions src) @?= dfg @@ -579,11 +574,11 @@ test_trace_features = ] test_examples = - [ unitTestCase "teacup io wait" ts $ do + [ unitTestCase "teacup io wait" def $ do setNetwork $ microarch Sync SlaveSPI setBusType pFX22_32 assignLua $(embedStringFile "examples/teacup.lua") - assertSynthesisDoneAuto + synthesizeAndCoSim , typedLuaTestCase (microarch ASync SlaveSPI) pFX22_32 @@ -705,7 +700,5 @@ test_examples = $(embedStringFile "examples/spi3.lua") ] -ts = def :: Val x => TargetSynthesis T.Text T.Text x Int - tests :: TestTree tests = $(testGroupGenerator) diff --git a/test/NITTA/LuaFrontend/Tests/Providers.hs b/test/NITTA/LuaFrontend/Tests/Providers.hs index d6d998e14..7d28b3e72 100644 --- a/test/NITTA/LuaFrontend/Tests/Providers.hs +++ b/test/NITTA/LuaFrontend/Tests/Providers.hs @@ -36,7 +36,6 @@ import NITTA.Model.Networks.Bus import NITTA.Model.Networks.Types import NITTA.Model.ProcessorUnits.Tests.Providers import NITTA.Model.Tests.Microarchitecture -import NITTA.Synthesis import Test.Tasty (TestTree) import Test.Tasty.HUnit @@ -75,11 +74,9 @@ typedIOLuaTestCase :: [(T.Text, [x])] -> T.Text -> TestTree -typedIOLuaTestCase arch proxy name received src = unitTestCase name ts $ do +typedIOLuaTestCase arch proxy name received src = unitTestCase name def $ do setNetwork arch setBusType proxy - setRecievedValues received + setReceivedValues received assignLua src - assertSynthesisDoneAuto - -ts = def :: Val x => TargetSynthesis T.Text T.Text x Int + synthesizeAndCoSim diff --git a/test/NITTA/Model/ProcessorUnits/Accum/Tests.hs b/test/NITTA/Model/ProcessorUnits/Accum/Tests.hs index 2efb39eef..61adc2058 100644 --- a/test/NITTA/Model/ProcessorUnits/Accum/Tests.hs +++ b/test/NITTA/Model/ProcessorUnits/Accum/Tests.hs @@ -24,8 +24,8 @@ import qualified Data.Text as T import qualified NITTA.Intermediate.Functions as F import NITTA.LuaFrontend.Tests.Providers import NITTA.Model.ProcessorUnits.Tests.Providers +import NITTA.Model.TargetSystem () import NITTA.Model.Tests.Providers -import NITTA.Synthesis import Test.QuickCheck import Test.Tasty (testGroup) @@ -58,7 +58,7 @@ tests = , accFromStr "+a + b + c = d; +e + f -g -h = i; -j + k = l = m" ] , nittaCoSimTestCase - "many_simul_outputs_grouped" + "many grouped output 1" march [ loop 1 "d" ["a"] , loop 1 "e" ["b"] @@ -71,7 +71,7 @@ tests = ] ] , nittaCoSimTestCase - "many_simul_outputs_not_grouped" + "many output not grouped" march [ loop 1 "d" ["a"] , loop 1 "e" ["b"] @@ -93,7 +93,7 @@ tests = ] , puCoSimTestCase "add with overflow" - u2 + u8bit [("a", 100), ("b", 100)] [ accFromStr "+a +b = c;" ] @@ -127,52 +127,7 @@ tests = [("a", 1), ("b", 2), ("e", 4), ("f", -4), ("j", 8)] [ accFromStr "+a +b = c = d; +e -f = g; +j = k" ] - , unitTestCase "test_accum_optimization_and_deadlock_resolve" ts2 $ do - -- TODO: We need to check that synthesis process do all needed refactoring - setNetwork $ microarch ASync SlaveSPI - setBusType pAttrIntX32 - assignLua luaTemplate - assertSynthesisRunAuto - traceDataflow - traceBus - , unitTestCase "negative optimisation test" tbr $ do - setNetwork $ maBroken ubr{wrongAttr = True} - setBusType pAttrIntX32 - assignLua luaTemplate - traceDataflow - traceTransferOptions - , unitTestCase "bus network detailed test" tbr $ do - setNetwork $ maBroken ubr - setBusType pAttrIntX32 - assignLua luaTemplate - bindInit - let loopDA = F.loop 0 "d#0" ["a#0"] - loopEC = F.loop 0 "e#0" ["c#0"] - loopFB = F.loop 0 "f#0" ["b#0"] - bindVariables [loopDA, loopEC, loopFB] - bindVariable (F.constant 1 ["1@const#0"]) - bindVariable (F.constant 2 ["2@const#0"]) - traceBindVariables - -- TODO: Does it bind both? - bindVariable (F.add "d#1" "2@const#0" ["f#0"]) - traceBindVariables - -- works both variants - --transferVariables $ provide ["2@const#0"] - bindVariable (F.add "d#2" "1@const#0" ["e#0"]) - bindVariable (F.add "a#0" "b#0" ["tmp_0#0"]) - bindVariable (F.add "tmp_0#0" "c#0" ["d#0", "d#1", "d#2"]) - transferVariables $ consume "2@const#0" - traceAvailableRefactor - applyBreakLoops [loopDA, loopEC, loopFB] - assertLoopBroken [loopDA, loopEC, loopFB] - , unitTestCase "transfer variable test" tbr $ do - setNetwork $ microarch ASync SlaveSPI - setBusType pAttrIntX32 - assignLua luaTemplate - assertSynthesisRunAuto - traceDataflow - traceBus - , unitTestCase "fixpoint 22 32" ts $ do + , unitTestCase "fixpoint 22 32" def $ do setNetwork $ microarch ASync SlaveSPI setBusType pFX22_32 assignLua @@ -183,7 +138,7 @@ tests = end f() |] - assertSynthesisDoneAuto + synthesizeAndCoSim , typedLuaTestCase (microarch ASync SlaveSPI) pFX22_32 @@ -274,7 +229,7 @@ tests = decideAt 9 9 $ provide ["f"] assertSynthesisDone - assertCoSimulation + assertPUCoSimulation , unitTestCase "accum detail two function test" accumDef $ do assign $ add "a" "b" ["c"] setValue "a" 2 @@ -331,7 +286,7 @@ tests = assertEndpoint 9 maxBound $ provide ["f"] decideAt 9 9 $ provide ["f"] - assertCoSimulation + assertPUCoSimulation assertSynthesisDone , unitTestCase "accum neg test" accumDef $ do assign $ F.neg "a" ["c"] @@ -346,23 +301,9 @@ tests = decideAt 3 3 $ provide ["c"] assertLocks [] - assertCoSimulation + assertPUCoSimulation ] where - ts = def :: Val x => TargetSynthesis T.Text T.Text x Int - ts2 = def :: Val x => TargetSynthesis T.Text T.Text x Int - tbr = def :: Val x => TargetSynthesis T.Text T.Text x Int - ubr = def :: Broken T.Text (Attr (IntX 32)) Int accumDef = def :: Accum T.Text Int Int - u2 = def :: Accum T.Text (Attr (IntX 8)) Int + u8bit = def :: Accum T.Text (Attr (IntX 8)) Int fsGen = algGen [packF <$> (arbitrary :: Gen (Acc _ _))] - luaTemplate = - [__i| - function sum(a, b, c) - local d = a + b + c -- should AccumOptimization - local e = d + 1 -- e and d should be buffered - local f = d + 2 - sum(d, f, e) - end - sum(0,0,0) - |] diff --git a/test/NITTA/Model/ProcessorUnits/Broken/Tests.hs b/test/NITTA/Model/ProcessorUnits/Broken/Tests.hs index d52cee74a..628212c55 100644 --- a/test/NITTA/Model/ProcessorUnits/Broken/Tests.hs +++ b/test/NITTA/Model/ProcessorUnits/Broken/Tests.hs @@ -46,7 +46,7 @@ tests = decideAt 3 3 $ provide ["b"] assertEndpoint 4 maxBound $ provide ["c"] decideAt 4 4 $ provide ["c"] - assertCoSimulation + assertPUCoSimulation , unitTestCase "two job unit test" u $ do assign $ brokenBuffer "a" ["b"] setValue "a" 64 @@ -60,7 +60,7 @@ tests = decideAt 4 4 $ consume "d" assertEndpoint 7 maxBound $ provide ["e"] decideAt 7 7 $ provide ["e"] - assertCoSimulation + assertPUCoSimulation , puCoSimTestCase "broken buffer" u [("a", 42)] [brokenBuffer "a" ["b"]] , puCoSimProp "puCoSimProp" u fsGen , nittaCoSimTestCase "nittaCoSimTestCase" (maBroken u) alg diff --git a/test/NITTA/Model/ProcessorUnits/Divider/Tests.hs b/test/NITTA/Model/ProcessorUnits/Divider/Tests.hs index 6b31fa426..61ad584c7 100644 --- a/test/NITTA/Model/ProcessorUnits/Divider/Tests.hs +++ b/test/NITTA/Model/ProcessorUnits/Divider/Tests.hs @@ -50,7 +50,7 @@ tests = assertEndpoint 7 maxBound $ provide ["c"] decideAt 7 7 $ provide ["c"] decideAt 8 8 $ provide ["d"] - assertCoSimulation + assertPUCoSimulation , unitTestCase "division only mod" u2 $ do assign $ division "a" "b" ["c"] [] setValue "a" 64 @@ -58,7 +58,7 @@ tests = decideAt 1 1 $ consume "a" decideAt 2 2 $ consume "b" decideAt 8 8 $ provide ["c"] - assertCoSimulation + assertPUCoSimulation , unitTestCase "division only rem" u2 $ do assign $ division "a" "b" [] ["d"] setValue "a" 64 @@ -66,7 +66,7 @@ tests = decideAt 1 1 $ consume "a" decideAt 2 2 $ consume "b" decideAt 11 11 $ provide ["d"] - assertCoSimulation + assertPUCoSimulation , unitTestCase "division success pipeline" u2 $ do assign $ division "a" "b" ["c"] [] assign $ division "e" "f" ["g"] [] @@ -77,7 +77,7 @@ tests = decideAt 4 4 $ consume "f" decideAt 7 7 $ provide ["c"] decideAt 10 10 $ provide ["g"] - assertCoSimulation + assertPUCoSimulation , unitTestCase "division pipeline on last tick" u2 $ do assign $ division "a" "b" ["c"] [] assign $ division "e" "f" ["g"] [] @@ -113,7 +113,7 @@ tests = assertLocks [] assertEndpoint 11 maxBound $ provide ["g"] decideAt 13 13 $ provide ["g"] - assertCoSimulation + assertPUCoSimulation , expectFail $ unitTestCase "division pipeline after result corrupted" u2 $ do assign $ division "a" "b" ["c"] [] diff --git a/test/NITTA/Model/ProcessorUnits/Fram/Tests.hs b/test/NITTA/Model/ProcessorUnits/Fram/Tests.hs index 58ad12c11..dbab229e9 100644 --- a/test/NITTA/Model/ProcessorUnits/Fram/Tests.hs +++ b/test/NITTA/Model/ProcessorUnits/Fram/Tests.hs @@ -40,11 +40,11 @@ tests = , unitTestCase "test BreakLoop" u2 $ do assign $ loop 10 "b" ["a"] setValue "b" 64 - breakLoop 10 "b" ["a"] + refactor =<< mkBreakLoop 10 "b" ["a"] decideAt 1 1 $ provide ["a"] decideAt 2 2 $ consume "b" traceProcess - assertCoSimulation + assertPUCoSimulation , puCoSimTestCase "loop function" u diff --git a/test/NITTA/Model/ProcessorUnits/IO/SPI/Tests.hs b/test/NITTA/Model/ProcessorUnits/IO/SPI/Tests.hs index 5d3f94793..ffd95e5ad 100644 --- a/test/NITTA/Model/ProcessorUnits/IO/SPI/Tests.hs +++ b/test/NITTA/Model/ProcessorUnits/IO/SPI/Tests.hs @@ -31,7 +31,7 @@ import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit import Test.Tasty.TH --- FIXME: avoid NITTA.Model.Tests.Internals usage +-- TODO: https://github.com/ryukzak/nitta/issues/122 test_multiple_receives = [ testCase "receive two variables" $ @@ -39,7 +39,7 @@ test_multiple_receives = runTargetSynthesisWithUniqName (def :: TargetSynthesis _ _ _ Int) { tName = "receive_two_variables" - , tMicroArch = marchSPI "spi" True pInt + , tMicroArch = marchSPI True pInt , tReceivedValues = [("a", [10 .. 15]), ("b", [20 .. 25])] , tDFG = fsToDataFlowGraph @@ -54,7 +54,7 @@ test_multiple_receives = runTargetSynthesisWithUniqName (def :: TargetSynthesis _ _ _ Int) { tName = "receive_variable_two_times" - , tMicroArch = marchSPI "spi" True pInt + , tMicroArch = marchSPI True pInt , tReceivedValues = [("a", [10 .. 15]), ("b", [20 .. 25])] , tDFG = fsToDataFlowGraph diff --git a/test/NITTA/Model/ProcessorUnits/Multiplier/Tests.hs b/test/NITTA/Model/ProcessorUnits/Multiplier/Tests.hs index c27e967de..c78f5d867 100644 --- a/test/NITTA/Model/ProcessorUnits/Multiplier/Tests.hs +++ b/test/NITTA/Model/ProcessorUnits/Multiplier/Tests.hs @@ -98,7 +98,7 @@ tests = decideAt 4 4 $ provide ["c"] assertLocks [] - assertCoSimulation + assertPUCoSimulation , unitTestCase "multiplier coSim smoke test" u $ do assign $ multiply "a" "b" ["c", "d"] setValue "a" 2 @@ -106,7 +106,7 @@ tests = decide $ consume "a" decide $ consume "b" decide $ provide ["c", "d"] - assertCoSimulation + assertPUCoSimulation ] where u = multiplier True :: Multiplier T.Text Int Int diff --git a/test/NITTA/Model/ProcessorUnits/Tests/DSL.hs b/test/NITTA/Model/ProcessorUnits/Tests/DSL.hs index d7d9170bf..0c69f66e2 100644 --- a/test/NITTA/Model/ProcessorUnits/Tests/DSL.hs +++ b/test/NITTA/Model/ProcessorUnits/Tests/DSL.hs @@ -1,33 +1,30 @@ {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# OPTIONS_GHC -Wno-redundant-constraints #-} {- | Module : NITTA.Model.ProcessorUnits.Tests.DSL -Description : Provides functions to test PU, by making syntesis decisions -Copyright : (c) Artyom Kostyuchik, 2021 +Description : Provides functions to test PU, by making synthesis decisions +Copyright : (c) Artyom Kostyuchik, 2022 License : BSD3 Maintainer : aleksandr.penskoi@gmail.com Stability : experimental = Module description -DSL (domain-specific language) is a module for testing Processor Units (PU). +DSL (domain-specific language) is a module for testing Processor Units (PU) and +target systems. -= Algorithm - -1. Choose PU and provide it into unitTestCase. -2. Assign function to this PU. -3. Schedule computational process for every variable in function. -4. Assert (check) the resulting PU. - -= Example - -Test case (numbers to the right correspond to the algorithm steps): += Examples @ unitTestCase "multiplier smoke test" pu $ do -- 1. Created test case for provided PU @@ -51,126 +48,82 @@ unitTestCase "multiplier smoke test" pu $ do -- 1. Created test case for pro pu = multiplier True :: Multiplier String Int Int -- 1. Chose PU: Multiplier @ -= Algorithm steps description - -* You can use any PU which instantiated with 'NITTA.Model.ProcessorUnits.Types.ProcessorUnit' and 'NITTA.Model.Problems.Endpoint.EndpointProblem' type class - -* There are 4 functions for assign: - - * assign - binds function to PU right at the moment. - - * assigns - binds like 'assign', but uses a list of functions as an input. - - * assignNaive - store function in Test State and binds it only at naive synthesis. - Don't forget to call 'decideNaive' function. - - * assignsNaive - works like 'assignNaive', but uses a list of functions as an input. - -* You can bind variables from the function to PU: - - * for first you need to wrap variables: - - * consume - for input variable. - - * provide - for output variables. - - * For second, you can pass wrapped variables to 'decide' function and - schedule (make synthesis decisions) them. There 3 types of 'decide': - - * decide - bind variable at the next tick of PU (nearest). - - * decideAt - bind variable at provided moment. - - * decideNaiveSynthesis - runs naive synthesis (makes all available decisions). - Requires using 'assignNaive' function. - -* Assert function could be at any place in the test case. - For a positive test case it usually at the end. - -= CoSimulation: - -To run simulation use 'assertCoSimulation' function. -Don't forget to set initial input values with 'setValue' function. - -= Debug: - -For debugging use functions starting with trace*, e.g. 'tracePU'. +- 'NITTA.Tests.test_manual' -- Target system manual test. +- 'NITTA.Model.ProcessorUnits.Tests.DSL.Tests' -- many examples. -} module NITTA.Model.ProcessorUnits.Tests.DSL ( unitTestCase, + + -- * Process Unit Prepare assign, - assigns, assignNaive, - assignsNaive, setValue, setValues, - -- *Process Unit Control + -- * Process Unit Synthesis decide, decideAt, decideAtUnsafe, consume, provide, - breakLoop, decideNaiveSynthesis, - -- *Asserts + -- * Prepare target system + setBusType, + bind2network, + setReceivedValues, + setNetwork, + assignLua, + + -- * Synthesize target system + doBind, + doTransfer, + synthesis, + + -- * Refactors for PU and target system + assertRefactor, + refactorAvail, + refactor, + mkBreakLoop, + mkConstantFolding, + mkOptimizeAccum, + mkResolveDeadlock, + + -- * Asserts for PU and target system + assertAllEndpointRoles, assertBindFullness, - assertCoSimulation, - assertSynthesisDone, + assertPUCoSimulation, + assertTargetSystemCoSimulation, assertEndpoint, - assertAllEndpointRoles, assertLocks, + assertSynthesisDone, + synthesizeAndCoSim, + assertSynthesisComplete, - -- *Trace - tracePU, - traceFunctions, + -- * Trace (inspection for debug) + traceBind, + traceDataflow, traceEndpoints, + traceFunctions, + tracePU, traceProcess, - - -- *Target synthesis - setNetwork, - setBusType, - setRecievedValue, - setRecievedValues, - assignLua, - bindInit, - bindVariable, - bindVariables, - traceBindVariables, - traceDataflow, - traceTransferOptions, - traceAvailableRefactor, - traceBus, - assertSynthesisDoneAuto, - assertSynthesisRunAuto, - transferVariables, - transferVariablesAt, - getLoopFunctions, - applyBreakLoop, - applyBreakLoops, - assertLoopBroken, - assignFunction, - assignFunctions, - applyConstantFolding, - assertConstantFolded, - applyOptimizeAccum, - assertOptimizeAccum, + traceRefactor, ) where import Control.Monad.Identity import Control.Monad.State.Lazy import Data.CallStack -import Data.Either -import Data.List (find, isSubsequenceOf) -import Data.Maybe +import Data.Default +import Data.List (find) +import qualified Data.List as L import Data.Proxy import qualified Data.Set as S import Data.String.ToString import qualified Data.String.Utils as S import qualified Data.Text as T +import Data.Typeable import NITTA.Intermediate.DataFlow -import NITTA.Intermediate.Functions +import NITTA.Intermediate.Simulation import NITTA.Intermediate.Types import NITTA.LuaFrontend import NITTA.Model.Networks.Bus @@ -178,15 +131,48 @@ import NITTA.Model.Networks.Types (PUClasses) import NITTA.Model.Problems import NITTA.Model.ProcessorUnits import NITTA.Model.ProcessorUnits.Tests.Utils +import NITTA.Model.TargetSystem import NITTA.Model.Tests.Internals import NITTA.Project import NITTA.Synthesis import NITTA.Utils import Numeric.Interval.NonEmpty hiding (elem) import Prettyprinter (pretty) +import System.Directory +import System.FilePath import Test.Tasty (TestTree) import Test.Tasty.HUnit (assertBool, assertFailure, testCase) +{- |Unit test state. Be aware internal implementation is not fully consistent + and can be replaced by a type family with PU and target system instances. +-} +data UnitTestState u v x = UnitTestState + { testName :: String + , -- |Unit model, should be a process unit or target system. + unit :: u + , -- |Contains functions assigned to PU. + functs :: [F v x] + , -- |Initial values for coSimulation + cntxCycle :: [(v, x)] + , -- |Values for IO immitation + receivedValues :: [(v, [x])] + , busType :: Maybe (Proxy x) + , -- |Report on process unit test bench. + report :: Either String (TestbenchReport v x) + } + deriving (Show) + +type Statement u v x r = HasCallStack => StateT (UnitTestState u v x) IO r + +type PUStatement pu v x t r = + (ProcessorUnit pu v x t, EndpointProblem pu v t) => + StateT (UnitTestState pu v x) IO r + +type TSStatement x r = + forall tag v t. + (tag ~ T.Text, v ~ T.Text, t ~ Int, Val x) => + Statement (TargetSystem (BusNetwork tag v x t) tag v x t) v x r + unitTestCase :: HasCallStack => String -> @@ -196,26 +182,6 @@ unitTestCase :: unitTestCase name pu alg = testCase name $ do void $ evalUnitTestState name pu alg --- | State of the processor unit used in test -data UnitTestState pu v x = UnitTestState - { testName :: String - , -- | Processor unit model. - unit :: pu - , -- | Contains functions assigned to PU. - -- There two types of assign function: - -- 1. assign - binds to PU. - -- 2. assignNaive - will be binded during naive synthesis. - functs :: [F v x] - , -- | Initial values for coSimulation - cntxCycle :: [(v, x)] - , -- | TODO: add suitable type - busType :: Maybe (Proxy x) - , report :: Either String (TestbenchReport v x) - } - deriving (Show) - -type DSLStatement pu v x t r = (HasCallStack, ProcessorUnit pu v x t, EndpointProblem pu v t) => StateT (UnitTestState pu v x) IO r - evalUnitTestState name st alg = evalStateT alg @@ -224,40 +190,31 @@ evalUnitTestState name st alg = , unit = st , functs = [] , cntxCycle = [] + , receivedValues = [] , busType = Nothing , report = Left "Report not ready!" } --- | Binds several provided functions to PU -assigns = mapM_ assign - -- | Binds provided function to PU -assign :: F v x -> DSLStatement pu v x t () +assign :: F v x -> PUStatement pu v x t () assign f = do st@UnitTestState{unit, functs} <- get case tryBind f unit of Right unit_ -> put st{unit = unit_, functs = f : functs} Left err -> lift $ assertFailure $ "assign: " <> err -{- | Store several provided functions and its initial values -for naive coSimulation --} -assignsNaive alg cntxs = mapM_ (`assignNaive` cntxs) alg - -{- | Store provided function and its initial values -for naive coSimulation --} -assignNaive f cntxs = do +-- | Store provided function and its initial values for naive coSimulation +assignNaive :: [(v, x)] -> F v x -> PUStatement pu v x t () +assignNaive cntxs f = do st@UnitTestState{functs, cntxCycle} <- get - -- TODO: add if value is present put st{functs = f : functs, cntxCycle = cntxs <> cntxCycle} -- | set initital values for coSimulation input variables -setValues :: (Function f v, WithFunctions pu f) => [(v, x)] -> DSLStatement pu v x t () +setValues :: (Function f v, WithFunctions pu f) => [(v, x)] -> PUStatement pu v x t () setValues = mapM_ $ uncurry setValue -- | set initital value for coSimulation input variables -setValue :: (Var v, Function f v, WithFunctions pu f) => v -> x -> DSLStatement pu v x t () +setValue :: (Var v, Function f v, WithFunctions pu f) => v -> x -> PUStatement pu v x t () setValue var val = do pu@UnitTestState{cntxCycle, unit} <- get when (var `elem` map fst cntxCycle) $ @@ -266,92 +223,22 @@ setValue var val = do lift $ assertFailure $ "It's not possible to set the variable '" <> toString var <> "'! It's not present in process" put pu{cntxCycle = (var, val) : cntxCycle} where - isVarAvailable v pu = S.isSubsetOf (S.fromList [v]) $ inpVars $ functions pu - -assignFunction f = assignFunctions [f] - -assignFunctions fs = do - st@UnitTestState{functs, unit = ts@TargetSynthesis{}} <- get - let tDFG' = fsToDataFlowGraph $ fs <> functs - put st{functs = fs <> functs, unit = ts{tDFG = tDFG'}} - --- TODO u can keep this variant, but not recommend -assignLua src = - let translateToIntermediate = return . frDataFlow . lua2functions - in do - st@UnitTestState{functs, unit = ts@TargetSynthesis{}} <- get - tDFG' <- maybe (return $ fsToDataFlowGraph functs) translateToIntermediate $ Just src - put st{unit = ts{tSourceCode = Just src, tDFG = tDFG'}} - -setBusType busType = modify' $ \st -> st{busType = Just busType} - -setRecievedValues = mapM_ $ uncurry setRecievedValue - -setRecievedValue var val = do - st@UnitTestState{unit = ts@TargetSynthesis{tReceivedValues = vs}} <- get - put st{unit = ts{tReceivedValues = (var, val) : vs}} - -setNetwork network = do - st@UnitTestState{unit = ts@TargetSynthesis{}} <- get - put st{unit = ts{tMicroArch = network}} - --- | Allows manual binding function. Incompatible with auto synthesis. -bindInit = do - st@UnitTestState{unit = ts@TargetSynthesis{tMicroArch, tDFG}} <- get - root <- lift $ getTreeUnit tMicroArch tDFG - put st{unit = ts{tMicroArch = root}} - -bindVariable f = do - st@UnitTestState{unit = ts@TargetSynthesis{tMicroArch}, functs} <- get - case find (\(Bind f' _) -> f == f') $ bindOptions tMicroArch of - Just decision -> put st{unit = ts{tMicroArch = bindDecision tMicroArch decision}, functs = f : functs} - Nothing -> lift $ assertFailure ("Cannot bind variable: " <> show f) - -bindVariables = mapM_ bindVariable - --- TODO: don't run it more than once -getTreeUnit tMicroArch tDfg = targetUnit <$> synthesisTreeRootIO (mkModelWithOneNetwork tMicroArch tDfg) - -transferVariables v = transferVariables' v Nothing - -transferVariablesAt v from to = transferVariables' v $ Just (from, to) - --- TODO: is it possible to use unsafe parameter? -transferVariables' v intrvl = do - st@UnitTestState{unit = ts@TargetSynthesis{tMicroArch = ma@BusNetwork{}}} <- get - let res = findDecision ma v intrvl - unless (length res == 1) $ - lift $ assertFailure ("Cannot transfer variable: " <> show v) - case length res of - 1 -> put st{unit = ts{tMicroArch = dataflowDecision ma $ dataflowOption2decision $ head res}} - 0 -> lift $ assertFailure ("Cannot transfer variable: " <> show v <> "; Haven't found any decisions.") - _ -> lift $ assertFailure ("Cannot transfer variable: " <> show v <> "; There are more than one possible decision: " <> show res) - -findDecision u v intrvl = - let isSame dfo = any (isSubroleOf v) $ provider dfo : consumer dfo - provider dfo = epRole $ snd $ dfSource dfo - consumer dfo = map (epRole . snd) $ dfTargets dfo - isIntrvl Nothing _ = True - isIntrvl (Just (a, b)) dfo = isValidInterval (a ... b) $ epAt $ snd $ dfSource dfo - isValidInterval atA atB = - atA `isSubsetOf` tcAvailable atB - && member (width atA + 1) (tcDuration atB) - in filter (\dfo -> isSame dfo && isIntrvl intrvl dfo) $ dataflowOptions u + isVarAvailable v pu = S.isSubsetOf (S.fromList [v]) $ unionsMap inputs $ functions pu -- | Make synthesis decision with provided Endpoint Role and automatically assigned time -decide :: EndpointRole v -> DSLStatement pu v x t () +decide :: EndpointRole v -> PUStatement pu v x t () decide role = do des <- epAt <$> getDecisionSpecific role doDecision False $ EndpointSt role des -- | Make synthesis decision with provided Endpoint Role and manually selected interval -decideAt :: t -> t -> EndpointRole v -> DSLStatement pu v x t () +decideAt :: t -> t -> EndpointRole v -> PUStatement pu v x t () decideAt from to role = doDecision False $ EndpointSt role (from ... to) -decideAtUnsafe :: t -> t -> EndpointRole v -> DSLStatement pu v x t () +decideAtUnsafe :: t -> t -> EndpointRole v -> PUStatement pu v x t () decideAtUnsafe from to role = doDecision True $ EndpointSt role (from ... to) -doDecision :: Bool -> EndpointSt v (Interval t) -> DSLStatement pu v x t () +doDecision :: Bool -> EndpointSt v (Interval t) -> PUStatement pu v x t () doDecision unsafe endpSt = do st@UnitTestState{unit} <- get let isAvailable = isEpOptionAvailable endpSt unit @@ -359,15 +246,8 @@ doDecision unsafe endpSt = do then put st{unit = endpointDecision unit endpSt} else lift $ assertFailure $ "doDecision: such option isn't available: " <> show endpSt <> " from " <> show (endpointOptions unit) -isEpOptionAvailable EndpointSt{epRole = role, epAt = atA} pu = - case find (isSubroleOf role . epRole) $ endpointOptions pu of - Nothing -> False - Just EndpointSt{epAt = atB} -> - atA `isSubsetOf` tcAvailable atB - && member (width atA + 1) (tcDuration atB) - -- |Bind all functions to processor unit and decide till decisions left. -decideNaiveSynthesis :: DSLStatement pu v x t () +decideNaiveSynthesis :: PUStatement pu v x t () decideNaiveSynthesis = do st@UnitTestState{unit, functs} <- get when (null functs) $ @@ -380,7 +260,6 @@ consume = Target -- | Transforms provided variables to Source provide = Source . S.fromList -getDecisionSpecific :: EndpointRole v -> DSLStatement pu v x t (EndpointSt v (Interval t)) getDecisionSpecific role = do let s = variables role des <- getDecisionsFromEp @@ -388,35 +267,45 @@ getDecisionSpecific role = do Just v -> return $ endpointOptionToDecision v Nothing -> lift $ assertFailure $ "Can't provide decision with variable: " <> show (vsToStringList s) -getDecisionsFromEp :: DSLStatement pu v x t [EndpointSt v (TimeConstraint t)] getDecisionsFromEp = do UnitTestState{unit} <- get case endpointOptions unit of [] -> lift $ assertFailure "Failed during decision making: there is no decisions left!" opts -> return opts --- | Breaks loop on PU by using breakLoopDecision function -breakLoop :: BreakLoopProblem pu v x => x -> v -> [v] -> DSLStatement pu v x t () -breakLoop x i o = do - st@UnitTestState{unit} <- get - case breakLoopOptions unit of - [] -> lift $ assertFailure "Break loop function is not supported for such type of PU" - _ -> put st{unit = breakLoopDecision unit BreakLoop{loopX = x, loopO = S.fromList o, loopI = i}} +isEpOptionAvailable EndpointSt{epRole = role, epAt = atA} pu = + case find (isSubroleOf role . epRole) $ endpointOptions pu of + Nothing -> False + Just EndpointSt{epAt = atB} -> + atA `isSubsetOf` tcAvailable atB + && member (width atA + 1) (tcDuration atB) -assertBindFullness :: (Function f v, WithFunctions pu f, Show f) => DSLStatement pu v x t () +assertBindFullness :: (Function f v, WithFunctions pu f, Show f) => PUStatement pu v x t () assertBindFullness = do UnitTestState{unit, functs} <- get isOk <- lift $ isFullyBinded unit functs unless isOk $ lift $ assertFailure $ "Function is not binded to process! expected: " ++ concatMap show functs ++ "; actual: " ++ concatMap show (functions unit) - -assertAllEndpointRoles :: (Var v) => [EndpointRole v] -> DSLStatement pu v x t () + where + isFullyBinded pu fs = do + assertBool ("Outputs not equal, expected: " <> show' fOuts <> "; actual: " <> show' outs) $ outs == fOuts + assertBool ("Inputs not equal, expected: " <> show' fInps <> "; actual: " <> show' inps) $ inps == fInps + return $ not $ null fu + where + fu = functions pu + outs = unionsMap outputs fu + inps = unionsMap inputs fu + fOuts = unionsMap outputs fs + fInps = unionsMap inputs fs + show' = show . S.map toString + +assertAllEndpointRoles :: (Var v) => [EndpointRole v] -> PUStatement pu v x t () assertAllEndpointRoles roles = do UnitTestState{unit} <- get let opts = S.fromList $ map epRole $ endpointOptions unit lift $ assertBool ("Actual endpoint roles: " <> show opts) $ opts == S.fromList roles -assertEndpoint :: t -> t -> EndpointRole v -> DSLStatement pu v x t () +assertEndpoint :: t -> t -> EndpointRole v -> PUStatement pu v x t () assertEndpoint a b role = do UnitTestState{unit} <- get let opts = endpointOptions unit @@ -425,55 +314,7 @@ assertEndpoint a b role = do Nothing -> lift $ assertFailure $ "assertEndpoint: '" <> show ep <> "' not defined in: " <> show opts Just _ -> return () -isFullyBinded pu fs = do - assertBool ("Outputs not equal, expected: " <> show' fOuts <> "; actual: " <> show' outs) $ outs == fOuts - assertBool ("Inputs not equal, expected: " <> show' fInps <> "; actual: " <> show' inps) $ inps == fInps - return $ not $ null fu - where - fu = functions pu - outs = unionsMap outputs fu - inps = unionsMap inputs fu - fOuts = unionsMap outputs fs - fInps = unionsMap inputs fs - show' = show . S.map toString - -assertSynthesisDone :: DSLStatement pu v x t () -assertSynthesisDone = do - UnitTestState{unit, functs, testName} <- get - unless (isProcessComplete unit functs && null (endpointOptions unit)) $ - lift $ assertFailure $ testName <> " Process is not done: " <> incompleteProcessMsg unit functs - --- | Run both automatic synthesis and Testbench. -assertSynthesisDoneAuto = assertSynthesis True - --- | Run only automatic synthesis without Testbench. -assertSynthesisRunAuto = assertSynthesis False - -assertSynthesis isTestbench = do - st@UnitTestState{testName, functs, unit = ts@TargetSynthesis{tSourceCode}} <- get - when (null functs && isNothing tSourceCode) $ - lift $ assertFailure "Can't run target synthesis, you haven't provided any functions or source code" - let wd = toModuleName $ toString testName - let namedTs = ts{tName = if isJust tSourceCode then "lua_" <> wd else wd} - result <- lift $ synthesizeTargetSystemWithUniqName namedTs - case result of - Left l -> lift $ assertFailure $ "target synthesis failed" <> show l - Right r -> put st{unit = namedTs{tMicroArch = pUnit r}} - when isTestbench $ - lift $ getTestbenchReport result - -getTestbenchReport project = do - reportTestbench <- traverse runTestbench project - case reportTestbench of - Left err -> assertFailure ("synthesis process fail " <> err) - Right TestbenchReport{tbStatus = True} -> return () - Right report@TestbenchReport{tbCompilerDump} - | T.length tbCompilerDump > 2 -> - assertFailure ("icarus synthesis error:\n" <> show report) - Right report@TestbenchReport{} -> - assertFailure ("icarus simulation error:\n" <> show report) - -assertLocks :: (Locks pu v) => [Lock v] -> DSLStatement pu v x t () +assertLocks :: (Locks pu v) => [Lock v] -> PUStatement pu v x t () assertLocks expectLocks = do UnitTestState{unit} <- get let actualLocks0 = locks unit @@ -483,16 +324,26 @@ assertLocks expectLocks = do where show' ls = S.join "\n" $ map ((" " <>) . show) ls -assertCoSimulation :: +assertSynthesisDone :: PUStatement pu v x t () +assertSynthesisDone = do + UnitTestState{unit, functs, testName} <- get + unless (isProcessComplete unit functs && null (endpointOptions unit)) $ + lift $ assertFailure $ testName <> " Process is not done: " <> incompleteProcessMsg unit functs + +assertPUCoSimulation :: ( PUClasses pu v x Int , WithFunctions pu (F v x) , Testable pu v x , DefaultX pu x , Var v ) => - DSLStatement pu v x Int () -assertCoSimulation = - let checkInputVars pu fs cntx = S.union (inpVars $ functions pu) (inpVars fs) == S.fromList (map fst cntx) + PUStatement pu v x Int () +assertPUCoSimulation = + let checkInputVars pu fs cntx = + S.union + (unionsMap inputs $ functions pu) + (unionsMap inputs fs) + == S.fromList (map fst cntx) in do UnitTestState{unit, functs, testName, cntxCycle} <- get unless (checkInputVars unit functs cntxCycle) $ @@ -504,107 +355,209 @@ assertCoSimulation = unless tbStatus $ lift $ assertFailure $ "coSimulation failed: \n" <> show report -inpVars fs = unionsMap inputs fs +assignLua :: T.Text -> TSStatement x () +assignLua src = do + assertEmptyDataFlow + st@UnitTestState{unit = TargetSystem{mUnit}} <- get + let dfg = frDataFlow $ lua2functions src + put + st + { unit = mkModelWithOneNetwork mUnit dfg + , functs = functions dfg + } + +-- | Bind function to network (except 'doBind' after that) +bind2network :: F T.Text x -> TSStatement x () +bind2network f = do + st@UnitTestState{functs, unit = ts@TargetSystem{mUnit, mDataFlowGraph}} <- get + put + st + { unit = + ts + { mDataFlowGraph = addFuncToDataFlowGraph f mDataFlowGraph + , mUnit = bind f mUnit + } + , functs = f : functs + } + +setNetwork :: BusNetwork T.Text T.Text x Int -> TSStatement x () +setNetwork network = do + st@UnitTestState{unit} <- get + assertEmptyDataFlow + put st{unit = unit{mUnit = network}} +setBusType :: Proxy x -> TSStatement x () +setBusType busType = modify' $ \st -> st{busType = Just busType} + +-- | Set data for IO +setReceivedValues :: [(T.Text, [x])] -> TSStatement x () +setReceivedValues values = do + st@UnitTestState{receivedValues} <- get + unless (null receivedValues) $ + lift $ assertFailure "setReceivedValues: already setted" + put st{receivedValues = values} + +synthesis :: SynthesisMethod T.Text T.Text x Int -> TSStatement x () +synthesis method = do + st@UnitTestState{unit} <- get + leaf <- lift $ do + root <- synthesisTreeRootIO unit + method root + put st{unit = sTarget $ sState leaf} + +doBind :: T.Text -> F T.Text x -> TSStatement x () +doBind tag f = do + st@UnitTestState{unit = ts} <- get + let d = Bind f tag + opts = bindOptions ts + unless (d `L.elem` opts) $ + lift $ assertFailure $ "bind not available: " <> show d <> " in: " <> show opts + put st{unit = bindDecision ts d} + +doTransfer :: [T.Text] -> TSStatement x () +doTransfer vs = do + st@UnitTestState{unit = ts} <- get + let opts = dataflowOptions ts + case L.find (\o -> S.fromList vs == variables o) opts of + Just o -> put st{unit = dataflowDecision ts $ dataflowOption2decision o} + Nothing -> lift $ assertFailure $ "can't find transfer for: " <> show vs <> " in: " <> show opts + +class Refactor u ref where + refactorAvail :: ref -> Statement u v x () + refactor :: ref -> Statement u v x () + +refactorAvail' ref options = do + UnitTestState{unit} <- get + unless (ref `L.elem` options unit) $ + lift $ assertFailure "refactorAvail: required refactor not present in option" + +refactor' ref options decision = do + st@UnitTestState{unit} <- get + unless (ref `L.elem` options unit) $ + lift $ assertFailure $ "refactor: required refactor not present in option: " <> show ref + put st{unit = decision unit ref} + +instance (Var v, Val x, BreakLoopProblem u v x) => Refactor u (BreakLoop v x) where + refactorAvail ref = refactorAvail' ref breakLoopOptions + refactor ref = refactor' ref breakLoopOptions breakLoopDecision + +mkBreakLoop :: (Var v, Val x) => x -> v -> [v] -> Statement u v x (BreakLoop v x) +mkBreakLoop x i o = return $ BreakLoop x (S.fromList o) i + +instance (Var v, Val x, OptimizeAccumProblem u v x) => Refactor u (OptimizeAccum v x) where + refactorAvail ref = refactorAvail' ref optimizeAccumOptions + refactor ref = refactor' ref optimizeAccumOptions optimizeAccumDecision + +mkOptimizeAccum :: (Var v, Val x) => [F v x] -> [F v x] -> Statement u v x (OptimizeAccum v x) +mkOptimizeAccum old new = return $ OptimizeAccum old new + +instance (Var v, Val x, ResolveDeadlockProblem u v x) => Refactor u (ResolveDeadlock v x) where + refactorAvail ref = refactorAvail' ref resolveDeadlockOptions + refactor ref = refactor' ref resolveDeadlockOptions resolveDeadlockDecision + +mkResolveDeadlock :: (Var v, Val x) => [v] -> Statement u v x (ResolveDeadlock v x) +mkResolveDeadlock vs = return $ resolveDeadlock (S.fromList vs) + +instance (Var v, Val x, ConstantFoldingProblem u v x) => Refactor u (ConstantFolding v x) where + refactorAvail ref = refactorAvail' ref constantFoldingOptions + refactor ref = refactor' ref constantFoldingOptions constantFoldingDecision + +mkConstantFolding :: (Var v, Val x) => [F v x] -> [F v x] -> Statement u v x (ConstantFolding v x) +mkConstantFolding old new = return $ ConstantFolding old new + +assertRefactor :: (Typeable ref, Eq ref, Show ref) => ref -> TSStatement x () +assertRefactor ref = do + refactors <- filter isRefactorStep . map (descent . pDesc) . steps . process . unit <$> get + case L.find (\(RefactorStep r) -> Just ref == cast r) refactors of + Nothing -> lift $ assertFailure $ "Refactor not present: " <> show ref <> " in " <> show refactors + Just _ -> return () + +assertEmptyDataFlow :: TSStatement x () +assertEmptyDataFlow = do + UnitTestState{unit = TargetSystem{mDataFlowGraph}} <- get + unless (null $ functions mDataFlowGraph) $ + error "assertEmptyDataFlow: dataflow should be empty" + +assertSynthesisComplete :: TSStatement x () +assertSynthesisComplete = do + UnitTestState{unit = unit@TargetSystem{mUnit, mDataFlowGraph}} <- get + unless (isSynthesisComplete unit) $ + lift $ assertFailure $ "synthesis is not complete: " <> show (transferred mUnit `S.difference` variables mDataFlowGraph) + +assertTargetSystemCoSimulation :: TSStatement x () +assertTargetSystemCoSimulation = do + UnitTestState{unit = TargetSystem{mUnit, mDataFlowGraph}, testName, receivedValues} <- get + report <- lift $ do + pInProjectNittaPath <- either (error . T.unpack) id <$> collectNittaPath defProjectTemplates + pwd <- getCurrentDirectory + pName <- uniqTestPath testName + let outputPath = "gen" + loopsNumber = 5 + prj = + Project + { pName = T.pack pName + , pLibPath = "hdl" + , pTargetProjectPath = outputPath pName + , pAbsTargetProjectPath = pwd outputPath pName + , pInProjectNittaPath + , pAbsNittaPath = pwd outputPath pInProjectNittaPath + , pUnit = mUnit + , pUnitEnv = bnEnv mUnit + , pTestCntx = simulateDataFlowGraph loopsNumber def receivedValues mDataFlowGraph + , pTemplates = defProjectTemplates + } + writeProject prj + runTestbench prj + assertSuccessReport report + +assertSuccessReport :: TestbenchReport T.Text x -> TSStatement x () +assertSuccessReport report@TestbenchReport{tbStatus} = + lift $ assertBool ("report with bad status:\n" <> show report) tbStatus + +synthesizeAndCoSim :: TSStatement x () +synthesizeAndCoSim = do + synthesis stateOfTheArtSynthesisIO + assertSynthesisComplete + assertTargetSystemCoSimulation + +tracePU :: Show pu => PUStatement pu v x t () tracePU = do UnitTestState{unit} <- get lift $ putStrLn $ "PU: " <> show unit - return () +traceFunctions :: Statement u v x () traceFunctions = do UnitTestState{functs} <- get - lift $ putStrLn $ "Functions: " <> show functs - return () + lift $ putListLn "Functions: " functs +traceEndpoints :: PUStatement pu v x t () traceEndpoints = do UnitTestState{unit} <- get - lift $ do - putStrLn "Endpoints:" - mapM_ (\ep -> putStrLn $ "- " <> show ep) $ endpointOptions unit - return () + lift $ putListLn "Endpoints:" $ endpointOptions unit +traceProcess :: (ProcessorUnit u v x Int) => Statement u v x () traceProcess = do UnitTestState{unit} <- get lift $ putStrLn $ "Process: " <> show (pretty $ process unit) - return () +traceDataflow :: TSStatement x () traceDataflow = do - UnitTestState{unit = TargetSynthesis{tDFG}} <- get - lift $ putStrLn $ "Dataflow: " <> show tDFG - return () - -traceBus = do - UnitTestState{unit = TargetSynthesis{tMicroArch = b@BusNetwork{}}} <- get - lift $ putStrLn $ "Bus: " <> show (pretty $ process b) - return () - -traceTransferOptions = do - UnitTestState{unit = TargetSynthesis{tMicroArch = ma@BusNetwork{}}} <- get - lift $ putStrLn $ "Dataflow options: " <> show (dataflowOptions ma) - return () - -traceBindVariables = do - UnitTestState{unit = TargetSynthesis{tMicroArch}} <- get - lift $ putStrLn $ "BindVariables: " <> show (bindOptions tMicroArch) - return () - -traceAvailableRefactor = do - UnitTestState{unit = TargetSynthesis{tMicroArch = bus}} <- get - lift $ putStrLn "Available refactor" - lift $ putStrLn $ " breakLoopOptions: " <> show (breakLoopOptions bus) - lift $ putStrLn $ " constantFoldingOptions : " <> show (constantFoldingOptions bus) - lift $ putStrLn $ " optimizeAccumOptions: " <> show (optimizeAccumOptions bus) - lift $ putStrLn $ " resolveDeadlockOptions: " <> show (resolveDeadlockOptions bus) - return () - --- | Get all loop function. Can be used as value to assertLoopBroken after auto synthesis. -getLoopFunctions = do - UnitTestState{unit = TargetSynthesis{tMicroArch, tDFG}} <- get - root <- lift $ getTreeUnit tMicroArch tDFG - let loopFs = filter isLoop $ map (\(Bind f _) -> f) $ bindOptions root - return loopFs - -applyBreakLoop f = do - st@UnitTestState{unit = ts@TargetSynthesis{tMicroArch}} <- get - case find (\l@BreakLoop{} -> recLoop l == f) $ breakLoopOptions tMicroArch of - Just refactor -> put st{unit = ts{tMicroArch = breakLoopDecision tMicroArch refactor}} - Nothing -> lift $ assertFailure $ "Can't find refactor for such function: " <> show f - -applyBreakLoops fs = mapM_ applyBreakLoop fs - --- TODO combine with assertSynthesisInclude?? -assertLoopBroken [] = lift $ assertFailure "Can't check is loop broken for empty list!" -assertLoopBroken fs = do - UnitTestState{unit = TargetSynthesis{tMicroArch = ma@BusNetwork{}}} <- get - -- TODO add loop filter to check that there is no other func - let fs' = S.fromList $ concatMap (concatBind . loopExtract) fs - let cad = S.fromList $ getCADs $ process ma - unless (S.isSubsetOf fs' cad) $ - lift $ - assertFailure $ - "Can't find refactor for such functions: " - <> show (S.difference fs' cad) - <> "\n in: " - <> show cad - where - loopExtract f - | Just f_@(Loop _ (O ov) (I iv)) <- castF f = Just (f_, ov, iv) - | otherwise = Nothing - concatBind (Just (f, ov, iv)) = ["bind LoopBegin " <> label f <> " " <> concatMap label (S.elems ov), "bind LoopEnd " <> label f <> " " <> label iv] - concatBind Nothing = [] - -applyConstantFolding fs = do - st@UnitTestState{unit = ts@TargetSynthesis{tMicroArch}} <- get - case find (\ConstantFolding{cRefOld} -> isSubsequenceOf fs cRefOld) $ constantFoldingOptions tMicroArch of - Just refactor -> put st{unit = ts{tMicroArch = constantFoldingDecision tMicroArch refactor}} - Nothing -> lift $ assertFailure $ "Can't find refactor for such function: " <> show fs - -assertConstantFolded = undefined - -applyOptimizeAccum fs = do - st@UnitTestState{unit = ts@TargetSynthesis{tMicroArch}} <- get - case find (\OptimizeAccum{refOld} -> isSubsequenceOf fs refOld) $ optimizeAccumOptions tMicroArch of - Just refactor -> put st{unit = ts{tMicroArch = optimizeAccumDecision tMicroArch refactor}} - Nothing -> lift $ assertFailure $ "Can't find refactor for such function: " <> show fs - -assertOptimizeAccum = undefined + UnitTestState{unit = TargetSystem{mUnit}} <- get + lift $ putListLn "Dataflow:" $ dataflowOptions mUnit + +traceBind :: TSStatement x () +traceBind = do + UnitTestState{unit = TargetSystem{mUnit}} <- get + lift $ putListLn "Bind:" $ bindOptions mUnit + +traceRefactor :: TSStatement x () +traceRefactor = do + UnitTestState{unit = TargetSystem{mUnit}} <- get + lift $ putListLn "breakLoopOptions:" $ breakLoopOptions mUnit + lift $ putListLn "constantFoldingOptions:" $ constantFoldingOptions mUnit + lift $ putListLn "optimizeAccumOptions:" $ optimizeAccumOptions mUnit + lift $ putListLn "resolveDeadlockOptions:" $ resolveDeadlockOptions mUnit + +putListLn name opts = do + putStrLn name + mapM_ (\b -> putStrLn $ "- " <> show b) opts diff --git a/test/NITTA/Model/ProcessorUnits/Tests/DSL/Tests.hs b/test/NITTA/Model/ProcessorUnits/Tests/DSL/Tests.hs index 1b52fdd7e..b1d727cd7 100644 --- a/test/NITTA/Model/ProcessorUnits/Tests/DSL/Tests.hs +++ b/test/NITTA/Model/ProcessorUnits/Tests/DSL/Tests.hs @@ -18,11 +18,10 @@ module NITTA.Model.ProcessorUnits.Tests.DSL.Tests ( ) where import Data.Default +import qualified Data.Set as S import Data.String.Interpolate -import qualified Data.Text as T import NITTA.Model.ProcessorUnits.Tests.Providers import NITTA.Model.Tests.Providers -import NITTA.Synthesis import Test.Tasty (testGroup) import Test.Tasty.ExpectedFailure @@ -40,7 +39,7 @@ tests = decide $ consume "a" decide $ consume "b" decide $ provide ["c", "d"] - assertCoSimulation + assertPUCoSimulation , unitTestCase "check assertEndpoint and assertAllEndpointRoles with Target success" u $ do assign $ multiply "a" "b" ["c", "d"] assertAllEndpointRoles [consume "a", consume "b"] @@ -83,7 +82,7 @@ tests = decide $ consume "a" decide $ consume "b" decide $ provide ["c", "d"] - assertCoSimulation + assertPUCoSimulation , expectFail $ unitTestCase "should not bind, when PU incompatible with F" u $ assign $ sub "a" "b" ["c"] @@ -109,7 +108,7 @@ tests = , expectFail $ unitTestCase "should error: breakLoop is not supportd" u $ do assign $ multiply "a" "b" ["c", "d"] - breakLoop 10 "a" ["c"] + refactor =<< mkBreakLoop 10 "a" ["c"] , expectFail $ unitTestCase "should error: setValue variable is unavailable" u $ do assign $ multiply "a" "b" ["c", "d"] @@ -142,7 +141,7 @@ tests = decideAt 0 0 $ consume "a" assertEndpoint 3 maxBound $ provide ["b"] decideAtUnsafe 2 2 $ provide ["b"] -- incorrect decision - assertCoSimulation + assertPUCoSimulation ] , testGroup "assertLocks" @@ -158,14 +157,108 @@ tests = ] , testGroup "BusNetwork positive tests" - [ unitTestCase "assertLoopBroken ok when break applied" tbr $ do - breakLoopTemplate - bindInit - let loopEC = loop 0 "e#0" ["c#0"] - bindVariable loopEC - applyBreakLoop loopEC - assertLoopBroken [loopEC] - , unitTestCase "assertLoopBroken ok when auto synthesis" tbr $ do + [ unitTestCase "target system: autosynthesis, assert breakLoop" def $ do + setNetwork march + setBusType pInt + assignLua + [__i| + function sum(a) + local d = a + 1 + sum(d) + end + sum(0) + |] + synthesizeAndCoSim + assertRefactor =<< mkBreakLoop 0 "d^0#0" ["a^0#0"] + , unitTestCase "target system: autosynthesis, constant folding" def $ do + setNetwork march + setBusType pInt + assignLua + [__i| + function sum(a) + local d = a + 1 + sum(d) + end + sum(0) + |] + synthesizeAndCoSim + assertRefactor =<< mkBreakLoop 0 "d^0#0" ["a^0#0"] + , unitTestCase "target system: autosynthesis, constant folding 1" def $ do + setNetwork march + setBusType pInt + assignLua + [__i| + function sum(a) + local d = 1 + 2 + a + sum(d) + end + sum(0) + |] + synthesizeAndCoSim + assertRefactor + =<< mkConstantFolding + [ add "!1#0" "!2#0" ["_0#d"] + , constant 2 ["!2#0"] + , constant 1 ["!1#0"] + ] + [ constant 3 ["_0#d"] + , constant 2 ["!2#0"] -- FIXME: Do we actually need this? + , constant 1 ["!1#0"] + ] + , unitTestCase "target system: autosynthesis, constant folding 2" def $ do + setNetwork march + setBusType pInt + assignLua + [__i| + function sum(a) + local d = a + 1 + 2 + sum(d) + end + sum(0) + |] + optAccum <- + mkOptimizeAccum + [ add "_0#d" "!2#0" ["d^0#0"] + , add "a^0#0" "!1#0" ["_0#d"] + ] + [ acc + [ Push Plus $ I "a^0#0" + , Push Plus $ I "!1#0" + , Push Plus $ I "!2#0" + , Pull $ O $ S.fromList ["d^0#0"] + ] + ] + refactorAvail optAccum + refactor optAccum + assertRefactor optAccum + , -- FIXME: should be presented (with small changes) + -- refactorAvail + -- =<< mkConstantFolding + -- [ acc + -- [ Push Plus $ I "a^0#0" + -- , Push Plus $ I "!1#0" + -- , Push Plus $ I "!2#0" + -- , Pull $ O $ S.fromList ["d^0#0"] + -- ] + -- , constant 1 ["!1#0"] + -- , constant 2 ["!2#0"] + -- ] + -- [ acc + -- [ Push Plus $ I "a^0#0" + -- , Push Plus $ I "_0#d" + -- , Pull $ O $ S.fromList ["d^0#0"] + -- ] + -- , constant 2 ["_0#d"] + -- ] + unitTestCase "target system: manual synthesis, assert breakLoop" def $ do + setNetwork march + setBusType pInt + let l = loop 0 "d^0#0" ["a^0#0"] + bind2network l + doBind "fram1" l + refactor =<< mkBreakLoop 0 "d^0#0" ["a^0#0"] + assertRefactor =<< mkBreakLoop 0 "d^0#0" ["a^0#0"] + , unitTestCase "target system: autosynthesis, buffer & accum refactor" def $ do setNetwork march setBusType pInt assignLua @@ -178,52 +271,38 @@ tests = end sum(0,0,0) |] - loopFs <- getLoopFunctions - assertSynthesisRunAuto - assertLoopBroken loopFs + synthesizeAndCoSim + assertRefactor =<< mkBreakLoop 0 "d^0#2" ["a^0#0"] + assertRefactor =<< mkBreakLoop 0 "f^0#0" ["b^0#0"] + assertRefactor =<< mkBreakLoop 0 "e^0#0" ["c^0#0"] + assertRefactor =<< mkResolveDeadlock ["d^0#0", "d^0#1"] + assertRefactor + =<< mkOptimizeAccum + [ add "_0#d" "c^0#0" ["d^0#0", "d^0#1", "d^0#2"] + , add "a^0#0" "b^0#0" ["_0#d"] + ] + [ acc + [ Push Plus $ I "a^0#0" + , Push Plus $ I "b^0#0" + , Push Plus $ I "c^0#0" + , Pull $ O $ S.fromList ["d^0#0"] + , Pull $ O $ S.fromList ["d^0#1"] + , Pull $ O $ S.fromList ["d^0#2"] + ] + ] ] , testGroup "BusNetwork negative tests" [ expectFail $ - unitTestCase "assertLoopBroken fail when func not binded" tbr $ do - breakLoopTemplate - bindInit - let loopEC = loop 0 "e#0" ["c#0"] - let loopDA = loop 0 "d#0" ["a#0"] - bindVariables [loopEC, loopDA] - assertLoopBroken [loopEC, loopDA] - , expectFail $ - unitTestCase "assertLoopBroken fail when func binded" tbr $ do - breakLoopTemplate - bindInit - let loopEC = loop 0 "e#0" ["c#0"] - bindVariable loopEC - assertLoopBroken [loopEC] - , expectFail $ - unitTestCase "assertLoopBroken when func binded" tbr $ do - -- TODO fix case: for unknown reason loop e -> c is not present in process: - -- ["bind LoopBegin loop(0, e#0) = c#0 c#0","bind LoopEnd loop(0, e#0) = c#0 e#0"] - breakLoopTemplate - loopFs <- getLoopFunctions - assertSynthesisRunAuto - traceBus - assertLoopBroken loopFs + unitTestCase "target system: manual synthesis, refactor loop break not applied" def $ do + setNetwork march + setBusType pInt + let l = loop 0 "d^0#0" ["a^0#0"] + bind2network l + doBind "fram1" l + assertRefactor =<< mkBreakLoop 0 "d^0#0" ["a^0#0"] ] ] where - tbr = def :: Val x => TargetSynthesis T.Text T.Text x Int u = multiplier True :: Multiplier String Int Int broken = def :: Broken String Int Int - breakLoopTemplate = do - setNetwork march - setBusType pInt - assignLua - [__i| - function sum(a, c) - local d = a + c - local m = 100 - local e = m + 1 - sum(d, e) - end - sum(0,0) - |] diff --git a/test/NITTA/Model/ProcessorUnits/Tests/Providers.hs b/test/NITTA/Model/ProcessorUnits/Tests/Providers.hs index f3ee57556..6de390c2f 100644 --- a/test/NITTA/Model/ProcessorUnits/Tests/Providers.hs +++ b/test/NITTA/Model/ProcessorUnits/Tests/Providers.hs @@ -72,9 +72,9 @@ puCoSimTestCase :: TestTree puCoSimTestCase name u cntxCycle alg = unitTestCase name u $ do - assignsNaive alg cntxCycle + mapM_ (assignNaive cntxCycle) alg decideNaiveSynthesis - assertCoSimulation + assertPUCoSimulation -- *Properties diff --git a/test/NITTA/Model/Tests/Internals.hs b/test/NITTA/Model/Tests/Internals.hs index ad7b350e5..116c0eef0 100644 --- a/test/NITTA/Model/Tests/Internals.hs +++ b/test/NITTA/Model/Tests/Internals.hs @@ -11,7 +11,6 @@ Stability : experimental module NITTA.Model.Tests.Internals ( runTargetSynthesisWithUniqName, uniqTestPath, - synthesizeTargetSystemWithUniqName, ) where import Control.Concurrent.STM.TVar @@ -38,7 +37,3 @@ uniqTestPath name = runTargetSynthesisWithUniqName t@TargetSynthesis{tName} = do name <- uniqTestPath tName runTargetSynthesis t{tName = name} - -synthesizeTargetSystemWithUniqName t@TargetSynthesis{tName} = do - name <- uniqTestPath tName - synthesizeTargetSystem t{tName = name} diff --git a/test/NITTA/Model/Tests/Microarchitecture.hs b/test/NITTA/Model/Tests/Microarchitecture.hs index 014c961e8..8b7271695 100644 --- a/test/NITTA/Model/Tests/Microarchitecture.hs +++ b/test/NITTA/Model/Tests/Microarchitecture.hs @@ -93,10 +93,10 @@ withSlaveSPI tag net = modifyNetwork net $ do withMasterSPI tag net = modifyNetwork net $ do add tag $ spiMasterPorts tag -marchSPI tag True proxy = withSlaveSPI tag $ basic proxy -marchSPI tag False proxy = withMasterSPI tag $ basic proxy +marchSPI True proxy = withSlaveSPI "spi" $ basic proxy +marchSPI False proxy = withMasterSPI "spi" $ basic proxy -marchSPIDropData tag isSlave proxy = (marchSPI tag isSlave proxy){ioSync = ASync} +marchSPIDropData isSlave proxy = (marchSPI isSlave proxy){ioSync = ASync} ----------------------------------------------------------- diff --git a/test/NITTA/Tests.hs b/test/NITTA/Tests.hs index 3fa8623a3..343bbc095 100644 --- a/test/NITTA/Tests.hs +++ b/test/NITTA/Tests.hs @@ -6,6 +6,7 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE NoMonomorphismRestriction #-} @@ -27,6 +28,7 @@ module NITTA.Tests ( import Data.Default import Data.Map.Strict (fromList) import qualified Data.Set as S +import Data.String.Interpolate import qualified Data.Text as T import qualified NITTA.Intermediate.Functions as F import NITTA.Intermediate.Types @@ -35,7 +37,6 @@ import NITTA.Model.Problems import NITTA.Model.ProcessorUnits import NITTA.Model.ProcessorUnits.Tests.Providers import NITTA.Model.Tests.Providers -import NITTA.Synthesis import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit import Test.Tasty.TH @@ -43,20 +44,20 @@ import Test.Tasty.TH -- FIXME: avoid NITTA.Model.Tests.Internals usage test_fibonacci = - [ unitTestCase "simple" ts $ do + [ unitTestCase "simple" def $ do setNetwork march - assignFunction $ F.loop (0 :: Int) "b2" ["a1"] - assignFunction $ F.loop (1 :: Int) "c" ["b1", "b2"] - assignFunction $ F.add "a1" "b1" ["c"] - assertSynthesisDoneAuto - , unitTestCase "io_drop_data" ts $ do + bind2network $ F.loop (0 :: Int) "b2" ["a1"] + bind2network $ F.loop (1 :: Int) "c" ["b1", "b2"] + bind2network $ F.add "a1" "b1" ["c"] + synthesizeAndCoSim + , unitTestCase "io_drop_data" def $ do setNetwork $ marchSPIDropData True pInt - assignFunctions algWithSend - assertSynthesisDoneAuto - , unitTestCase "io_no_drop_data" ts $ do + mapM_ bind2network algWithSend + synthesizeAndCoSim + , unitTestCase "io_no_drop_data" def $ do setNetwork $ marchSPI True pInt - assignFunctions algWithSend - assertSynthesisDoneAuto + mapM_ bind2network algWithSend + synthesizeAndCoSim ] where algWithSend = @@ -67,9 +68,11 @@ test_fibonacci = ] test_add_and_io = - [ unitTestCase "receive 4 variables" ts $ do - setNetwork $ marchSPI True pInt - assignFunctions + [ unitTestCase "receive several values and complex accum" def $ do + setNetwork $ microarch Sync SlaveSPI + setBusType pIntX32 + mapM_ + bind2network [ F.receive ["a"] , F.receive ["b"] , F.receive ["e"] @@ -80,24 +83,76 @@ test_add_and_io = , F.send "g" , F.send "h" ] - setRecievedValues + setReceivedValues [ ("a", [10 .. 15]) , ("b", [20 .. 25]) , ("e", [0 .. 25]) , ("f", [20 .. 30]) ] - assertSynthesisDoneAuto + synthesizeAndCoSim + ] + +test_manual = + [ unitTestCase "target system: full manual synthesis" def $ do + setNetwork $ marchSPI True pAttrIntX32 + setBusType pAttrIntX32 + assignLua + [__i| + function sum(a, b, c) + local d = a + b + c -- should AccumOptimization + local e = d + 1 -- e and d should be buffered + local f = d+ 2 + sum(d, f, e) + end + sum(0,0,0) + |] + mapM_ + (uncurry doBind) + [ ("fram1", F.loop 0 "d^0#2" ["a^0#0"]) + , ("fram1", F.loop 0 "f^0#0" ["b^0#0"]) + , ("fram1", F.loop 0 "e^0#0" ["c^0#0"]) + , ("fram1", F.constant 1 ["!1#0"]) + , ("fram1", F.constant 2 ["!2#0"]) + , ("accum", F.add "a^0#0" "b^0#0" ["_0#d"]) + , ("accum", F.add "_0#d" "c^0#0" ["d^0#0", "d^0#1", "d^0#2"]) + , ("accum", F.add "d^0#1" "!2#0" ["f^0#0"]) + , ("accum", F.add "d^0#0" "!1#0" ["e^0#0"]) + ] + refactor =<< mkBreakLoop 0 "d^0#2" ["a^0#0"] + refactor =<< mkBreakLoop 0 "f^0#0" ["b^0#0"] + refactor =<< mkBreakLoop 0 "e^0#0" ["c^0#0"] + doTransfer ["a^0#0"] + doTransfer ["b^0#0"] + refactor =<< mkResolveDeadlock ["_0#d"] + doBind "fram1" $ F.buffer "_0#d@buf" ["_0#d"] + doTransfer ["_0#d@buf"] + doTransfer ["_0#d"] + doTransfer ["c^0#0"] + doTransfer ["d^0#2"] + refactor =<< mkResolveDeadlock ["d^0#0", "d^0#1"] + doBind "fram1" $ F.buffer "d^0#0@buf" ["d^0#0", "d^0#1"] + doTransfer ["d^0#0@buf"] + doTransfer ["d^0#1"] + doTransfer ["!2#0"] + doTransfer ["f^0#0"] + doTransfer ["d^0#0"] + doTransfer ["!1#0"] + doTransfer ["e^0#0"] + assertSynthesisComplete + assertTargetSystemCoSimulation ] -ts = def :: TargetSynthesis _ _ _ _ f1 = F.add "a" "b" ["c", "d"] :: F T.Text Int patchP :: (Patch a (T.Text, T.Text)) => (T.Text, T.Text) -> a -> a patchP = patch + patchI :: (Patch a (I T.Text, I T.Text)) => (I T.Text, I T.Text) -> a -> a patchI = patch + patchO :: (Patch a (O T.Text, O T.Text)) => (O T.Text, O T.Text) -> a -> a patchO = patch + patchC :: (Patch a (Changeset T.Text)) => Changeset T.Text -> a -> a patchC = patch From 586dd2dc21531adc5ec7d69f39541dbefea93cd0 Mon Sep 17 00:00:00 2001 From: Aleksandr Penskoi Date: Sat, 22 Jan 2022 21:16:31 +0300 Subject: [PATCH 3/3] Remove fixme leak --- test/NITTA/Tests.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/test/NITTA/Tests.hs b/test/NITTA/Tests.hs index 343bbc095..0a3c49b3f 100644 --- a/test/NITTA/Tests.hs +++ b/test/NITTA/Tests.hs @@ -41,8 +41,6 @@ import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit import Test.Tasty.TH --- FIXME: avoid NITTA.Model.Tests.Internals usage - test_fibonacci = [ unitTestCase "simple" def $ do setNetwork march