# LANGUAGE CPP #
module AScheduleInfo (
    AScheduleErrInfo(..),
    AScheduleInfo(..),
    Conflicts(..),
    ExclusiveRulesDB(..),
    FastSchedNode(..),
    RuleRelationDB(..),
    RuleRelationInfo(..),
    SchedNode(..),
    areRulesDisjoint,
    areRulesExclusive,
    defaultRuleRelationship,
    erdbFromList,
    erdbToList,
    getRuleRelation,
    getSchedNodeId,
    isSchedNode,
    printRuleRelationInfo,
    rrdbFromList,
    unionRuleRelationInfo
) where

#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 804)
import Prelude hiding ((<>))
#endif

import qualified Data.Map as M
import qualified Data.Set as S
import Data.List(intersperse)
import Util(thd)
import Eval

import ErrorUtil
import PFPrint
import Position
import Id(cmpIdByName)
import ASyntax
import AUses
import VModInfo(VSchedInfo)
import RSchedule(RAT)


-- ========================================================================
-- Data returned by the aSchedule stage
--

data AScheduleInfo = AScheduleInfo
    {
      -- Warnings during scheduling
      -- (position, tag, msg including position and tag)
      --
      asi_warnings             :: [(Position, String, String)],

  In order of computation in ASchedule :

      -- The method uses map and the rule uses map
      --   They don't have any read method calls used by a rule's assumptions.
    XXX except where necessary to make AState work
      --   The rule uses map also doesn't have the method calls to write a
      --   rule's conflict-free condition wires (the method uses map does
    because AState needs it ) .
      --   This will probably change somehow when we have real runtime errors
      --
      asi_method_uses_map      :: MethodUsesMap,
      asi_rule_uses_map        :: RuleUsesMap,

      asi_resource_alloc_table :: RAT,
      asi_exclusive_rules_db   :: ExclusiveRulesDB,
      asi_sched_order          :: [SchedNode],
      asi_schedule             :: ASchedule,
      asi_sched_graph          :: [(SchedNode, [SchedNode])],
      asi_rule_relation_db     :: RuleRelationDB,
      asi_v_sched_info         :: VSchedInfo
    } deriving (Show)


instance PPrint AScheduleInfo where
    pPrint d p asi =
        text "AScheduleInfo" $+$
        nest 2 (
            text "-- schedule" $+$
            pPrint d 0 (asi_schedule asi) $+$
            text "-- vschedinfo" $+$
            pPrint d 0 (asi_v_sched_info asi) $+$
            text "-- warnings" $+$
            (let ppWarn = vcat . map text . lines
             in  vcat (map (ppWarn . thd) (asi_warnings asi))) $+$
            text "-- method uses map" $+$
            pPrint d 0 (asi_method_uses_map asi) $+$
            text "-- rule uses map" $+$
            pPrint d 0 (asi_rule_uses_map asi) $+$
            text "-- resource allocation table" $+$
            pPrint d 0 (asi_resource_alloc_table asi)
  no dump of DBs , sched graph and order
            )


-- ---------------

-- When the scheduling stage aborts with an error, this data structure
-- contains the available information up to that point (for debugging)
--
data AScheduleErrInfo = AScheduleErrInfo
    {
      -- Warnings during scheduling
      -- (position, tag, msg including position and tag)
      --
      asei_warnings             :: [(Position, String, String)],

      -- Errors during scheduling
      -- (position, tag, msg including position and tag)
      --
      asei_errors               :: [(Position, String, String)],

      -- These are computed initially, and therefore are always available:

      -- The method uses map and the rule uses map
      --   They don't have any read method calls used by a rule's assumptions.
    XXX except where necessary to make AState work
      --   The rule uses map also doesn't have the method calls to write a
      --   rule's conflict-free condition wires (the method uses map does
    because AState needs it ) .
      --   This will probably change somehow when we have real runtime errors
      --
      asei_method_uses_map      :: MethodUsesMap,
      asei_rule_uses_map        :: RuleUsesMap,

      -- The remaining fields may not be available.
      -- In order of computation:
      --
      asei_resource_alloc_table :: Maybe RAT,
      asei_exclusive_rules_db   :: Maybe ExclusiveRulesDB,
      asei_sched_order          :: Maybe [SchedNode],
      asei_schedule             :: Maybe ASchedule,
      asei_sched_graph          :: Maybe [(SchedNode, [SchedNode])],
      asei_rule_relation_db     :: Maybe RuleRelationDB,
      asei_v_sched_info         :: Maybe VSchedInfo
    } deriving (Show)


