72 Integrity check for horizontal relations (CADStep relations)

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

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)

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

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)

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}

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)

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_'

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

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
                     }
             }