From d6f7714d4dad3827133b0bc8d023cddcfff48953 Mon Sep 17 00:00:00 2001 From: BasicEC Date: Tue, 14 Jun 2022 21:50:16 +0300 Subject: [PATCH] Fixes after review Related: #157 --- app/Main.hs | 2 +- examples/microarch.toml | 2 +- src/NITTA/Model/Microarchitecture/Config.hs | 19 ++++------ src/NITTA/Model/Networks/Bus.hs | 22 +++++------ src/NITTA/Model/Networks/Types.hs | 2 +- src/NITTA/Model/Problems/Allocation.hs | 8 ++-- src/NITTA/Model/Problems/ViewHelper.hs | 10 ++--- src/NITTA/Model/TargetSystem.hs | 2 +- src/NITTA/Synthesis/Method.hs | 6 ++- src/NITTA/Synthesis/Steps/Allocation.hs | 8 ++-- src/NITTA/Synthesis/Steps/Dataflow.hs | 38 ++++++++++++------- src/NITTA/UIBackend/ViewHelper.hs | 2 +- test/NITTA/Model/ProcessorUnits/Tests/DSL.hs | 9 +++-- .../Model/ProcessorUnits/Tests/DSL/Tests.hs | 2 +- web/src/components/SubforestTables.tsx | 7 +--- .../components/SubforestTables/Columns.tsx | 2 +- 16 files changed, 74 insertions(+), 67 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 3813079a9..cea221ff9 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -320,7 +320,7 @@ microarchWithProtos ioSync = defineNetwork "net1" ioSync $ do addPrototype "mul{x}" MultiplierIO addPrototype "accum{x}" AccumIO addPrototype "div{x}" DividerIO - add "spi" $ -- use addPrototype when https://github.com/ryukzak/nitta/issues/194 will be fixed + add "spi" $ -- FIXME: use addPrototype when https://github.com/ryukzak/nitta/issues/194 will be fixed SPISlave { slave_mosi = InputPortTag "mosi" , slave_miso = OutputPortTag "miso" diff --git a/examples/microarch.toml b/examples/microarch.toml index 2e19d8746..8ed5cfcf5 100644 --- a/examples/microarch.toml +++ b/examples/microarch.toml @@ -43,4 +43,4 @@ isInt = true type = "Divider" name = "div{x}" mock = true -pipeline = 4 \ No newline at end of file +pipeline = 4 diff --git a/src/NITTA/Model/Microarchitecture/Config.hs b/src/NITTA/Model/Microarchitecture/Config.hs index bdc2b6f27..60f32e85b 100644 --- a/src/NITTA/Model/Microarchitecture/Config.hs +++ b/src/NITTA/Model/Microarchitecture/Config.hs @@ -1,15 +1,11 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PartialTypeSignatures #-} -{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} - -{-# HLINT ignore "Use forM_" #-} module NITTA.Model.Microarchitecture.Config ( mkMicroarchitecture, ) where -import Control.Monad.State (when) import Data.Aeson ( FromJSON (parseJSON), Options (sumEncoding), @@ -21,7 +17,6 @@ import Data.Aeson ( ) import Data.Default (Default (def)) import Data.HashMap.Internal.Strict (HashMap) -import Data.Maybe (fromJust, isJust) import Data.Text qualified as T import GHC.Generics (Generic) import NITTA.Intermediate.Value (Val) @@ -83,8 +78,8 @@ instance FromJSON PUConf where data NetworkConf = NetworkConf { name :: T.Text - , pus :: Maybe [PUConf] - , protos :: Maybe [PUConf] + , pus :: [PUConf] + , protos :: [PUConf] } deriving (Generic, Show) @@ -105,8 +100,8 @@ mkMicroarchitecture ioSync toml = | proto = addCustomPrototype | otherwise = addCustom build NetworkConf{pus, protos} = do - when (isJust pus) $ mapM_ (configure False) $ fromJust pus - when (isJust protos) $ mapM_ (configure True) $ fromJust protos + mapM_ (configure False) pus + mapM_ (configure True) protos where configure proto Accum{name} = addPU proto name def PU.AccumIO configure proto Divider{name, pipeline, mock} = addPU proto name (PU.divider pipeline mock) PU.DividerIO @@ -132,6 +127,6 @@ mkMicroarchitecture ioSync toml = } nets = networks (getFromToml toml :: MicroarchitectureConf) mkNetwork net@NetworkConf{name} = modifyNetwork (busNetwork name ioSync) (build net) - in if length nets > 1 - then error "multi-networks are not currently supported" - else mkNetwork (head nets) + in case nets of + [n] -> mkNetwork n + _ -> error "multi-networks are not currently supported" diff --git a/src/NITTA/Model/Networks/Bus.hs b/src/NITTA/Model/Networks/Bus.hs index f594ecafd..7bdb1fc95 100644 --- a/src/NITTA/Model/Networks/Bus.hs +++ b/src/NITTA/Model/Networks/Bus.hs @@ -187,7 +187,7 @@ instance (UnitTag tag, VarValTime v x t) => DataflowProblem (BusNetwork tag v x instance (UnitTag tag, VarValTime v x t) => ProcessorUnit (BusNetwork tag v x t) v x t where tryBind f net@BusNetwork{bnRemains, bnPus, bnPUPrototypes} | any (allowToProcess f) (M.elems bnPus) = Right net{bnRemains = f : bnRemains} - -- TODO + -- TODO: -- There are several issues that need to be addressed: see https://github.com/ryukzak/nitta/pull/195#discussion_r853486450 -- 1) Now the binding of functions to the network is hardcoded, that prevents use of an empty uarch at the start -- 2) If Allocation options are independent of the bnRemains, then they are present in all synthesis states, which means no leaves in the synthesis tree @@ -423,26 +423,26 @@ instance (UnitTag tag) => AllocationProblem (BusNetwork tag v x t) tag where allocationOptions BusNetwork{bnName, bnRemains, bnPUPrototypes} = map toOptions $ M.keys $ M.filter (\PUPrototype{pProto} -> any (`allowToProcess` pProto) bnRemains) bnPUPrototypes where - toOptions puTag = + toOptions processUnitTag = Allocation - { bnTag = bnName - , puTag + { networkTag = bnName + , processUnitTag } - allocationDecision bn@BusNetwork{bnPUPrototypes, bnPus, bnProcess} alloc@Allocation{bnTag, puTag} = - let tag = bnTag <> "_" <> fromTemplate puTag (show (length bnPus)) + allocationDecision bn@BusNetwork{bnPUPrototypes, bnPus, bnProcess} alloc@Allocation{networkTag, processUnitTag} = + let tag = networkTag <> "_" <> fromTemplate processUnitTag (show (length bnPus)) prototype = - if M.member puTag bnPUPrototypes - then bnPUPrototypes M.! puTag - else error $ "No suitable prototype for the tag (" <> toString puTag <> ")" + if M.member processUnitTag bnPUPrototypes + then bnPUPrototypes M.! processUnitTag + else error $ "No suitable prototype for the tag (" <> toString processUnitTag <> ")" addPU t PUPrototype{pProto, pIOPorts} = modifyNetwork bn $ do addCustom t pProto pIOPorts nBn = addPU tag prototype in nBn { bnProcess = execScheduleWithProcess bn bnProcess $ scheduleAllocation alloc , bnPUPrototypes = - if isTemplate puTag + if isTemplate processUnitTag then bnPUPrototypes - else M.delete puTag bnPUPrototypes + else M.delete processUnitTag bnPUPrototypes } -------------------------------------------------------------------------- diff --git a/src/NITTA/Model/Networks/Types.hs b/src/NITTA/Model/Networks/Types.hs index 0626f16c2..49e70cb82 100644 --- a/src/NITTA/Model/Networks/Types.hs +++ b/src/NITTA/Model/Networks/Types.hs @@ -178,7 +178,7 @@ data PUPrototype tag v x t where { pTag :: tag -- ^Prototype tag. You can specify tag as a template by adding {x}. -- This will allow to allocate PU more than once by replacing {x} with index. - -- When PU is allocated puTag will look like bnName_pTag. + -- When PU is allocated processUnitTag will look like bnName_pTag. , pProto :: pu -- ^PU prototype , pIOPorts :: IOPorts pu diff --git a/src/NITTA/Model/Problems/Allocation.hs b/src/NITTA/Model/Problems/Allocation.hs index 137a843dd..57f2a5704 100644 --- a/src/NITTA/Model/Problems/Allocation.hs +++ b/src/NITTA/Model/Problems/Allocation.hs @@ -6,7 +6,7 @@ {- | Module : NITTA.Model.Problems.Allocation Description : PU allocation on the bus network -Copyright : (c) Aleksandr Penskoi, 2022 +Copyright : (c) Aleksandr Penskoi, Vitaliy Zakusilo, 2022 License : BSD3 Maintainer : aleksandr.penskoi@gmail.com Stability : experimental @@ -20,15 +20,15 @@ import Data.String.ToString (ToString (..)) import GHC.Generics (Generic) data Allocation tag = Allocation - { bnTag :: tag + { networkTag :: tag -- ^Tag of the BusNetwork where PU will be allocated - , puTag :: tag + , processUnitTag :: tag -- ^Tag of the prototype that will be used for allocation } deriving (Generic, Eq) instance (ToString tag) => Show (Allocation tag) where - show Allocation{bnTag, puTag} = "Allocation of " <> toString puTag <> " on " <> toString bnTag + show Allocation{networkTag, processUnitTag} = "Allocation of " <> toString processUnitTag <> " on " <> toString networkTag class AllocationProblem u tag | u -> tag where allocationOptions :: u -> [Allocation tag] diff --git a/src/NITTA/Model/Problems/ViewHelper.hs b/src/NITTA/Model/Problems/ViewHelper.hs index 07909bfa7..ec315a4ca 100644 --- a/src/NITTA/Model/Problems/ViewHelper.hs +++ b/src/NITTA/Model/Problems/ViewHelper.hs @@ -36,8 +36,8 @@ data DecisionView , pu :: T.Text } | AllocationView - { bnTag :: T.Text - , puTag :: T.Text + { networkTag :: T.Text + , processUnitTag :: T.Text } | DataflowDecisionView { source :: (T.Text, EndpointSt T.Text (Interval Int)) @@ -70,10 +70,10 @@ instance (UnitTag tag) => Viewable (Bind tag v x) DecisionView where } instance (UnitTag tag) => Viewable (Allocation tag) DecisionView where - view Allocation{bnTag, puTag} = + view Allocation{networkTag, processUnitTag} = AllocationView - { bnTag = toText bnTag - , puTag = toText puTag + { networkTag = toText networkTag + , processUnitTag = toText processUnitTag } instance (UnitTag tag, Var v, Time t) => Viewable (DataflowSt tag v (Interval t)) DecisionView where diff --git a/src/NITTA/Model/TargetSystem.hs b/src/NITTA/Model/TargetSystem.hs index bcccda532..116142b8e 100644 --- a/src/NITTA/Model/TargetSystem.hs +++ b/src/NITTA/Model/TargetSystem.hs @@ -63,7 +63,7 @@ instance instance (BindProblem u tag v x) => BindProblem (TargetSystem u tag v x t) tag v x where bindOptions TargetSystem{mUnit} = bindOptions mUnit - bindDecision f@TargetSystem{mUnit} d = f{mUnit = bindDecision mUnit d} + bindDecision ts@TargetSystem{mUnit} d = ts{mUnit = bindDecision mUnit d} instance (DataflowProblem u tag v t) => DataflowProblem (TargetSystem u tag v x t) tag v t where dataflowOptions TargetSystem{mUnit} = dataflowOptions mUnit diff --git a/src/NITTA/Synthesis/Method.hs b/src/NITTA/Synthesis/Method.hs index 72ee8e71a..cf1f298f1 100644 --- a/src/NITTA/Synthesis/Method.hs +++ b/src/NITTA/Synthesis/Method.hs @@ -125,7 +125,9 @@ allBestThreadIO n tree = do bestLeaf :: (VarValTime v x t, UnitTag tag) => DefTree tag v x t -> [DefTree tag v x t] -> DefTree tag v x t bestLeaf tree leafs = let successLeafs = filter (\node -> isComplete node && isLeaf node) leafs - target = sTarget . sState in case successLeafs of - _ : _ -> minimumOn (\l -> (processDuration $ target l, puSize $ target l)) successLeafs + _ : _ -> + minimumOn + (\Tree{sState = SynthesisState{sTarget}} -> (processDuration sTarget, puSize sTarget)) + successLeafs [] -> headDef tree leafs diff --git a/src/NITTA/Synthesis/Steps/Allocation.hs b/src/NITTA/Synthesis/Steps/Allocation.hs index a29df3155..fa705e189 100644 --- a/src/NITTA/Synthesis/Steps/Allocation.hs +++ b/src/NITTA/Synthesis/Steps/Allocation.hs @@ -8,7 +8,7 @@ {- | Module : NITTA.Synthesis.Steps.Allocation Description : Implementation of SynthesisDecisionCls that allows to allocate PUs -Copyright : (c) Aleksandr Penskoi, 2022 +Copyright : (c) Aleksandr Penskoi, Vitaliy Zakusilo, 2022 License : BSD3 Maintainer : aleksandr.penskoi@gmail.com Stability : experimental @@ -24,7 +24,7 @@ import NITTA.Intermediate.Analysis (ProcessWave (ProcessWave, pwFs)) import NITTA.Model.Networks.Bus (BusNetwork (bnPUPrototypes, bnPus, bnRemains)) import NITTA.Model.Networks.Types (PU (PU, unit), PUPrototype (..)) import NITTA.Model.Problems.Allocation ( - Allocation (Allocation, puTag), + Allocation (Allocation, processUnitTag), AllocationProblem (allocationDecision), ) import NITTA.Model.ProcessorUnits.Types ( @@ -66,9 +66,9 @@ instance where decisions SynthesisState{sTarget} o = [(o, allocationDecision sTarget o)] - parameters SynthesisState{sTarget = TargetSystem{mUnit}, processWaves, numberOfProcessWaves} Allocation{puTag} _ = + parameters SynthesisState{sTarget = TargetSystem{mUnit}, processWaves, numberOfProcessWaves} Allocation{processUnitTag} _ = let pus = M.elems $ bnPus mUnit - tmp = bnPUPrototypes mUnit M.! puTag + tmp = bnPUPrototypes mUnit M.! processUnitTag mParallelism PUPrototype{pProto} = parallelismType pProto canProcessTmp PUPrototype{pProto} f = allowToProcess f pProto canProcessPU PU{unit} f = allowToProcess f unit diff --git a/src/NITTA/Synthesis/Steps/Dataflow.hs b/src/NITTA/Synthesis/Steps/Dataflow.hs index 2f7941676..497d2d971 100644 --- a/src/NITTA/Synthesis/Steps/Dataflow.hs +++ b/src/NITTA/Synthesis/Steps/Dataflow.hs @@ -54,7 +54,7 @@ data DataflowMetrics = DataflowMetrics , pNotTransferableInputs :: [Float] -- ^number of variables, which is not transferable for affected -- functions. - , pWaveOfUse :: Float + , pFirstWaveOfTargetUse :: Float -- ^number of the first wave in which one of the target variables is used } deriving (Generic) @@ -76,7 +76,10 @@ instance let TimeConstraint{tcAvailable, tcDuration} = epAt $ snd dfSource vs = unionsMap (variables . snd) dfTargets lvs = length vs - waveNum = length . takeWhile (\ProcessWave{pwFs} -> lvs == length (vs `S.difference` unionsMap inputs pwFs)) $ processWaves + waveNum = + length + . takeWhile (\ProcessWave{pwFs} -> lvs == length (vs `S.difference` unionsMap inputs pwFs)) + $ processWaves in DataflowMetrics { pWaitTime = fromIntegral (inf tcAvailable) , pRestrictedTime = fromEnum (sup tcDuration) /= maxBound @@ -85,18 +88,27 @@ instance affectedFunctions = filter (\f -> not $ null (inputs f `S.intersection` vs)) fs notTransferableVars = map (\f -> inputs f S.\\ transferableVars) affectedFunctions in map (fromIntegral . length) notTransferableVars - , pWaveOfUse = fromIntegral waveNum :: Float + , pFirstWaveOfTargetUse = fromIntegral waveNum :: Float } - estimate SynthesisState{numberOfDataflowOptions} _o _d DataflowMetrics{pWaitTime, pNotTransferableInputs, pRestrictedTime, pWaveOfUse} = - 2000 - + (numberOfDataflowOptions >= threshold) - 1000 - + pRestrictedTime - 200 - - sum pNotTransferableInputs - * 5 - - pWaitTime - - pWaveOfUse + estimate + SynthesisState{numberOfDataflowOptions} + _o + _d + DataflowMetrics + { pWaitTime + , pNotTransferableInputs + , pRestrictedTime + , pFirstWaveOfTargetUse + } = + 2000 + + (numberOfDataflowOptions >= threshold) + 1000 + + pRestrictedTime + 200 + - sum pNotTransferableInputs + * 5 + - pWaitTime + - pFirstWaveOfTargetUse threshold = 20 diff --git a/src/NITTA/UIBackend/ViewHelper.hs b/src/NITTA/UIBackend/ViewHelper.hs index dc3390d36..6146a7ce7 100644 --- a/src/NITTA/UIBackend/ViewHelper.hs +++ b/src/NITTA/UIBackend/ViewHelper.hs @@ -243,7 +243,7 @@ instance ToSample (NodeView tag v x t) where { pWaitTime = 1 , pRestrictedTime = False , pNotTransferableInputs = [0, 0] - , pWaveOfUse = 0 + , pFirstWaveOfTargetUse = 0 } , decision = DataflowDecisionView diff --git a/test/NITTA/Model/ProcessorUnits/Tests/DSL.hs b/test/NITTA/Model/ProcessorUnits/Tests/DSL.hs index 747f72333..68174a526 100644 --- a/test/NITTA/Model/ProcessorUnits/Tests/DSL.hs +++ b/test/NITTA/Model/ProcessorUnits/Tests/DSL.hs @@ -456,9 +456,9 @@ doTransfer vs = do Nothing -> lift $ assertFailure $ "can't find transfer for: " <> show vs <> " in: " <> show opts doAllocation :: T.Text -> T.Text -> TSStatement x () -doAllocation bnTag puTag = do +doAllocation networkTag processUnitTag = do st@UnitTestState{unit = ts} <- get - let d = Allocation{bnTag = bnTag, puTag = puTag} + let d = Allocation{networkTag = networkTag, processUnitTag = processUnitTag} opts = allocationOptions ts unless (d `L.elem` opts) $ lift $ @@ -526,10 +526,11 @@ assertEmptyDataFlow = do error "assertEmptyDataFlow: dataflow should be empty" mkAllocation :: T.Text -> T.Text -> Statement u v x (Allocation T.Text) -mkAllocation bnTag puTag = return Allocation{bnTag, puTag} +mkAllocation networkTag processUnitTag = return Allocation{networkTag, processUnitTag} mkAllocationOptions :: (Typeable tag, UnitTag tag) => tag -> [tag] -> Statement u v x [Allocation tag] -mkAllocationOptions bnTag puTags = return $ map (\puTag -> Allocation{bnTag, puTag}) puTags +mkAllocationOptions networkTag puTags = + return $ map (\processUnitTag -> Allocation{networkTag, processUnitTag}) puTags assertAllocation :: (Typeable a, Eq a, Show a) => Int -> a -> TSStatement x () assertAllocation number alloc = do diff --git a/test/NITTA/Model/ProcessorUnits/Tests/DSL/Tests.hs b/test/NITTA/Model/ProcessorUnits/Tests/DSL/Tests.hs index 3c659d5da..05a28f8a5 100644 --- a/test/NITTA/Model/ProcessorUnits/Tests/DSL/Tests.hs +++ b/test/NITTA/Model/ProcessorUnits/Tests/DSL/Tests.hs @@ -324,7 +324,7 @@ tests = Bus.addCustomPrototype "fram{x}" (framWithSize 32) FramIO Bus.addPrototype "accum{x}" AccumIO Bus.addPrototype "mul{x}" MultiplierIO - Bus.add "spi" $ -- use addPrototype when https://github.com/ryukzak/nitta/issues/194 will be fixed + Bus.add "spi" $ -- FIXME: use addPrototype when https://github.com/ryukzak/nitta/issues/194 will be fixed SPISlave { slave_mosi = InputPortTag "mosi" , slave_miso = OutputPortTag "miso" diff --git a/web/src/components/SubforestTables.tsx b/web/src/components/SubforestTables.tsx index a08f44055..2aaa159a6 100644 --- a/web/src/components/SubforestTables.tsx +++ b/web/src/components/SubforestTables.tsx @@ -77,10 +77,7 @@ export const SubforestTables: FC = ({ nodes }) => { - e.decision.tag !== "DataflowDecisionView" && - e.decision.tag !== "BindDecisionView" && - e.decision.tag !== "AllocationView" + (e) => !["DataflowDecisionView", "BindDecisionView", "AllocationView"].includes(e.decision.tag) )} columns={[ sidColumn(appContext.setSID), @@ -120,7 +117,7 @@ export const SubforestTables: FC = ({ nodes }) => { 60 ), textColumn("restricted", (e: Node) => String((e.parameters as DataflowMetrics).pRestrictedTime), 60), - textColumn("wave of use", (e: Node) => String((e.parameters as DataflowMetrics).pWaveOfUse), 60), + textColumn("first wave of target use", (e: Node) => String((e.parameters as DataflowMetrics).pFirstWaveOfTargetUse), 60), detailColumn(), ]} /> diff --git a/web/src/components/SubforestTables/Columns.tsx b/web/src/components/SubforestTables/Columns.tsx index 19224d51d..0003f9d87 100644 --- a/web/src/components/SubforestTables/Columns.tsx +++ b/web/src/components/SubforestTables/Columns.tsx @@ -212,7 +212,7 @@ export function showResolveDeadlock(decision: ResolveDeadlock): ReactElement { export function showAllocation(decision: Allocation): ReactElement { return (
- {decision.bnTag} {decision.puTag} + {decision.networkTag} {decision.processUnitTag}
); }