instance PPrint AScheduleErrInfo where
    pPrint d p asei =
        text "AScheduleErrInfo" $+$
        nest 2 (
            text "-- schedule" $+$
            pPrint d 0 (asei_schedule asei) $+$
            text "-- vschedinfo" $+$
            pPrint d 0 (asei_v_sched_info asei) $+$
            text "-- warnings" $+$
            (let ppWarn = vcat . map text . lines
             in  vcat (map (ppWarn . thd) (asei_warnings asei))) $+$
            text "-- errors" $+$
            (let ppErr = vcat . map text . lines
             in  vcat (map (ppErr . thd) (asei_errors asei))) $+$
            text "-- method uses map" $+$
            pPrint d 0 (asei_method_uses_map asei) $+$
            text "-- rule uses map" $+$
            pPrint d 0 (asei_rule_uses_map asei) $+$
            text "-- resource allocation table" $+$
            pPrint d 0 (asei_resource_alloc_table asei)
  no dump of DBs , sched graph and order
            )


-- ---------------

-- A cache of what is known about whether rules are exclusive (post-scheduling)
  It can be queried for two pieces of information :
-- * Are the CAN_FIRE signals for the rules disjoint?
  * Are the WILL_FIRE signals for the rules disjoint ?
--   (This is a superset which also takes into account rule executions
--    that have been forced to be exclusive due to conflicts etc.)
newtype ExclusiveRulesDB =
    ExclusiveRulesDB (M.Map ARuleId (S.Set ARuleId, S.Set ARuleId))

  Are the WILL_FIRE signals of the rules exclusive ?
  ( Used in Verilog backend for determining if a priority mux is needed . )
-- Note: we check both the disjoint set and the exclusive set, since we
-- do not make a redundant record of exclusivity when it is implied by
-- disjointness.
areRulesExclusive :: ExclusiveRulesDB -> ARuleId -> ARuleId -> Bool
areRulesExclusive (ExclusiveRulesDB exclusive_fmap) r1 r2 =
    let (disj_set, excl_set) = M.findWithDefault (S.empty, S.empty) r1 exclusive_fmap
    in (S.member r2 disj_set) || (S.member r2 excl_set)

-- Are the CAN_FIRE signals of the rules exclusive?
  ( Used in Bluesim backend for short - circuiting the CF computation ,
  particularly to avoid computing a CF which has changed due to the
-- execution of a mutually exclusive rule -- for which no sched edge exists.)
areRulesDisjoint :: ExclusiveRulesDB -> ARuleId -> ARuleId -> Bool
areRulesDisjoint (ExclusiveRulesDB exclusive_fmap) r1 r2 =
    let (disj_set, _) = M.findWithDefault (S.empty, S.empty) r1 exclusive_fmap
    in  S.member r2 disj_set

erdbToList :: ExclusiveRulesDB -> [(ARuleId,([ARuleId],[ARuleId]))]
erdbToList (ExclusiveRulesDB exclusive_map) =
    let conv (r, (d_set, e_set)) = (r, (S.toList d_set, S.toList e_set))
    in  map conv (M.toList exclusive_map)

erdbFromList :: [(ARuleId,([ARuleId],[ARuleId]))] -> ExclusiveRulesDB
erdbFromList xs =
    let conv (r, (ds, es)) = (r, (S.fromList ds, S.fromList es))
    in  ExclusiveRulesDB (M.fromList (map conv xs))

instance Show ExclusiveRulesDB where
    show erdb = show (erdbToList erdb)

-- ---------------

data SchedNode = Sched AId | Exec AId
  deriving (Eq, Show)

  comparing by name instead of the default ORD instance for I d
-- makes the schedule order from the flattened graph stable.
instance Ord SchedNode where
  compare (Sched _) (Exec _)  = LT
  compare (Exec _)  (Sched _) = GT
  compare (Sched x) (Sched y) = cmpIdByName x y
  compare (Exec x)  (Exec y)  = cmpIdByName x y

instance PPrint SchedNode where
    pPrint d _ (Sched i) = text "Sched" <+> pPrint d 0 i
    pPrint d _ (Exec i) = text "Exec" <+> pPrint d 0 i

