-- | Atom rule scheduling.
module Language.Atom.Scheduling
  ( schedule
  ) where

import Control.Monad
import Data.List
import Data.Maybe
import Language.Atom.Code
import Language.Atom.Elaboration
import System.IO
import Text.Printf

schedule :: Name -> [Rule] -> IO (Maybe [[[Rule]]])
schedule name rules = do
  putStrLn "Starting rule scheduling..."
  hFlush stdout
  putStrLn $ "Writing scheduling report (" ++ name ++ ".rpt)..."
  writeFile (name ++ ".rpt") $ reportSchedule periods
  hFlush stdout
  return $ Just periods
  where

  periods = map spread $ zip [1..] $ map rulesWithPeriod [1 .. maxPeriod]  -- XXX No scheduling done.

  maxPeriod = maximum $ map rulePeriod rules

  rulesWithPeriod :: Int -> [Rule]
  rulesWithPeriod p = [ r | r <- rules, rulePeriod r == p ]

  spread :: (Int, [Rule]) -> [[Rule]]
  spread (0, []) = []
  spread (0, _)  = error "Scheduling.spread"
  spread (period, rules) = take rulesInCycle rules : spread (period - 1, drop rulesInCycle rules)
    where
    rulesInCycle = (length rules `div` period) + (if length rules `mod` period > 0 then 1 else 0)


reportSchedule :: [[[Rule]]] -> String
reportSchedule s = "Rule Scheduling Report\n\n  Period  Cycle  Exprs  Rule\n  ------  -----  -----  ----\n" ++ (concatMap reportPeriod) (zip [1..] s) ++
                   "                 -----\n" ++
                   printf "                 %5i\n" (sum $ map ruleComplexity (concat (concat s)))

reportPeriod (period, p) = concatMap (reportCycle period) (zip [0..] p)

reportCycle period (cycle, c) = concatMap (reportRule period cycle) c

reportRule :: Int -> Int -> Rule -> String
reportRule period cycle rule = printf "  %6i  %5i  %5i  %s\n" period cycle (ruleComplexity rule) (show rule)