never executed always true always false

    1 {-# LANGUAGE GADTs #-}
    2 {-# LANGUAGE QuasiQuotes #-}
    3 
    4 {- |
    5 Module      : NITTA.Intermediate.Simulation
    6 Description : Functional simulation
    7 Copyright   : (c) Aleksandr Penskoi, 2019
    8 License     : BSD3
    9 Maintainer  : aleksandr.penskoi@gmail.com
   10 Stability   : experimental
   11 -}
   12 module NITTA.Intermediate.Simulation (
   13     simulateDataFlowGraph,
   14     simulateAlg,
   15 ) where
   16 
   17 import Data.HashMap.Strict qualified as HM
   18 import Data.Map.Strict qualified as M
   19 import Data.Set (elems)
   20 import Data.String.Interpolate
   21 import NITTA.Intermediate.Analysis (reorderAlgorithm)
   22 import NITTA.Intermediate.Functions
   23 import NITTA.Intermediate.Types
   24 
   25 -- | Functional algorithm simulation
   26 simulateDataFlowGraph ::
   27     (Var v, Val x, WithFunctions g (F v x)) =>
   28     Int ->
   29     CycleCntx v x ->
   30     [(v, [x])] ->
   31     g ->
   32     Cntx v x
   33 simulateDataFlowGraph cycleN cycle0 transmission dfg =
   34     simulateAlg cycleN cycle0 transmission $ reorderAlgorithm $ functions dfg
   35 
   36 simulateAlg ::
   37     (Var v, Val x) =>
   38     Int ->
   39     CycleCntx v x ->
   40     [(v, [x])] ->
   41     [F v x] ->
   42     Cntx v x
   43 simulateAlg cycleN cycle0 transmission alg
   44     | let cycleConnections [] = []
   45           cycleConnections (f : fs)
   46             -- without refactoring
   47             | Just (Loop _ (O ov) (I iv)) <- castF f = (iv, elems ov) : cycleConnections fs
   48             -- after refactoring (BreakLoopD)
   49             | Just (LoopBegin (Loop _ (O ov) (I iv)) _) <- castF f = (iv, elems ov) : cycleConnections fs
   50             | otherwise = cycleConnections fs
   51 
   52           fromPrevCycle = cycleConnections alg =
   53         Cntx
   54             { cntxReceived = M.fromList transmission
   55             , cntxProcess = take cycleN $ simulateAlg' fromPrevCycle cycle0 transmission alg
   56             , cntxCycleNumber = cycleN
   57             }
   58 
   59 simulateAlg' fromPrevCycle cycleCntx0 transmission alg =
   60     let (cycleCntx0', transmission') = receive' cycleCntx0 transmission
   61         cycleCntx = simulateCycle cycleCntx0' alg
   62      in cycleCntx : simulateAlg' fromPrevCycle (throwLoop cycleCntx) transmission' alg
   63     where
   64         -- TODO: receive data for several IO processor unit.
   65         receive' CycleCntx{cycleCntx} trans =
   66             ( CycleCntx $
   67                 foldl
   68                     ( \c (v, xs) ->
   69                         case xs of
   70                             x : _ -> HM.insert v x c
   71                             _ -> c
   72                     )
   73                     cycleCntx
   74                     trans
   75             , map
   76                 ( \(v, xs) ->
   77                     case xs of
   78                         (_ : _) -> (v, tail xs)
   79                         [] -> (v, xs)
   80                 )
   81                 trans
   82             )
   83         throwLoop (CycleCntx cntx) =
   84             CycleCntx $
   85                 HM.fromList $
   86                     foldl
   87                         ( \st (thrown, vs) -> map (\v -> (v, cntx HM.! thrown)) vs ++ st
   88                         )
   89                         []
   90                         fromPrevCycle
   91         simulateCycle cntx00 fs =
   92             foldl
   93                 ( \cntx f ->
   94                     case updateCntx cntx $ simulate cntx f of
   95                         Right cntx' -> cntx'
   96                         Left e -> error [i|can't simulate #{f} in context #{cntx}: #{e}|]
   97                 )
   98                 cntx00
   99                 fs