getSchedNodeId :: SchedNode -> AId
getSchedNodeId (Sched i) = i
getSchedNodeId (Exec i) = i

isSchedNode :: SchedNode -> Bool
isSchedNode (Sched _) = True
isSchedNode (Exec _) = False

  A SchedNode newtype wrapper for SchedNode for the cases
-- where comparison performance is critical and stable ordering
-- is not important.
newtype FastSchedNode = FSN { unFSN :: SchedNode }
  deriving(Eq)

instance Ord FastSchedNode where
  compare (FSN (Sched _)) (FSN (Exec _))  = LT
  compare (FSN (Exec _))  (FSN (Sched _)) = GT
  compare (FSN (Sched x)) (FSN (Sched y)) = compare x y
  compare (FSN (Exec x))  (FSN (Exec y))  = compare x y


-- ---------------

-- This structure represents information about pairs of rules:
--   - If a pair is not in the set, then their predicates are not disjoint
--   - If a pair is not in the map, then the rules have no conflicts
--   - If a pair maps to a RuleRelationInfo value, then the breakdown
--     of conflicts is given in the RuleRelationInfo structure.
data RuleRelationDB =
    RuleRelationDB (S.Set (ARuleId,ARuleId))                  -- disjointness
                   (M.Map (ARuleId,ARuleId) RuleRelationInfo) -- conflicts

data RuleRelationInfo = RuleRelationInfo { mCF :: Maybe Conflicts
                                         , mSC :: Maybe Conflicts
                                         , mRes :: Maybe Conflicts
                                         , mCycle :: Maybe Conflicts
                                         , mPragma :: Maybe Conflicts
                                         , mArb :: Maybe Conflicts
                                         -- XXX path and urgency info?
                                         } deriving (Eq,Show)

defaultRuleRelationship :: RuleRelationInfo
defaultRuleRelationship = RuleRelationInfo { mCF     = Nothing
                                           , mSC     = Nothing
                                           , mRes    = Nothing
                                           , mCycle  = Nothing
                                           , mPragma = Nothing
                                           , mArb    = Nothing
                                           }


rrdbToList :: RuleRelationDB ->
              [((ARuleId,ARuleId),Bool,(Maybe RuleRelationInfo))]
rrdbToList (RuleRelationDB dset cmap) =
    let all_pairs = dset `S.union` (M.keysSet cmap)
    in [ (k, k `S.member` dset, M.lookup k cmap) | k <- S.toList all_pairs ]

rrdbFromList :: [((ARuleId,ARuleId),Bool,(Maybe RuleRelationInfo))] ->
                RuleRelationDB
rrdbFromList xs =
    let dset = S.fromList [ k | (k,True,_) <- xs ]
        cmap = M.fromList [ (k,rri) | (k,_,(Just rri)) <- xs ]
    in RuleRelationDB dset cmap

instance Show RuleRelationDB where
    show rrdb = show (rrdbToList rrdb)

getRuleRelation :: RuleRelationDB -> ARuleId -> ARuleId -> (Bool,RuleRelationInfo)
getRuleRelation (RuleRelationDB dset cmap) r1 r2 =
    let disj = S.member (r1,r2) dset
        rri  = M.findWithDefault defaultRuleRelationship (r1,r2) cmap
    in (disj,rri)

-- -----

data Conflicts =
      CUse [(MethodId,MethodId)]
    | CCycle [ARuleId]
    | CMethodsBeforeRules
    | CUserEarliness Position
    | CUserAttribute Position
    | CUserPreempt Position
    | CResource MethodId
    | CArbitraryChoice
    | CFFuncArbitraryChoice
  deriving (Eq,Show)

