never executed always true always false
    1 {-# LANGUAGE ConstraintKinds #-}
    2 {-# LANGUAGE TypeFamilies #-}
    3 
    4 {- |
    5 Module      : NITTA.Intermediate.Analysis
    6 Description : Analysis of the process execution flow
    7 Copyright   : (c) Aleksandr Penskoi, 2022
    8 License     : BSD3
    9 Maintainer  : aleksandr.penskoi@gmail.com
   10 Stability   : experimental
   11 
   12 Much of the work in this module focuses on building waves of process execution.
   13 In this case, we call a wave a set of functions that are ready for execution (all input vars are ready to use)
   14 and that can be performed independently of each other.
   15 Example:
   16 
   17 Lua code:
   18 
   19 @
   20 function sum(a)
   21     local d = a + 1
   22     sum(d)
   23 end
   24 sum(0)
   25 @
   26 
   27 After building DataFlowGraph, we get the following set of functions:
   28 
   29 @
   30 - const(1) = !1#0
   31 - loop(0, d^0#0) = a^0#0
   32 - a^0#0 + !1#0 = d^0#0
   33 @
   34 
   35 Const and Loop function can be executed at the first wave because all input variables are ready to use.
   36 After executing first wave a^0#0 and !1#0 will be ready, so we will be able to execute add function.
   37 So the resulting process waves are the following:
   38 
   39 @
   40 [
   41     ProcessWave {
   42         pwFs = [const(1) = !1#0,loop(0, d^0#0) = a^0#0],
   43         pwOut = fromList ["!1#0","a^0#0"]
   44     },
   45     ProcessWave {
   46         pwFs = [a^0#0 + !1#0 = d^0#0],
   47         pwOut = fromList ["d^0#0"]
   48     }
   49 ]
   50 @
   51 -}
   52 module NITTA.Intermediate.Analysis (
   53     ProcessWave (..),
   54     buildProcessWaves,
   55     reorderAlgorithm,
   56     estimateVarWaves,
   57 ) where
   58 
   59 import Data.List qualified as L
   60 import Data.Map qualified as M
   61 import Data.Set qualified as S
   62 import GHC.Generics
   63 import NITTA.Intermediate.Functions
   64 import NITTA.Intermediate.Types
   65 import NITTA.Utils.Base
   66 
   67 data ProcessWave v x = ProcessWave
   68     { pwFs :: [F v x]
   69     -- ^ Functions that can be executed at this wave
   70     , pwOut :: S.Set v
   71     -- ^ Set of output variables related to the functions from this step
   72     }
   73     deriving (Show, Generic)
   74 
   75 data Builder v x = Builder
   76     { pwRemains :: S.Set (F v x)
   77     -- ^ Functions that can be calculated due to lack of ready input values
   78     , pwIn :: S.Set v
   79     -- ^ Variables that defined at the beginning of the process
   80     , pwReadyIn :: S.Set v
   81     -- ^ Variables that is ready to be used us inputs
   82     , pwGraph :: [ProcessWave v x]
   83     -- ^ Resulting process flow
   84     }
   85     deriving (Show, Generic)
   86 
   87 {- |
   88 Sort functions in order of execution.
   89 Note that some function could be executed in parallel, in this case we save order from the source list.
   90 -}
   91 reorderAlgorithm :: (Var v, Val x) => [F v x] -> [F v x]
   92 reorderAlgorithm alg = concatMap pwFs $ buildProcessWaves [] alg
   93 
   94 {- |
   95 Functions can be divided into waves of execution.
   96 For each output variable, we define the wave number on which the variable will be defined.
   97 -}
   98 estimateVarWaves :: (Var v, Val x, Num a) => [v] -> [F v x] -> M.Map v a
   99 estimateVarWaves alreadyVars fs = M.fromList $ go 0 $ buildProcessWaves alreadyVars fs
  100     where
  101         go n (ProcessWave{pwFs} : pss) = go (n + 1) pss <> [(out, n) | out <- S.toList $ unionsMap outputs pwFs]
  102         go _ [] = []
  103 
  104 -- | Divide function into execution waves.
  105 buildProcessWaves :: (Var v, Val x) => [v] -> [F v x] -> [ProcessWave v x]
  106 buildProcessWaves vars fs =
  107     let pwIn = S.fromList vars
  108         (loops, other) = L.partition isLoop fs
  109         beginning =
  110             -- Place all loops at the beginning of the algorithm to avoid circular dependencies in functions.
  111             [ ProcessWave
  112                 { pwFs = loops
  113                 , pwOut = unionsMap outputs loops
  114                 }
  115             | not (null loops)
  116             ]
  117         builder =
  118             Builder
  119                 { pwRemains = S.fromList other
  120                 , pwGraph = beginning
  121                 , pwIn
  122                 , pwReadyIn = pwIn `S.union` unionsMap pwOut beginning
  123                 }
  124      in pwGraph $ execBuilder builder 0
  125 
  126 execBuilder :: Ord v => Builder v x -> Int -> Builder v x
  127 execBuilder builder@Builder{pwRemains} prev
  128     | S.null pwRemains = builder
  129     | S.size pwRemains == prev = error "Process waves construction stuck in a loop"
  130     | otherwise = execBuilder (foldl applyRemaining builder pwRemains) $ S.size pwRemains
  131 
  132 applyRemaining :: Ord v => Builder v x -> F v x -> Builder v x
  133 applyRemaining builder@Builder{pwRemains, pwGraph, pwIn, pwReadyIn} func =
  134     let fIn = inputs func
  135         fOut = outputs func
  136         pendingIn = S.difference fIn pwReadyIn
  137      in if not $ null pendingIn
  138             then builder
  139             else
  140                 builder
  141                     { pwReadyIn = S.union fOut pwReadyIn
  142                     , pwGraph = insertF func (S.difference fIn pwIn) fOut pwGraph
  143                     , pwRemains = S.delete func pwRemains
  144                     }
  145 
  146 insertF :: Ord v => F v x -> S.Set v -> S.Set v -> [ProcessWave v x] -> [ProcessWave v x]
  147 insertF f fIn fOut []
  148     | null fIn = [ProcessWave{pwFs = [f], pwOut = fOut}]
  149     | otherwise = error "Cannot calculate process wave for the function"
  150 insertF f fIn fOut (ps@ProcessWave{pwFs, pwOut} : pss)
  151     | null fIn = ps{pwFs = f : pwFs, pwOut = S.union fOut pwOut} : pss
  152     | otherwise = ps : insertF f (S.difference fIn pwOut) fOut pss