module Language.Atom.Partition
  ( partitionRules
  ) where

import Data.List

import Language.Atom.Code
import Language.Atom.Elaboration
import Language.Atom.Expressions

class Weight a where weight :: a -> Int
instance Weight a => Weight [a] where weight = sum . map weight
data Graph a b where Graph :: (Eq a, Eq b, Weight a, Weight b) => [a] -> [(a, b, a)] -> Graph a b
instance (Show a, Show b) => Show (Graph a b) where show (Graph nodes edges) = "Graph " ++ show nodes ++ show edges

instance Weight Rule where weight = ruleComplexity
instance Weight UV   where weight = width

{-
groupCycles :: Graph a b -> Graph [a] [b]
groupCycles (Graph nodes edges) = 
  where
  
  _ = cycles $ map (:[]) nodes

  cycles :: a -> [[a]]
  cycles a path = 
    where
    downstream = [ b | (a', _, b) <- edges, a == a' ]

    cycle :: [a] -> [a]
    cycle a
-}

partitionRules :: [Rule] -> IO ()
partitionRules rules = do
  print $ graphRules rules

graphRules :: [Rule] -> Graph Rule UV
graphRules rules = Graph rules [ (r, uv, w) | uv <- uvs, r <-reads uv, w <- writes uv ] 
  where
  readWrites = map readWrite rules
  (uvs1, _, uvs2) = unzip3 readWrites
  uvs = intersect (nub $ concat uvs1) (nub $ concat uvs2)
  reads  uv = [ rule | (reads,  rule, _) <- readWrites, elem uv reads  ]
  writes uv = [ rule | (_, rule, writes) <- readWrites, elem uv writes ]

readWrite :: Rule -> ([UV], Rule, [UV])
readWrite rule = (nub uvs, rule, nub assignUVs)
  where
  (assignUVs, assignUEs) = unzip $ ruleAssigns rule
  ues = ruleEnable rule : assignUEs ++ concat (snd $ unzip $ ruleActions rule)
  uvs = nub $ concatMap reads ues

  reads :: UE -> [UV]
  reads (UVRef uv) = [uv]
  reads ue = concatMap reads $ ueUpstream ue