printConflicts :: Bool -> PDetail -> Conflicts -> Doc
printConflicts use_pvprint d edge =
    let pfp :: (PVPrint a, PPrint a) => a -> Doc
        pfp = if (use_pvprint)
              then pvPrint d 0
              else pPrint d 0
    in  case (edge) of
            (CUse uses) ->
                let meths = vcat [pfp m1 <+> text "vs." <+> pfp m2
                                     | (m1, m2) <- uses]
                in  fsep [s2par "calls to", nest 2 meths]
            (CCycle cycle_rules) ->
                let cycle = fsep (intersperse (text "->")
                                    [pfp r | r <- cycle_rules])
                in  fsep [s2par "dropped cycle", nest 2 $ parens cycle]
            (CMethodsBeforeRules) ->
                s2par "methods fire before rules"
            (CUserEarliness pos) ->
                fsep [s2par "earliness attribute at", pfp pos]
            (CUserAttribute pos) ->
                fsep [s2par "scheduling attribute at", pfp pos]
            (CUserPreempt pos) ->
                fsep [s2par "preempt attribute at", pfp pos]
            (CResource m) -> fsep [s2par "resource limit on", pfp m]
            (CArbitraryChoice) ->
                s2par "earliness order chosen by the compiler"
            (CFFuncArbitraryChoice) ->
                s2par ("earliness order chosen by the compiler" ++
                       " (due to system task or foreign function use)")

instance PPrint Conflicts where
    pPrint d p = printConflicts False d

instance PVPrint Conflicts where
    pvPrint d p = printConflicts True d

instance Hyper Conflicts where
    hyper (CUse uses) y = hyper uses y
    hyper (CCycle cycle_rules) y = hyper cycle_rules y
    hyper (CMethodsBeforeRules) y = y
    hyper (CUserEarliness pos) y = hyper pos y
    hyper (CUserAttribute pos) y = hyper pos y
    hyper (CUserPreempt pos) y = hyper pos y
    hyper (CResource m) y = hyper m y
    hyper (CArbitraryChoice) y = y
    hyper (CFFuncArbitraryChoice) y = y

-- -----

printRuleRelationInfo :: ARuleId -> ARuleId -> Bool -> RuleRelationInfo -> Doc
printRuleRelationInfo rule1 rule2 isDisjoint
        (RuleRelationInfo mCF mSC mRes mCycle mPragma mArb) =
    let
        -- print a single conflict of a given type
        pp_conflict ctype Nothing =
            sep [text "no", text ctype, text "conflict"]
        pp_conflict ctype (Just c) =
            sep [text ctype, text "conflict:", pPrint PDReadable 0 c]
    in
        (text "Scheduling info for rules \"" <>
         pPrint PDReadable 0 rule1 <> text "\" and \"" <>
         pPrint PDReadable 0 rule2 <> text "\":")
        $+$
        sep [text "predicates",
             (if isDisjoint
              then text "are" else text "are not"),
              text "disjoint"]
        $+$
        nest 4 (pp_conflict "<>" mCF $+$
                pp_conflict "<" mSC $+$
                pp_conflict "resource" mRes $+$
                pp_conflict "cycle" mCycle $+$
                pp_conflict "attribute" mPragma)
                -- XXX mArb

-- -----

unionRuleRelationInfo :: RuleRelationInfo -> RuleRelationInfo ->
                         RuleRelationInfo
unionRuleRelationInfo rri1 rri2 =
    let
        unionMaybeWith fn Nothing   m2        = m2
        unionMaybeWith fn m1        Nothing   = m1
        unionMaybeWith fn (Just v1) (Just v2) = Just (fn v1 v2)

        unionCUse (CUse us1) (CUse us2) = CUse (us1 ++ us2)
        unionCUse c1 c2 = internalError ("unionCUse: " ++ ppReadable (c1, c2))

        -- XXX the info in c2 is lost
        unionCResource c1@(CResource _) (CResource _) = c1
        unionCResource c1 c2 = internalError ("unionCResource: " ++
                                              ppReadable (c1, c2))

        -- XXX the info in c2 is lost
        unionCCycle c1@(CCycle _) (CCycle _) = c1
        unionCCycle c1 c2 = internalError ("unionCCycle: " ++
                                           ppReadable (c1, c2))

        -- XXX the info in c2 is lost
        unionPragma c1 c2 = c1

        -- XXX Since some info may be lost, make sure that any reason
  XXX othet than FFunc bias  FFunc bias
        unionArb CArbitraryChoice _ = CArbitraryChoice
        unionArb _ CArbitraryChoice = CArbitraryChoice
        unionArb c1 c2 = c1

    in
       RuleRelationInfo {
           mCF = unionMaybeWith unionCUse (mCF rri1) (mCF rri2),
           mSC = unionMaybeWith unionCUse (mSC rri1) (mSC rri2),
           mRes = unionMaybeWith unionCResource (mRes rri1) (mRes rri2),
           mCycle = unionMaybeWith unionCCycle (mCycle rri1) (mCycle rri2),
           mPragma = unionMaybeWith unionPragma (mPragma rri1) (mPragma rri2),
           mArb = unionMaybeWith unionArb (mArb rri1) (mArb rri2)
       }

