diff --git a/src/NITTA/Model/IntegrityCheck.hs b/src/NITTA/Model/IntegrityCheck.hs index 3b3ca47ff..98e43a176 100644 --- a/src/NITTA/Model/IntegrityCheck.hs +++ b/src/NITTA/Model/IntegrityCheck.hs @@ -57,7 +57,7 @@ checkIntegrity pu = checkEndpointToIntermidiateRelation eps ifs pr = S.isSubsetOf makeRelationList rels where - rels = S.fromList $ relations pr + rels = S.fromList $ filter isVertical $ relations pr findRel (h, l) = if length l > 1 then Vertical h $ fst $ findJust (\(k, _) -> Vertical h k `elem` rels) l @@ -75,7 +75,7 @@ checkEndpointToIntermidiateRelation eps ifs pr = S.isSubsetOf makeRelationList r checkInstructionToEndpointRelation ins eps pr = and makeRelationList where - rels = S.fromList $ map (\(Vertical r1 r2) -> (r1, r2)) $ relations pr + rels = S.fromList $ map (\(Vertical r1 r2) -> (r1, r2)) $ filter isVertical $ relations pr eps' = M.fromList $ concat $ M.elems eps makeRelationList = concatMap diff --git a/src/NITTA/Model/Networks/Bus.hs b/src/NITTA/Model/Networks/Bus.hs index 5e23628f3..b8c52552d 100644 --- a/src/NITTA/Model/Networks/Bus.hs +++ b/src/NITTA/Model/Networks/Bus.hs @@ -200,7 +200,7 @@ instance (UnitTag tag, VarValTime v x t) => ProcessorUnit (BusNetwork tag v x t) mapM_ ( \(epKey, v) -> when (v `M.member` v2transportStepKey) $ - establishVerticalRelation (v2transportStepKey M.! v) epKey + establishVerticalRelations [v2transportStepKey M.! v] [epKey] ) enpointStepKeyVars @@ -210,7 +210,7 @@ instance (UnitTag tag, VarValTime v x t) => ProcessorUnit (BusNetwork tag v x t) mapM_ ( \v -> when (v `M.member` v2transportStepKey) $ - establishVerticalRelation pID (v2transportStepKey M.! v) + establishVerticalRelations [pID] [v2transportStepKey M.! v] ) $ variables f ) @@ -227,7 +227,12 @@ instance (UnitTag tag, VarValTime v x t) => ProcessorUnit (BusNetwork tag v x t) return (pID, pID') ) steps - mapM_ (\(Vertical h l) -> establishVerticalRelation (pu2netKey M.! h) (pu2netKey M.! l)) relations + mapM_ + ( \case + (Vertical h l) -> establishVerticalRelations [pu2netKey M.! h] [pu2netKey M.! l] + (Horizontal h l) -> establishHorizontalRelations [pu2netKey M.! h] [pu2netKey M.! l] + ) + relations instance Controllable (BusNetwork tag v x t) where data Instruction (BusNetwork tag v x t) diff --git a/src/NITTA/Model/ProcessorUnits/Accum.hs b/src/NITTA/Model/ProcessorUnits/Accum.hs index 3176708ca..40b56b8a7 100644 --- a/src/NITTA/Model/ProcessorUnits/Accum.hs +++ b/src/NITTA/Model/ProcessorUnits/Accum.hs @@ -188,10 +188,9 @@ instance (VarValTime v x t, Num x) => EndpointProblem (Accum v x t) v t where (_, process_') = runSchedule pu $ do endpoints <- scheduleEndpoint d $ scheduleInstruction (epAt -1) Out when (null tasks') $ do - high <- scheduleFunction (a ... sup epAt) func - let low = endpoints ++ map pID (relatedEndpoints process_ $ variables func) - establishVerticalRelations high low - + -- FIXME: here ([]) you can see the source of error. + -- Function don't connected to bind step. It should be fixed. + scheduleFunctionFinish [] func $ a ... sup epAt updateTick (sup epAt) return endpoints in pu diff --git a/src/NITTA/Model/ProcessorUnits/Broken.hs b/src/NITTA/Model/ProcessorUnits/Broken.hs index cfffba59b..c3960245e 100644 --- a/src/NITTA/Model/ProcessorUnits/Broken.hs +++ b/src/NITTA/Model/ProcessorUnits/Broken.hs @@ -143,6 +143,7 @@ instance (VarValTime v x t) => EndpointProblem (Broken v x t) v t where let res = scheduleEndpoint d $ if lostVerticalRelation then fmap (const []) ins else ins endpoints <- res when (null sources') $ do + -- TODO: migrate to scheduleFunctionFinish high <- scheduleFunction (a ... sup epAt) f let low = endpoints ++ currentWorkEndpoints uncurry establishVerticalRelations $ if lostVerticalRelation then ([], []) else (high, low) diff --git a/src/NITTA/Model/ProcessorUnits/Fram.hs b/src/NITTA/Model/ProcessorUnits/Fram.hs index 822a78a2b..eb3ef0cc4 100644 --- a/src/NITTA/Model/ProcessorUnits/Fram.hs +++ b/src/NITTA/Model/ProcessorUnits/Fram.hs @@ -258,7 +258,8 @@ 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) + + establishHorizontalRelations binds (f1 ++ f2 ++ revoke) 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/Multiplier.hs b/src/NITTA/Model/ProcessorUnits/Multiplier.hs index ba27aa99b..ceef2fc44 100644 --- a/src/NITTA/Model/ProcessorUnits/Multiplier.hs +++ b/src/NITTA/Model/ProcessorUnits/Multiplier.hs @@ -527,11 +527,12 @@ instance (VarValTime v x t) => EndpointProblem (Multiplier v x t) v t where let (_, process_') = runSchedule pu $ do endpoints <- scheduleEndpoint d $ scheduleInstruction epAt Out when (null sources') $ do - high <- scheduleFunction (a ... sup epAt) f - let low = endpoints ++ map pID (relatedEndpoints process_ $ variables f) -- Set up the vertical relantions between functional unit -- and related to that data sending. - establishVerticalRelations high low + + -- FIXME: here ([]) you can see the source of error. + -- Function don't connected to bind step. It should be fixed. + scheduleFunctionFinish [] f $ a ... sup epAt -- this is needed to correct work of automatically generated tests -- that takes time about time from Process updateTick (sup epAt) diff --git a/src/NITTA/Model/ProcessorUnits/Shift.hs b/src/NITTA/Model/ProcessorUnits/Shift.hs index 6bb5a74ae..feea6f0f9 100644 --- a/src/NITTA/Model/ProcessorUnits/Shift.hs +++ b/src/NITTA/Model/ProcessorUnits/Shift.hs @@ -189,9 +189,9 @@ instance (VarValTime v x t) => EndpointProblem (Shift v x t) v t where updateTick (sup epAt) endpoints <- scheduleEndpoint d $ scheduleInstruction (shiftI (-1) epAt) Out when (null sources') $ do - high <- scheduleFunction (a ... sup epAt) f - let low = endpoints ++ map pID (relatedEndpoints process_ $ variables f) - establishVerticalRelations high low + -- FIXME: here ([]) you can see the source of error. + -- Function don't connected to bind step. It should be fixed. + scheduleFunctionFinish [] f $ a ... sup epAt return endpoints in pu { process_ = process_' diff --git a/src/NITTA/Model/ProcessorUnits/Types.hs b/src/NITTA/Model/ProcessorUnits/Types.hs index 6ebd0ab8b..13180e178 100644 --- a/src/NITTA/Model/ProcessorUnits/Types.hs +++ b/src/NITTA/Model/ProcessorUnits/Types.hs @@ -33,6 +33,8 @@ module NITTA.Model.ProcessorUnits.Types ( Step (..), StepInfo (..), Relation (..), + isVertical, + isHorizontal, descent, whatsHappen, extractInstructionAt, @@ -208,8 +210,18 @@ data Relation -- step (function execution) can be translated to a sequence of endpoint -- steps (receiving and sending variable), and process unit instructions. Vertical ProcessStepID ProcessStepID + | -- |Horizontal relationships (on one level). For example, we bind the + -- function and apply the refactoring. The binding step should be + -- connected to refactoring steps, including new binding steps. + Horizontal ProcessStepID ProcessStepID deriving (Show, Eq, Generic, Ord) +isVertical Vertical{} = True +isVertical _ = False + +isHorizontal Horizontal{} = True +isHorizontal _ = False + instance ToJSON Relation whatsHappen t Process{steps} = filter (atSameTime t . pInterval) steps diff --git a/src/NITTA/Utils/ProcessDescription.hs b/src/NITTA/Utils/ProcessDescription.hs index 0345528b5..a93704aee 100644 --- a/src/NITTA/Utils/ProcessDescription.hs +++ b/src/NITTA/Utils/ProcessDescription.hs @@ -29,7 +29,7 @@ module NITTA.Utils.ProcessDescription ( scheduleInstruction, scheduleNestedStep, establishVerticalRelations, - establishVerticalRelation, + establishHorizontalRelations, getProcessSlice, relatedEndpoints, castInstruction, @@ -102,7 +102,7 @@ scheduleStep' mkStep = do return [nextUid] {- |Add to the process description information about vertical relations, which are defined by the - Cartesian product of high and low lists. +Cartesian product of high and low lists. -} establishVerticalRelations high low = do sch@Schedule{schProcess = p@Process{relations}} <- get @@ -114,14 +114,16 @@ establishVerticalRelations high low = do } } --- |Add to the process description information about vertical relation. -establishVerticalRelation h l = do +{- |Add to the process description information about horizontal relations (inside +level), which are defined by the Cartesian product of high and low lists. +-} +establishHorizontalRelations high low = do sch@Schedule{schProcess = p@Process{relations}} <- get put sch { schProcess = p - { relations = Vertical h l : relations + { relations = [Horizontal h l | h <- high, l <- low] ++ relations } }