-- ---------------

 ========================================================================
 Data returned by the aSchedule stage

 Warnings during scheduling
 (position, tag, msg including position and tag)

 The method uses map and the rule uses map
   They don't have any read method calls used by a rule's assumptions.
   The rule uses map also doesn't have the method calls to write a
   rule's conflict-free condition wires (the method uses map does
   This will probably change somehow when we have real runtime errors

 ---------------
 When the scheduling stage aborts with an error, this data structure
 contains the available information up to that point (for debugging)

 Warnings during scheduling
 (position, tag, msg including position and tag)

 Errors during scheduling
 (position, tag, msg including position and tag)

 These are computed initially, and therefore are always available:
 The method uses map and the rule uses map
   They don't have any read method calls used by a rule's assumptions.
   The rule uses map also doesn't have the method calls to write a
   rule's conflict-free condition wires (the method uses map does
   This will probably change somehow when we have real runtime errors

 The remaining fields may not be available.
 In order of computation:

 ---------------
 A cache of what is known about whether rules are exclusive (post-scheduling)
 * Are the CAN_FIRE signals for the rules disjoint?
   (This is a superset which also takes into account rule executions
    that have been forced to be exclusive due to conflicts etc.)
 Note: we check both the disjoint set and the exclusive set, since we
 do not make a redundant record of exclusivity when it is implied by
 disjointness.
 Are the CAN_FIRE signals of the rules exclusive?
 execution of a mutually exclusive rule -- for which no sched edge exists.)
 ---------------
 makes the schedule order from the flattened graph stable.
 where comparison performance is critical and stable ordering
 is not important.
 ---------------
 This structure represents information about pairs of rules:
   - If a pair is not in the set, then their predicates are not disjoint
   - If a pair is not in the map, then the rules have no conflicts
   - If a pair maps to a RuleRelationInfo value, then the breakdown
     of conflicts is given in the RuleRelationInfo structure.
 disjointness
 conflicts
 XXX path and urgency info?
 -----
 -----
 print a single conflict of a given type
 XXX mArb
 -----
 XXX the info in c2 is lost
 XXX the info in c2 is lost
 XXX the info in c2 is lost
 XXX Since some info may be lost, make sure that any reason
 ---------------
# LANGUAGE CPP #
module AScheduleInfo (
    AScheduleErrInfo(..),
    AScheduleInfo(..),
    Conflicts(..),
    ExclusiveRulesDB(..),
    FastSchedNode(..),
    RuleRelationDB(..),
    RuleRelationInfo(..),
    SchedNode(..),
    areRulesDisjoint,
    areRulesExclusive,
    defaultRuleRelationship,
    erdbFromList,
    erdbToList,
    getRuleRelation,
    getSchedNodeId,
    isSchedNode,
    printRuleRelationInfo,
    rrdbFromList,
    unionRuleRelationInfo
) where

#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 804)
import Prelude hiding ((<>))
#endif

import qualified Data.Map as M
import qualified Data.Set as S
import Data.List(intersperse)
import Util(thd)
import Eval

import ErrorUtil
import PFPrint
import Position
import Id(cmpIdByName)
import ASyntax
import AUses
import VModInfo(VSchedInfo)
import RSchedule(RAT)



data AScheduleInfo = AScheduleInfo
    {
      asi_warnings             :: [(Position, String, String)],

  In order of computation in ASchedule :

    XXX except where necessary to make AState work
    because AState needs it ) .
      asi_method_uses_map      :: MethodUsesMap,
      asi_rule_uses_map        :: RuleUsesMap,

      asi_resource_alloc_table :: RAT,
      asi_exclusive_rules_db   :: ExclusiveRulesDB,
      asi_sched_order          :: [SchedNode],
      asi_schedule             :: ASchedule,
      asi_sched_graph          :: [(SchedNode, [SchedNode])],
      asi_rule_relation_db     :: RuleRelationDB,
      asi_v_sched_info         :: VSchedInfo
    } deriving (Show)


instance PPrint AScheduleInfo where
    pPrint d p asi =
        text "AScheduleInfo" $+$
        nest 2 (
            text "-- schedule" $+$
            pPrint d 0 (asi_schedule asi) $+$
            text "-- vschedinfo" $+$
            pPrint d 0 (asi_v_sched_info asi) $+$
            text "-- warnings" $+$
            (let ppWarn = vcat . map text . lines
             in  vcat (map (ppWarn . thd) (asi_warnings asi))) $+$
            text "-- method uses map" $+$
            pPrint d 0 (asi_method_uses_map asi) $+$
            text "-- rule uses map" $+$
            pPrint d 0 (asi_rule_uses_map asi) $+$
            text "-- resource allocation table" $+$
            pPrint d 0 (asi_resource_alloc_table asi)
  no dump of DBs , sched graph and order
            )



data AScheduleErrInfo = AScheduleErrInfo
    {
      asei_warnings             :: [(Position, String, String)],

      asei_errors               :: [(Position, String, String)],


    XXX except where necessary to make AState work
    because AState needs it ) .
      asei_method_uses_map      :: MethodUsesMap,
      asei_rule_uses_map        :: RuleUsesMap,

      asei_resource_alloc_table :: Maybe RAT,
      asei_exclusive_rules_db   :: Maybe ExclusiveRulesDB,
      asei_sched_order          :: Maybe [SchedNode],
      asei_schedule             :: Maybe ASchedule,
      asei_sched_graph          :: Maybe [(SchedNode, [SchedNode])],
      asei_rule_relation_db     :: Maybe RuleRelationDB,
      asei_v_sched_info         :: Maybe VSchedInfo
    } deriving (Show)


instance PPrint AScheduleErrInfo where
    pPrint d p asei =
        text "AScheduleErrInfo" $+$
        nest 2 (
            text "-- schedule" $+$
            pPrint d 0 (asei_schedule asei) $+$
            text "-- vschedinfo" $+$
            pPrint d 0 (asei_v_sched_info asei) $+$
            text "-- warnings" $+$
            (let ppWarn = vcat . map text . lines
             in  vcat (map (ppWarn . thd) (asei_warnings asei))) $+$
            text "-- errors" $+$
            (let ppErr = vcat . map text . lines
             in  vcat (map (ppErr . thd) (asei_errors asei))) $+$
            text "-- method uses map" $+$
            pPrint d 0 (asei_method_uses_map asei) $+$
            text "-- rule uses map" $+$
            pPrint d 0 (asei_rule_uses_map asei) $+$
            text "-- resource allocation table" $+$
            pPrint d 0 (asei_resource_alloc_table asei)
  no dump of DBs , sched graph and order
            )



  It can be queried for two pieces of information :
  * Are the WILL_FIRE signals for the rules disjoint ?
newtype ExclusiveRulesDB =
    ExclusiveRulesDB (M.Map ARuleId (S.Set ARuleId, S.Set ARuleId))

  Are the WILL_FIRE signals of the rules exclusive ?
  ( Used in Verilog backend for determining if a priority mux is needed . )
areRulesExclusive :: ExclusiveRulesDB -> ARuleId -> ARuleId -> Bool
areRulesExclusive (ExclusiveRulesDB exclusive_fmap) r1 r2 =
    let (disj_set, excl_set) = M.findWithDefault (S.empty, S.empty) r1 exclusive_fmap
    in (S.member r2 disj_set) || (S.member r2 excl_set)

  ( Used in Bluesim backend for short - circuiting the CF computation ,
  particularly to avoid computing a CF which has changed due to the
areRulesDisjoint :: ExclusiveRulesDB -> ARuleId -> ARuleId -> Bool
areRulesDisjoint (ExclusiveRulesDB exclusive_fmap) r1 r2 =
    let (disj_set, _) = M.findWithDefault (S.empty, S.empty) r1 exclusive_fmap
    in  S.member r2 disj_set

erdbToList :: ExclusiveRulesDB -> [(ARuleId,([ARuleId],[ARuleId]))]
erdbToList (ExclusiveRulesDB exclusive_map) =
    let conv (r, (d_set, e_set)) = (r, (S.toList d_set, S.toList e_set))
    in  map conv (M.toList exclusive_map)

erdbFromList :: [(ARuleId,([ARuleId],[ARuleId]))] -> ExclusiveRulesDB
erdbFromList xs =
    let conv (r, (ds, es)) = (r, (S.fromList ds, S.fromList es))
    in  ExclusiveRulesDB (M.fromList (map conv xs))

instance Show ExclusiveRulesDB where
    show erdb = show (erdbToList erdb)


data SchedNode = Sched AId | Exec AId
  deriving (Eq, Show)

  comparing by name instead of the default ORD instance for I d
instance Ord SchedNode where
  compare (Sched _) (Exec _)  = LT
  compare (Exec _)  (Sched _) = GT
  compare (Sched x) (Sched y) = cmpIdByName x y
  compare (Exec x)  (Exec y)  = cmpIdByName x y

instance PPrint SchedNode where
    pPrint d _ (Sched i) = text "Sched" <+> pPrint d 0 i
    pPrint d _ (Exec i) = text "Exec" <+> pPrint d 0 i

getSchedNodeId :: SchedNode -> AId
getSchedNodeId (Sched i) = i
getSchedNodeId (Exec i) = i

isSchedNode :: SchedNode -> Bool
isSchedNode (Sched _) = True
isSchedNode (Exec _) = False

  A SchedNode newtype wrapper for SchedNode for the cases
newtype FastSchedNode = FSN { unFSN :: SchedNode }
  deriving(Eq)

instance Ord FastSchedNode where
  compare (FSN (Sched _)) (FSN (Exec _))  = LT
  compare (FSN (Exec _))  (FSN (Sched _)) = GT
  compare (FSN (Sched x)) (FSN (Sched y)) = compare x y
  compare (FSN (Exec x))  (FSN (Exec y))  = compare x y



data RuleRelationDB =

data RuleRelationInfo = RuleRelationInfo { mCF :: Maybe Conflicts
                                         , mSC :: Maybe Conflicts
                                         , mRes :: Maybe Conflicts
                                         , mCycle :: Maybe Conflicts
                                         , mPragma :: Maybe Conflicts
                                         , mArb :: Maybe Conflicts
                                         } deriving (Eq,Show)

defaultRuleRelationship :: RuleRelationInfo
defaultRuleRelationship = RuleRelationInfo { mCF     = Nothing
                                           , mSC     = Nothing
                                           , mRes    = Nothing
                                           , mCycle  = Nothing
                                           , mPragma = Nothing
                                           , mArb    = Nothing
                                           }


rrdbToList :: RuleRelationDB ->
              [((ARuleId,ARuleId),Bool,(Maybe RuleRelationInfo))]
rrdbToList (RuleRelationDB dset cmap) =
    let all_pairs = dset `S.union` (M.keysSet cmap)
    in [ (k, k `S.member` dset, M.lookup k cmap) | k <- S.toList all_pairs ]

rrdbFromList :: [((ARuleId,ARuleId),Bool,(Maybe RuleRelationInfo))] ->
                RuleRelationDB
rrdbFromList xs =
    let dset = S.fromList [ k | (k,True,_) <- xs ]
        cmap = M.fromList [ (k,rri) | (k,_,(Just rri)) <- xs ]
    in RuleRelationDB dset cmap

instance Show RuleRelationDB where
    show rrdb = show (rrdbToList rrdb)

getRuleRelation :: RuleRelationDB -> ARuleId -> ARuleId -> (Bool,RuleRelationInfo)
getRuleRelation (RuleRelationDB dset cmap) r1 r2 =
    let disj = S.member (r1,r2) dset
        rri  = M.findWithDefault defaultRuleRelationship (r1,r2) cmap
    in (disj,rri)


data Conflicts =
      CUse [(MethodId,MethodId)]
    | CCycle [ARuleId]
    | CMethodsBeforeRules
    | CUserEarliness Position
    | CUserAttribute Position
    | CUserPreempt Position
    | CResource MethodId
    | CArbitraryChoice
    | CFFuncArbitraryChoice
  deriving (Eq,Show)

printConflicts :: Bool -> PDetail -> Conflicts -> Doc
printConflicts use_pvprint d edge =
    let pfp :: (PVPrint a, PPrint a) => a -> Doc
        pfp = if (use_pvprint)
              then pvPrint d 0
              else pPrint d 0
    in  case (edge) of
            (CUse uses) ->
                let meths = vcat [pfp m1 <+> text "vs." <+> pfp m2
                                     | (m1, m2) <- uses]
                in  fsep [s2par "calls to", nest 2 meths]
            (CCycle cycle_rules) ->
                let cycle = fsep (intersperse (text "->")
                                    [pfp r | r <- cycle_rules])
                in  fsep [s2par "dropped cycle", nest 2 $ parens cycle]
            (CMethodsBeforeRules) ->
                s2par "methods fire before rules"
            (CUserEarliness pos) ->
                fsep [s2par "earliness attribute at", pfp pos]
            (CUserAttribute pos) ->
                fsep [s2par "scheduling attribute at", pfp pos]
            (CUserPreempt pos) ->
                fsep [s2par "preempt attribute at", pfp pos]
            (CResource m) -> fsep [s2par "resource limit on", pfp m]
            (CArbitraryChoice) ->
                s2par "earliness order chosen by the compiler"
            (CFFuncArbitraryChoice) ->
                s2par ("earliness order chosen by the compiler" ++
                       " (due to system task or foreign function use)")

instance PPrint Conflicts where
    pPrint d p = printConflicts False d

instance PVPrint Conflicts where
    pvPrint d p = printConflicts True d

instance Hyper Conflicts where
    hyper (CUse uses) y = hyper uses y
    hyper (CCycle cycle_rules) y = hyper cycle_rules y
    hyper (CMethodsBeforeRules) y = y
    hyper (CUserEarliness pos) y = hyper pos y
    hyper (CUserAttribute pos) y = hyper pos y
    hyper (CUserPreempt pos) y = hyper pos y
    hyper (CResource m) y = hyper m y
    hyper (CArbitraryChoice) y = y
    hyper (CFFuncArbitraryChoice) y = y


printRuleRelationInfo :: ARuleId -> ARuleId -> Bool -> RuleRelationInfo -> Doc
printRuleRelationInfo rule1 rule2 isDisjoint
        (RuleRelationInfo mCF mSC mRes mCycle mPragma mArb) =
    let
        pp_conflict ctype Nothing =
            sep [text "no", text ctype, text "conflict"]
        pp_conflict ctype (Just c) =
            sep [text ctype, text "conflict:", pPrint PDReadable 0 c]
    in
        (text "Scheduling info for rules \"" <>
         pPrint PDReadable 0 rule1 <> text "\" and \"" <>
         pPrint PDReadable 0 rule2 <> text "\":")
        $+$
        sep [text "predicates",
             (if isDisjoint
              then text "are" else text "are not"),
              text "disjoint"]
        $+$
        nest 4 (pp_conflict "<>" mCF $+$
                pp_conflict "<" mSC $+$
                pp_conflict "resource" mRes $+$
                pp_conflict "cycle" mCycle $+$
                pp_conflict "attribute" mPragma)


unionRuleRelationInfo :: RuleRelationInfo -> RuleRelationInfo ->
                         RuleRelationInfo
unionRuleRelationInfo rri1 rri2 =
    let
        unionMaybeWith fn Nothing   m2        = m2
        unionMaybeWith fn m1        Nothing   = m1
        unionMaybeWith fn (Just v1) (Just v2) = Just (fn v1 v2)

        unionCUse (CUse us1) (CUse us2) = CUse (us1 ++ us2)
        unionCUse c1 c2 = internalError ("unionCUse: " ++ ppReadable (c1, c2))

        unionCResource c1@(CResource _) (CResource _) = c1
        unionCResource c1 c2 = internalError ("unionCResource: " ++
                                              ppReadable (c1, c2))

        unionCCycle c1@(CCycle _) (CCycle _) = c1
        unionCCycle c1 c2 = internalError ("unionCCycle: " ++
                                           ppReadable (c1, c2))

        unionPragma c1 c2 = c1

  XXX othet than FFunc bias  FFunc bias
        unionArb CArbitraryChoice _ = CArbitraryChoice
        unionArb _ CArbitraryChoice = CArbitraryChoice
        unionArb c1 c2 = c1

    in
       RuleRelationInfo {
           mCF = unionMaybeWith unionCUse (mCF rri1) (mCF rri2),
           mSC = unionMaybeWith unionCUse (mSC rri1) (mSC rri2),
           mRes = unionMaybeWith unionCResource (mRes rri1) (mRes rri2),
           mCycle = unionMaybeWith unionCCycle (mCycle rri1) (mCycle rri2),
           mPragma = unionMaybeWith unionPragma (mPragma rri1) (mPragma rri2),
           mArb = unionMaybeWith unionArb (mArb rri1) (mArb rri2)
       }

