content: {-# LANGUAGE PatternGuards #-}
  -- AUses
  --
  -- This module is used by ASchedule to create a MethodUsesMap, which
  -- is then used by RSchedule and exposed to later stages (AState)
  -- through the output of the ASchedule stage.
  --
  -- MethodUsesMap relates MethodId to a list of UniqueUse (an expression
  -- or action) and, for each use:
  --   * a list of RuleId for rules which use the method in their condition,
  --   * a list of RuleId for rules which use the method in their action,
  --   * a list of AId for submodule instances which use the method in
  --     their instantiation (e.g. continuous connection to an input port)
  -- Thus, the data types MethodId, UniqueUse, MethodUsers, and RuleId are
  -- also exported.
  --
  -- Other data types (notably RuleUsesMap)
  -- are exposed for use by ASchedule and AAddSchedAssumps:
  --
  -- 1) ASchedule creates a list of Rules using its own "cvtARule" and "cvtIfc"
  --    functions (which could probably be put here in AUses)
  -- 2) Then it calls buildUseMaps to create get the use maps from AUses.
  -- 3) buildUseMaps first builds a ruleUseMap (using ruleUsesMap)
  -- 4) A complete uses map is created, with "createMethodUsesMap",
  --    by inverting the RuleUsesMap and adding uses from the submodule
  --    instances.
  -- 5) Both maps are returned to ASchedule
  -- 6) The ruleUseMap is used to check that rules have proper actions
  --    (no parallel conflicting actions) using "verifySafeRuleActions"
  --    (which could also be moved here).
  -- 7) The ruleUseMap is also used by functions "cfConflicts" and "scConflicts"
  --    to add conflict edges to the conflict graphs.  Again, this could be
  --    abstracted so that ASchedule doesn't need knowledge of the internal
  --    data structures.
  -- 8) The MethodUsesMap is used by RSchedule for resource allocation.
  --    (it is also used as part of clock-domain checking in the scheduler)
  --
  -- AAddSchedAssumps uses a RuleUsesMap because it needs to go from
  -- rules to method calls to potentially conflicting method calls in
  -- "conflict-free" rules
  
  module AUses(
                MethodUsesMap, -- requires MethodId, UniqueUse, MethodUsers
                mergeUseMapData,
                MethodId(..), methodIdToId, getMIdPosition, getMIdObject,
                UniqueUse(..), UseCond(..), ucTrue,
                MethodUsesList,
                getUUPos, hasSideEffects, extractCondition, differentArgs,
                useDropCond,
                MethodUsers, -- requires RuleId
                RuleId,
  
                -- create the ruleUsesMap and methodUsesMap together
                buildUseMaps,
  
                -- used by ASchedule and AAddSchedAssumps
                RuleUsesMap,
                RuleUses(..),
                Rule(..), ruleName, rulePred, ruleAncestor,
                rumToObjectMap, rumToMethodUseMap,
                rumGetMethodIds, rumRuleUsesFF,
                getMethodActionUses, rumGetActionUses, lookupMethodActionUse,
                ruleMethodUsesToUUs
               ) where
  
  import Eval
  import ASyntax
  import ASyntaxUtil
  import qualified Data.Map as M
  import qualified Data.Set as S
  import Position
  import Id
  import FStringCompat
  import Data.List(union, partition, foldl')
  import Util
  import PPrint
  import PVPrint
  import ErrorUtil(internalError)
  import Prim
  import IntLit
  import Control.Monad(liftM, mapAndUnzipM)
  import Control.Monad.State.Strict(State, runState, get, put)
  -- import Debug.Trace
  
  
  -- ==============================
  -- Data Types: Rule and RuleId
  
  -- RULE: internal rule/interface method rep for scheduler --
  type RuleId = ARuleId
  data Rule = Rule RuleId (Maybe RuleId) [APred] [AExpr] [AAction]
            -- name, source if split, predicates, non-predicate reads, writes
  
  instance Eq Rule where
      (Rule rId _ _ _ _) == (Rule rId' _ _ _ _) = rId == rId' -- we can assume unique ids
  
  instance PPrint Rule where
      pPrint d i (Rule rId _ rPred rReads rWrites) =
          sep $ map sep
                       [[text "rule:", pPrint d i rId], [text "pred:", pPrint d i rPred],
                        [text "reads:", pPrint d i rReads], [text "writes:", pPrint d i rWrites]]
  
  ruleName :: Rule -> RuleId
  ruleName (Rule rId _ _ _ _) = rId
  
  ruleAncestor :: Rule -> Maybe RuleId
  ruleAncestor (Rule _ ancestor _ _ _) = ancestor
  
  rulePred :: Rule -> [APred]
  rulePred (Rule _ _ rPred _ _) = rPred
  
  
  -- ==============================
  -- Data Types: MethodId
  
  -- METHOD IDs: identifies the object and the method --
  data MethodId = MethodId AId AMethodId deriving (Eq,Ord,Show) -- object.method
  instance PPrint MethodId where
      pPrint d p mid = pPrint d p (methodIdToId mid)
  instance PVPrint MethodId where
      pvPrint d p mid = pvPrint d p (methodIdToId mid)
  instance Hyper MethodId where
       hyper (MethodId a m) y = hyper2 a m y
  
  methodIdToId :: MethodId -> Id
  methodIdToId (MethodId id mid) = mkStId id mid
  
  getMIdPosition :: MethodId -> Position
  getMIdPosition (MethodId id mid) = getIdPosition id
  
  -- return just the instance
  -- (can be used, for instance, to see if two uses are on the same object)
  getMIdObject :: MethodId -> AId
  getMIdObject (MethodId i _) = i
  
  -- ==============================
  -- Data Types: UniqueUse
  
  data UniqueUse = UUAction AAction
                 | UUExpr AExpr UseCond
       deriving (Eq, Ord, Show)
  
  instance PPrint UniqueUse where
      pPrint PDDebug _ u = text "<UniqueUse>" <+> pPrint PDReadable 0 u
      pPrint d i   (UUAction a) = pPrint d i a
      pPrint d i (UUExpr a c) | c == ucTrue = pPrint d i a
      pPrint d i u@(UUExpr a uc) = pPrint d i a <+>
                                             text "condition:" <+>
                                             pPrint d i (useCondToAExpr uc)
  
  instance PPrintExpand UniqueUse where
      pPrintExpand ds d i (UUAction a) = pPrintExpand ds d i a
      pPrintExpand ds d i (UUExpr a _)   = pPrintExpand ds d i a
  
  instance Hyper UniqueUse where
      hyper (UUAction a) y = hyper a y
      hyper (UUExpr e c) y = hyper2 e c y
  
  -- XXX why does this return True for actions?
  -- XXX consider merging this and "hasSideEffects"
  differentArgs :: UniqueUse -> UniqueUse -> Bool
  differentArgs (UUExpr e1 c1) (UUExpr e2 c2) = e1 /= e2
  differentArgs _ _ = True
  
  hasSideEffects :: UniqueUse -> Bool
  hasSideEffects (UUExpr _ _) = False
  hasSideEffects _ = True
  
  isUUAction :: UniqueUse -> Bool
  isUUAction UUAction {} = True
  isUUAction _ = False
  
  getUUPos :: UniqueUse -> Position
  getUUPos (UUAction act) = getIdPosition (aact_objid act)
  getUUPos (UUExpr (AMethCall _ i _ _) _) = getIdPosition i
  getUUPos (UUExpr _ _) = noPosition -- XXX internal error? get a real position?
  
  extractCondition :: UniqueUse -> AExpr
  extractCondition (UUAction act) | (c:_) <- aact_args act = c
  extractCondition (UUAction act) = internalError("AUses - action without condition: "
                                                   ++ ppReadable act)
  extractCondition (UUExpr _ uc) = useCondToAExpr uc
  
  useCondToAExpr :: UseCond -> AExpr
  useCondToAExpr uc = foldl aAnd aTrue exprs
    where true_list = S.toList (true_exprs uc)
          false_list = map aNot (S.toList (false_exprs uc))
          eq_list = map mkEq (M.toList (eq_map uc))
          mkEq  (e,i)  = APrim defaultAId aTBool PrimEQ [e, ASInt defaultAId (aType e) i]
          neq_list = concatMap mkNEq (M.toList (neq_map uc))
          mkNEq (e,is) = map (\i -> APrim defaultAId aTBool PrimBNot [mkEq (e,i)]) (S.toList is)
          exprs = true_list ++ false_list ++ eq_list ++ neq_list
  
  useDropCond :: UniqueUse -> UniqueUse
  useDropCond (UUExpr e c) = UUExpr e ucTrue
  useDropCond a = a
  
  -- ==============================
  -- Data Types: ActionUses, ExprUses
  
  -- map from a submodule to a map from methods (on the module) to their uses
  type MethodExprUses = M.Map Id (M.Map Id (M.Map AExpr UseCond))
  type MethodActionUses = M.Map Id (M.Map Id [AAction])
  
  toListMethodExprUses :: MethodExprUses -> [(MethodId, [UniqueUse])]
  toListMethodExprUses mus =
      [ (MethodId objId methId, map (\ (e,c) -> UUExpr e c) (M.toList uses))
            | (objId, methmap) <- M.toList mus,
              (methId, uses) <- M.toList methmap ]
  
  toListMethodActionUses :: MethodActionUses -> [(MethodId, [UniqueUse])]
  toListMethodActionUses mus =
      [ (MethodId objId methId, map UUAction uses)
            | (objId, methmap) <- M.toList mus,
              (methId, uses) <- M.toList methmap ]
  
  -- ----------
  
  type FFuncId = AId
  
  -- map from a foreign function to its uses
  type FFuncExprUses = M.Map FFuncId (M.Map AExpr UseCond)
  type FFuncActionUses = M.Map FFuncId [AAction]
  
  toListFFExprUses :: FFuncExprUses -> [(FFuncId, [UniqueUse])]
  toListFFExprUses fus =
      [ (fId, map (\ (e,c) -> UUExpr e c) (M.toList uses))
            | (fId, uses) <- M.toList fus ]
  
  toListFFActionUses :: FFuncActionUses -> [(FFuncId, [UniqueUse])]
  toListFFActionUses fus =
      [ (fId, map UUAction uses)
            | (fId, uses) <- M.toList fus ]
  
  -- ----------
  
  type ExprUses = (MethodExprUses, FFuncExprUses)
  type ActionUses = (MethodActionUses, FFuncActionUses)
  
  noExprUses :: ExprUses
  noExprUses = (M.empty, M.empty)
  
  singleMethodExprUse :: AId -> AMethodId -> AExpr -> UseCond -> ExprUses
  singleMethodExprUse i m e c =
      (M.singleton i (M.singleton m (M.singleton e c)),
       M.empty)
  
  singleMethodActionUse :: AId -> AMethodId -> AAction -> ActionUses
  singleMethodActionUse i m a =
      (M.singleton i (M.singleton m [a]),
       M.empty)
  
  singleFFuncExprUse :: AId -> AExpr -> UseCond -> ExprUses
  singleFFuncExprUse i e c = (M.empty, M.singleton i (M.singleton e c))
  
  singleFFuncActionUse :: AId -> AAction -> ActionUses
  singleFFuncActionUse i a = (M.empty, M.singleton i [a])
  
  getMethodExprUses :: ExprUses -> MethodExprUses
  getMethodExprUses = fst
  
  getMethodActionUses :: ActionUses -> MethodActionUses
  getMethodActionUses = fst
  
  getFFuncExprUses :: ExprUses -> FFuncExprUses
  getFFuncExprUses = snd
  
  getFFuncActionUses :: ActionUses -> FFuncActionUses
  getFFuncActionUses = snd
  
  lookupMethodActionUse :: MethodId -> MethodActionUses -> Maybe [AAction]
  lookupMethodActionUse (MethodId objId methId) objmap =
      case (M.lookup objId objmap) of
        Nothing -> Nothing
        Just methmap ->  M.lookup methId methmap
  
  -- ----------
  
  -- Merge expression uses by combining the use condition of identical exprs
  -- (Ravi's comment: "merge only expressions -- merging actions is dangerous")
  
  mergeExprUses :: [ExprUses] -> ExprUses
  mergeExprUses uss =
    let
        mergeUsesFn :: M.Map AExpr UseCond -> M.Map AExpr UseCond ->
                       M.Map AExpr UseCond
        mergeUsesFn us1 us2 = M.unionWith orUseCond us1 us2
  
        mergeMethodUses :: [MethodExprUses] -> MethodExprUses
        mergeMethodUses ms = M.unionsWith (M.unionWith mergeUsesFn) ms
  
        mergeFFuncUses :: [FFuncExprUses] -> FFuncExprUses
        mergeFFuncUses fs = M.unionsWith mergeUsesFn fs
  
        (muss, fuss) = unzip uss
    in
        (mergeMethodUses muss, mergeFFuncUses fuss)
  
  mergeActionUses :: [ActionUses] -> ActionUses
  mergeActionUses uss =
    let
        mergeUsesFn = (++)
  
        mergeMethodUses :: [MethodActionUses] -> MethodActionUses
        mergeMethodUses ms = M.unionsWith (M.unionWith mergeUsesFn) ms
  
        mergeFFuncUses :: [FFuncActionUses] -> FFuncActionUses
        mergeFFuncUses fs = M.unionsWith mergeUsesFn fs
  
        (muss, fuss) = unzip uss
    in
        (mergeMethodUses muss, mergeFFuncUses fuss)
  
  mergeExprUsesM :: [ExprUses] -> UCM (ExprUses)
  mergeExprUsesM uss = do
    let
        mergeUsesFnM :: M.Map AExpr UseCond -> M.Map AExpr UseCond ->
                        UCM (M.Map AExpr UseCond)
        mergeUsesFnM us1 us2 = map_unionWithM orUseCondM us1 us2
  
        mergeMethodUsesM :: [MethodExprUses] -> UCM (MethodExprUses)
        mergeMethodUsesM ms = map_unionsWithM (map_unionWithM mergeUsesFnM) ms
  
        mergeFFuncUsesM :: [FFuncExprUses] -> UCM (FFuncExprUses)
        mergeFFuncUsesM fs = map_unionsWithM mergeUsesFnM fs
  
        (muss, fuss) = unzip uss
    merged_mus <- mergeMethodUsesM muss
    merged_fus <- mergeFFuncUsesM fuss
    return (merged_mus, merged_fus)
  
  -- ----------
  
  addUseCond :: DefMap -> AExpr -> ExprUses -> ExprUses
  addUseCond dm c (mus, fus) =
      let
          addUC c' = andUseCond dm c c'
          isFalseCond c' = (c' == ucFalse)
  
          filterNullMethUses us =
              let us' = M.map (M.filter (not . M.null)) us
              in  M.filter (not . M.null) us'
          addCondMethUses us =
              let mapMethUses fn = M.map (M.map fn)
                  dropFalse = M.filter (not . isFalseCond)
              in  filterNullMethUses (mapMethUses (dropFalse . M.map addUC) us)
  
          filterNullFFUses us = M.filter (not . M.null) us
          addCondFFUses us =
              let mapFFUses fn = M.map fn
                  dropFalse = M.filter (not . isFalseCond)
              in  filterNullFFUses (mapFFUses (dropFalse . M.map addUC) us)
  
      in
          (addCondMethUses mus, addCondFFUses fus)
  
  -- extract common uses with the same condition
  -- only used in eDomain
  intersectUses :: ExprUses -> ExprUses -> ExprUses
  intersectUses (mus1, fus1) (mus2, fus2) = (mus', fus')
    where mus' = M.intersectionWith (M.intersectionWith M.intersection) mus1 mus2
          fus' = M.intersectionWith (M.intersection) fus1 fus2
  
  -- return only uses unique to the first set
  -- even if only the condition is different
  -- only used in eDomain
  minusUses :: ExprUses -> ExprUses -> ExprUses
  minusUses (mus1, fus1) (mus2, fus2) = (mus', fus')
    where mus' = M.differenceWith mapmapdiff mus1 mus2
          fus' = M.differenceWith mapdiff fus1 fus2
  
          mapmapdiff s1 s2 = toMaybe (not (M.null s')) s'
            where s' = M.differenceWith mapdiff s1 s2
          mapdiff s1 s2 = toMaybe (not (M.null s')) s'
            where s' = s1 `M.difference` s2
  
  -- ==============================
  -- Data Types: RuleUses
  
  -- predicate uses, action read uses, action write uses
  -- note: actionvalue method calls will start out being mentioned in both
  -- the action read and write uses, but we will filter out the read uses
  data RuleUses = RuleUses ExprUses ExprUses ActionUses
  
  instance PPrint RuleUses where
      pPrint d i (RuleUses pus rus wus) =
         let pmus = toListMethodExprUses $ getMethodExprUses pus
             rmus = toListMethodExprUses $ getMethodExprUses rus
             wmus = toListMethodActionUses $ getMethodActionUses wus
             pfus = toListFFExprUses $ getFFuncExprUses pus
             rfus = toListFFExprUses $ getFFuncExprUses rus
             wfus = toListFFActionUses $ getFFuncActionUses wus
         in  sep [
                  sep [text "predicate reads (methods):", pPrint d i pmus],
                  sep [text "action reads (methods):", pPrint d i rmus],
                  sep [text "action writes (methods):", pPrint d i wmus],
                  sep [text "predicate reads (funcs):", pPrint d i pfus],
                  sep [text "action reads: (funcs)", pPrint d i rfus],
                  sep [text "action writes: (funcs)", pPrint d i wfus]
                 ]
  
  instance Show RuleUses where
     show ruses = ppReadable ruses
  
  -- AAddSchedAssumps uses the RuleUsesMap to generate the code to check
  -- "conflict_free" assumptions.
  -- XXX This function returns the old UniqueUses datatype, so that
  -- XXX AAddSchedAssumps doesn't have to change, even though we've changed
  -- XXX the internal representation.
  ruleMethodUsesToUUs :: RuleUses -> MethodUsesList
  ruleMethodUsesToUUs (RuleUses pus rus wus) =
      getMethodUUExprs pus ++
      getMethodUUExprs rus ++
      getMethodUUActions wus
  
  -- ==============================
  -- Data Types: RuleUsesMap
  
  -- A map from rule names to the methods used in the rule.
  -- This is paired with the rule's predicate to save the effort of a
  -- separate lookup when computing the full condition for a method call
  -- (the condition of the call AND'd with the rule's predicate).
  type RuleUsesMap = M.Map RuleId (AExpr, RuleUses)
  
  -- This is still around for ASchedule to idenitfy common Action uses
  -- between two rules, for warning about arbitrary earliness.
  -- XXX A more abstract entry point might be good?
  rumGetActionUses :: RuleUsesMap -> ARuleId -> ActionUses
  rumGetActionUses m r = case M.lookup r m of
                Just (_, RuleUses _ _ range) -> range
                _ -> errNotInUseMap r
  
  -- The following are intended as more abstract entry points for ASchedule:
  
  -- whether a rule uses foreign functions
  rumRuleUsesFF :: RuleUsesMap -> ARuleId -> Bool
  rumRuleUsesFF m r =
      case M.lookup r m of
        Just (_, RuleUses preds domain range) ->
            let eUsesFF = not . M.null . getFFuncExprUses
                aUsesFF = not . M.null . getFFuncActionUses
            in  eUsesFF preds || eUsesFF domain || aUsesFF range
        _ -> errNotInUseMap r
  
  -- convert a RuleUseMap to a map from rule Id to the list of Ids of
  -- submodules whose methods are used by the rule
  rumToObjectMap :: RuleUsesMap -> M.Map ARuleId (S.Set Id)
  rumToObjectMap m =
     let usesToObjIds (_, RuleUses preds domain range) =
             let eObjIds = M.keysSet . getMethodExprUses
                 aObjIds = M.keysSet . getMethodActionUses
             in  S.unions [eObjIds preds, eObjIds domain, aObjIds range]
     in  M.map usesToObjIds m
  
  -- convert a RuleUseMap to a map from rule Id to the methods that
  -- the rule uses (grouped by submodule Id) mapped to their uses
  rumToMethodUseMap :: RuleUsesMap ->
                       M.Map ARuleId (AExpr, M.Map Id (M.Map Id [UniqueUse]))
  rumToMethodUseMap m =
      let usesToMethMap (pred, RuleUses preds domain range) =
              let toE (e, c) = UUExpr e c
                  toA a = UUAction a
                  convE = M.map (M.map (map toE . M.toList)) . getMethodExprUses
                  convA = M.map (M.map (map toA)) . getMethodActionUses
              in  (pred, M.unionsWith (M.unionWith (++)) [convE preds, convE domain, convA range])
      in  M.map usesToMethMap m
  
  -- a map from the submodules that a rule calls methods on
  -- to the set of methods which are used
  rumGetMethodIdMap :: RuleUsesMap -> ARuleId -> M.Map Id (S.Set Id)
  rumGetMethodIdMap m r =
      case M.lookup r m of
        Just (_, RuleUses preds domain range) ->
            let convE us = M.map (M.keysSet) (getMethodExprUses us)
                convA us = M.map (M.keysSet) (getMethodActionUses us)
            in  M.unionsWith (S.union) [convE preds, convE domain, convA range]
        _ -> errNotInUseMap r
  
  -- a list of all the submodule methods that a rule uses
  -- (a flattened version of "rumGetMethodIdMap")
  rumGetMethodIds :: RuleUsesMap -> ARuleId -> [MethodId]
  rumGetMethodIds m r = [ MethodId objId methId
                          | (objId, methset) <- M.toList $ rumGetMethodIdMap m r,
                            methId <- S.toList methset ]
  
  -- ==============================
  -- Expr collection monad
  
  -- This Use-Condition Monad (UCM) performs CSE on expression use conditions,
  -- possibly creating new defs.  This is to address the "Ek bug" (1388) where
  -- conditions that can be expressed with linear defs were instead being
  -- expressed with expontential defs.
  
  type DefMap = M.Map AId AExpr
  type DefUseMap = M.Map AId ExprUses
  
  -- condition under which an AExpr is used
  -- since AExprs do not contain their condition (unlike AActions)
  
  data UCState = UCState { nextNo :: !Int,
                           new_defs :: [ADef],
                           defMap :: DefMap,
                           defUseMap :: DefUseMap,
                           cseMap :: M.Map AExpr (AId, AType)
                         }
  
  type UCM a = State (UCState) a
  
  getDefMap :: UCM (DefMap)
  getDefMap = liftM defMap get
  
  getDefUses:: AId -> UCM (ExprUses)
  getDefUses i = do
    um <- liftM defUseMap $ get
    case (M.lookup i um) of
      Just uses -> do
          -- traceM ("getDefUses hit:" ++ ppReadable i)
          return uses
      Nothing -> do
        -- traceM ("getDefUses miss: " ++ ppReadable (i, M.size um))
        dm <- getDefMap
        let err = errNoDef i
        let e = M.findWithDefault err i dm
        uses <- eDomain e
        s <- get
        let um' = M.insert i uses (defUseMap s)
        put (s { defUseMap = um' })
        -- traceM ("getDefUses: " ++ ppReadable (i, e, uses))
        return uses
  
  initUCState :: [ADef] -> UCState
  initUCState defs = UCState {
                       nextNo = 1,
                       new_defs = [],
                       -- is throwing away props incorrect?
                       cseMap = M.fromList [(e, (i,t)) | ADef i t e _props <- defs ],
                       defMap = M.fromList [(i, e) | ADef i _ e _props <- defs ],
                       defUseMap = M.empty
                     }
  
  runUCState :: [ADef] -> UCM a -> (a, [ADef])
  runUCState defs m = (res, new_defs s)
     where (res, s) = runState m (initUCState defs)
  
  aUsesPref :: String
  aUsesPref = "__duses"
  
  getNextNo :: UCM (Int)
  getNextNo = do
    s <- get
    let no = nextNo s
    put s { nextNo = no + 1 }
    return no
  
  newDef :: AExpr -> UCM (AId, AType)
  newDef e = do
    no <- getNextNo
    let pos = getPosition e
    let i = setBadId (mkId pos (mkFString (aUsesPref ++ (show no))))
    let t = aType e
    let def = ADef i t e [] -- props from somewhere? xxx
    s <- get
    let new_defs' = def : (new_defs s)
    let cseMap' = M.insert e (i,t) (cseMap s)
    put (s { new_defs = new_defs', cseMap = cseMap' })
    return (i, t)
  
  getCseMap :: UCM (M.Map AExpr (AId, AType))
  getCseMap = liftM cseMap $ get
  
  cseWithArgs :: AExpr -> UCM (AExpr)
  cseWithArgs e = do
    cseMap <- getCseMap
    case (M.lookup e cseMap) of
      Just (i, t) -> return (ASDef t i)
      Nothing -> do
        let args = ae_args e
        args' <- mapM cse args
        let e' = e { ae_args = args' }
        cseMap <- getCseMap
        case (M.lookup e' cseMap) of
          Just (i, t) -> return (ASDef t i)
          Nothing -> do (i, t) <- newDef e'
                        return (ASDef t i)
  
  cse :: AExpr -> UCM (AExpr)
  cse e@(APrim { }) = cseWithArgs e
  cse e@(AMethCall { }) = cseWithArgs e
  cse e@(ANoInlineFunCall { }) = cseWithArgs e
  cse e@(AFunCall { }) = cseWithArgs e
  cse e = return e
  
  -- true expressions, false expressions, equality set, not-equality set
  data UseCond = UseCond { true_exprs :: S.Set AExpr,
                           false_exprs :: S.Set AExpr,
                           eq_map :: M.Map AExpr IntLit,
                           neq_map :: M.Map AExpr (S.Set IntLit)
                         }
    deriving (Show, Eq, Ord)
  
  instance Hyper UseCond where
    hyper (UseCond a b c d) y = hyper4 a b c d y
  
  ucTrue, ucFalse :: UseCond
  ucTrue  = UseCond S.empty S.empty M.empty M.empty
  ucFalse = UseCond (S.singleton (aFalse)) S.empty M.empty M.empty
  
  {-
  isTrueUseCond uc = S.null (true_exprs uc) &&
                     S.null (false_exprs uc) &&
                     M.null (eq_map uc) &&
                     M.null (neq_map uc)
  -}
  
  -- prepare for ORing two use conditions by capturing
  -- overlapping AND terms and making a residual expression
  preOrUseCond :: UseCond -> UseCond -> (UseCond, AExpr)
  preOrUseCond uc1 uc2 =
      {-
      trace ("uc1: " ++ ppReadable (true_exprs uc1, false_exprs uc1,
                                    eq_map uc1, neq_map uc1)) $
      trace ("uc2: " ++ ppReadable (true_exprs uc2, false_exprs uc2,
                                    eq_map uc2, neq_map uc2)) $
      trace ("shared_uc: " ++ ppReadable (shared_true, shared_false,
                                          shared_eq, shared_neq)) $
      trace ("uc1_rest: " ++ ppReadable (true1, false1, eq1, neq1)) $
      trace ("uc2_rest: " ++ ppReadable (true2, false2, eq2, neq2)) $
      -}
      (shared_uc, or_expr)
    where shared_true  =
              S.intersection (true_exprs uc1) (true_exprs uc2)
          shared_false = S.intersection (false_exprs uc1) (false_exprs uc2)
          -- only keep eq_map entries if they equal the same value
          eq_match i1 i2 = toMaybe (i1 == i2) i1
          shared_eq = M.mapMaybe id $
                      (M.intersectionWith eq_match (eq_map uc1) (eq_map uc2))
          shared_neq = M.filter (not . S.null) $
                       (M.intersectionWith S.intersection) (neq_map uc1) (neq_map uc2)
          shared_uc = UseCond shared_true shared_false shared_eq shared_neq
          true1 = (true_exprs uc1) `S.difference` shared_true
          true2 = (true_exprs uc2) `S.difference` shared_true
          false1 = (false_exprs uc1) `S.difference` shared_false
          false2 = (false_exprs uc2) `S.difference` shared_false
          eq1 = (eq_map uc1) `M.difference` shared_eq
          eq2 = (eq_map uc2) `M.difference` shared_eq
          -- when neq expressions overlap,
          -- check if there are residual terms to preserve
          -- M.differenceWith keeps the original terms otherwise
          neq_diff s1 s2 = toMaybe (not (S.null base_result)) base_result
             where base_result = s1 `S.difference` s2
          neq1 = M.differenceWith neq_diff (neq_map uc1) shared_neq
          neq2 = M.differenceWith neq_diff (neq_map uc2) shared_neq
          uc1_rest = UseCond true1 false1 eq1 neq1
          uc2_rest = UseCond true2 false2 eq2 neq2
          or_expr = aOr (useCondToAExpr uc1_rest) (useCondToAExpr uc2_rest)
  
  orUseCond :: UseCond -> UseCond -> UseCond
  orUseCond  uc1 uc2 = if (isTrue or_expr) then uc else uc'
    where (uc, or_expr) = preOrUseCond uc1 uc2
          uc' = uc { true_exprs = S.insert or_expr (true_exprs uc) }
  
  orUseCondM :: UseCond -> UseCond -> UCM UseCond
  orUseCondM uc1 uc2 = do
    let (uc, or_expr) = preOrUseCond uc1 uc2
    if (isTrue or_expr) then
      return (uc)
     else do
      or_expr' <- cse or_expr
      let uc' = uc { true_exprs = S.insert or_expr' (true_exprs uc) }
      return uc'
  
  -- Ravi's original comments:
  --   we don't worry about expanding definitions here (even though the
  --   resulting conditions become predicates in conflict-free assumptions)
  --   because the only issue would be with port-limited resources that need
  --   are converted to port references (everything else is rearranging of
  --   known definitions and method calls)
  --   port references are looked up by the full method call expression
  --   (see AState.hs) and we don't change that
  -- However, we do need to avoid inlining "noinline" function calls; so this
  -- has been re-structured to back out the very last inlined def, if it
  -- doesn't make progress.
  --
  andUseCond :: DefMap -> AExpr -> UseCond -> UseCond
  andUseCond dm e c = andUseCond' dm Nothing e c
  
  andUseCond' :: DefMap -> Maybe AExpr -> AExpr -> UseCond -> UseCond
  andUseCond' dm _ d@(ASDef _ i) uc =
      andUseCond' dm (Just d) (M.findWithDefault err i dm) uc
    where err = internalError ("AUses.andUseCond - unknown def: " ++ ppReadable i)
  andUseCond' dm _ (APrim _ _ PrimBNot [e]) uc = doBNot Nothing e
    where doBNot _ d@(ASDef _ i) = doBNot (Just d) (M.findWithDefault (err i) i dm)
          doBNot _ (APrim _ _ PrimEQ [x, ASInt _ _ i]) = doNEq x i uc
          doBNot (Just d) _ = addFalse d uc  -- don't inline the def
          doBNot Nothing e' = addFalse e' uc
          err i = internalError ("AUses.andUseCond - unknown def: " ++ ppReadable i)
  andUseCond' dm _ eq@(APrim _ _ PrimEQ [x, ASInt _ _ i]) uc = doEQ x i uc
  andUseCond' dm _ e uc | length es > 1 =
      {-# SCC "aucFold" #-} foldl' (flip (andUseCond' dm Nothing)) uc es
    where es = getAnds Nothing e
          getAnds _ (APrim _ _ PrimBAnd es') = concatMap (getAnds Nothing) es'
          getAnds _ d@(ASDef _ i) = getAnds (Just d) (M.findWithDefault (err i) i dm)
          getAnds (Just d) _ = [d]  -- don't inline the def
          getAnds Nothing e' = [e']
          err i = internalError ("AUses.andUseCond - unknown def: " ++ ppReadable i)
  andUseCond' dm (Just d) _ uc = addTrue d uc  -- don't inline the def
  andUseCond' dm Nothing e' uc = addTrue e' uc
  
  doNEq :: AExpr -> IntLit -> UseCond -> UseCond
  doNEq x i uc =
      case (M.lookup x (eq_map uc)) of
        Just j ->
            if (i == j) then ucFalse else uc
        Nothing ->
           let neq' = M.insertWith (S.union) x (S.singleton i) (neq_map uc)
           in uc { neq_map = neq' }
  
  doEQ :: AExpr -> IntLit -> UseCond -> UseCond
  doEQ x i uc =
    case (M.lookup x (eq_map uc)) of
      Just j -> if i == j then uc else ucFalse
      Nothing ->
        case (M.lookup x (neq_map uc)) of
          Just s ->
              if (i `S.member` s) then ucFalse
              else let eq' = M.insert x i (eq_map uc)
                       neq' = M.delete x (neq_map uc)
                   in uc { eq_map = eq', neq_map = neq' }
          Nothing -> let eq' = M.insert x i (eq_map uc)
                     in uc { eq_map = eq' }
  
  addFalse :: AExpr -> UseCond -> UseCond
  addFalse e uc
      | isFalse e                    = uc
      | e `S.member` (true_exprs uc) = ucFalse
      | isTrue e                     = ucFalse
      | otherwise                    = uc { false_exprs = S.insert e (false_exprs uc) }
  
  addTrue :: AExpr -> UseCond -> UseCond
  addTrue e uc
      | e `S.member` (false_exprs uc) = ucFalse
      | isFalse e                     = ucFalse
      | isTrue e                      = uc
      | otherwise                     = uc { true_exprs = S.insert e (true_exprs uc) }
  
  -- ==============================
  -- Function: Build the RuleUsesMap and use it to build the MethodUsesMap
  
  buildUseMaps :: [ADef] -> [Rule] -> [AVInst] -> (RuleUsesMap, MethodUsesMap, [ADef])
  buildUseMaps defs rules avis = (rum, mum, reverse new_defs)
    where ((rum, mum), new_defs) = runUCState defs m
          m = do rum <- ruleUsesMap rules
                 -- traceM (ppReadable rum)
                 mum <- createMethodUsesMap rum avis
                 return (rum, mum)
  
  ruleUsesMap :: [Rule] -> UCM RuleUsesMap
  ruleUsesMap rules = liftM M.fromList (mapM f rules)
    where f r = do ru <- rUses r
                   let rp = aAnds (rulePred r)
                   return (ruleName r, (rp, ru))
  
  rUses :: Rule -> UCM (RuleUses)
  rUses (Rule _ _ preds reads writes) = do
    (wDomains, wRanges) <- mapAndUnzipM aUses writes
  
    -- could condition on the preds, but the users of this info
    -- already do that, so it is redundant
    rDomains <- mapM eDomain reads
  
    pDomains <- mapM eDomain preds
    ps <- mergeExprUsesM pDomains
    rs <- mergeExprUsesM (rDomains ++ wDomains)
    -- Action uses don't require monadic merging
    let ws = mergeActionUses wRanges
    return (RuleUses ps rs ws)
  
  aUses :: AAction -> UCM (ExprUses, ActionUses)
  aUses a@(ACall i mi (c:es)) = do
      cond_uses <- eDomain c
      dm <- getDefMap
      arg_uses  <- liftM (map (addUseCond dm c)) $ mapM eDomain es
      expr_uses <- mergeExprUsesM (cond_uses : arg_uses)
      let action_uses = singleMethodActionUse i (unQualId mi) a
      return (expr_uses, action_uses)
  
  aUses a@(AFCall { aact_objid = i, aact_args = (c:es) }) = do
      cond_uses <- eDomain c
      dm <- getDefMap
      arg_uses  <- liftM (map (addUseCond dm c)) $ mapM eDomain es
      expr_uses <- mergeExprUsesM (cond_uses : arg_uses)
      let action_uses = singleFFuncActionUse i a
      return (expr_uses, action_uses)
  
  aUses a@(ATaskAction { aact_objid = i, aact_args = (c:es) }) = do
      cond_uses <- eDomain c
      dm <- getDefMap
      arg_uses  <- liftM (map (addUseCond dm c)) $ mapM eDomain es
      expr_uses <- mergeExprUsesM (cond_uses : arg_uses)
      let action_uses = singleFFuncActionUse i a
      return (expr_uses, action_uses)
  
  aUses a = internalError ("AUses - action without condition: " ++ ppReadable a)
  
  eDomain :: AExpr -> UCM (ExprUses)
  -- special cases for non-strict primitives
  eDomain (APrim _ _ PrimIf [cnd, thn, els]) = do
    cond_uses <- eDomain cnd
    thn_uses  <- eDomain thn
    els_uses  <- eDomain els
    dm <- getDefMap
    let common_uses = thn_uses `intersectUses` els_uses
        thn_only    = addUseCond dm cnd (thn_uses `minusUses` els_uses)
        els_only    = addUseCond dm (aNot cnd) (els_uses `minusUses` thn_uses)
    mergeExprUsesM [cond_uses, common_uses, thn_only, els_only]
  eDomain (APrim _ _ PrimBAnd [x, y]) = do
    x_uses <- eDomain x
    y_uses <- eDomain y
    dm <- getDefMap
    let common = x_uses `intersectUses` y_uses
        x_only = addUseCond dm y (x_uses `minusUses` y_uses)
        y_only = addUseCond dm x (y_uses `minusUses` x_uses)
    -- XXX Why is this not the monadic version "mergeExprUsesM"?
    -- XXX This could be a deliberate decision by Ravi to not CSE ANDed terms.
    -- XXX See, for instance, revision 14202.
    return (mergeExprUses [common, x_only, y_only])
  eDomain (APrim _ _ PrimBOr [x, y]) = do
     x_uses <- eDomain x
     y_uses <- eDomain y
     dm <- getDefMap
     let common = x_uses `intersectUses` y_uses
         x_only = addUseCond dm (aNot y) (x_uses `minusUses` y_uses)
         y_only = addUseCond dm (aNot x) (y_uses `minusUses` x_uses)
     mergeExprUsesM [common, x_only, y_only]
  eDomain (APrim _ _ PrimArrayDynSelect [arr_e, idx_e]) = do
     idx_uses <- eDomain idx_e
     arr_uses <- eDomainArray idx_e arr_e
     mergeExprUsesM [idx_uses, arr_uses]
  eDomain (APrim { ae_args = es }) =
      -- should primitives have resource constraints?
      mapM eDomain es >>= mergeExprUsesM
  eDomain e@(AMethCall _ i mi es) = do
      let this_use = singleMethodExprUse i (unQualId mi) e ucTrue
      es_uses <- mapM eDomain es
      mergeExprUsesM (this_use : es_uses)
  eDomain e@(AFunCall { ae_objid = i, ae_args = es }) = do
      let this_use = singleFFuncExprUse i e ucTrue
      es_uses <- mapM eDomain es
      mergeExprUsesM (this_use : es_uses)
  -- don't count noinline functions
  eDomain e@(ANoInlineFunCall { ae_objid = i, ae_args = es }) =
      mapM eDomain es >>= mergeExprUsesM
  -- don't count the return value uses of actionvalue, only the action part
  eDomain (AMethValue { }) = return noExprUses
  -- the uses are counted on the action side
  eDomain (ATaskValue { }) = return noExprUses
  eDomain e@(ASPort _ i) = return noExprUses
  eDomain e@(ASParam _ i) = return noExprUses
  eDomain (ASDef _ d) = getDefUses d
  eDomain (ASInt _ _ _) = return noExprUses
  eDomain (ASReal _ _ _) = return noExprUses
  eDomain (ASStr _ _ _) = return noExprUses
  eDomain (ASAny _ _) = return noExprUses
  -- these are now expected, as eDomain is called on instantiation arguments
  eDomain e@(ASClock { }) = return noExprUses
      --internalError ("AUses.eDomain unexpected clock" ++ ppReadable e)
  eDomain e@(ASReset { }) = return noExprUses
      --internalError ("AUses.eDomain unexpected reset" ++ ppReadable e)
  eDomain e@(ASInout { }) = return noExprUses
  eDomain e@(AMGate { }) = return noExprUses
  
  eDomainArray :: AExpr -> AExpr -> UCM (ExprUses)
  {-
  -- XXX PrimArrayDynSelect would have been pushed into the arms,
  -- XXX so this shouldn't occur
  eDomainArray idx_e (APrim _ _ PrimIf [cnd, thn, els]) = do
    cond_uses <- eDomain cnd
    thn_uses  <- eDomainArray idx_e thn
    els_uses  <- eDomainArray idx_e els
    dm <- getDefMap
    let common_uses = thn_uses `intersectUses` els_uses
        thn_only    = addUseCond dm cnd (thn_uses `minusUses` els_uses)
        els_only    = addUseCond dm (aNot cnd) (els_uses `minusUses` thn_uses)
    mergeExprUsesM [cond_uses, common_uses, thn_only, els_only]
  -}
  eDomainArray idx_e (APrim _ _ PrimBuildArray es) = do
    let max_idx = case (aType idx_e) of
                    ATBit sz -> (2^sz) - 1
                    _ -> internalError ("eDomainArray: idx_ty")
    -- XXX what about indexing out of range?
    -- XXX should the last element be considered the default
    let mkEq e n = APrim defaultAId aTBool PrimEQ [e, aNat n]
        mkUses (n, e) = do
          e_uses <- eDomain e
          dm <- getDefMap
          return $ addUseCond dm (mkEq idx_e n) e_uses
    -- only consider uses up to the maximum indexable element
    es_uses <- mapM mkUses (zip [0..max_idx] es)
    mergeExprUsesM es_uses
  eDomainArray idx_e (ASDef _ i) = do
    -- XXX can we memoize results?
    dm <- getDefMap
    let arr_e' = M.findWithDefault (errNoDef i) i dm
    eDomainArray idx_e arr_e'
  eDomainArray _ arr_e =
    internalError ("eDomainArray: unhandled: " ++ ppReadable arr_e)
  
  -- ==============================
  -- Data Types: MethodUsesMap
  
  -- The users are:
  -- * rules that use it in their predicate,
  -- * rules that use it in their body (action), and
  -- * submodule instantiations that use it in port connections.
  type MethodUsers = ([RuleId], [RuleId], [AId])
  
  -- XXX This could return an Either, instead of UniqueUse
  type MethodUsesMap = M.Map MethodId [(UniqueUse, MethodUsers)]
  
  type MethodUsesList = [(MethodId, [UniqueUse])]
  
  mergeUseMapData :: [(UniqueUse, MethodUsers)] -> [(UniqueUse, MethodUsers)] -> [(UniqueUse, MethodUsers)]
  mergeUseMapData a b | null exprBlobs   = actionMergeResult
                      | null actionBlobs = exprMergeResult
                      | otherwise = internalError("Method has both action and expr uses " ++ ppReadable blobs)
    where blobs = a ++ b
          (actionBlobs, exprBlobs) = partition (isUUAction . fst) blobs
          actionMergeResult = M.toList (M.fromListWith concatMethodUsers blobs)
          -- UUExpr merging needs to be handled carefully because we
          -- want to be able to look up uses without the use condition
          exprCondMerge (c1, u1) (c2, u2) = (orUseCond c1 c2, concatMethodUsers u1 u2)
          exprMergeList = [(e, (c, mus)) | (UUExpr e c, mus) <- blobs ]
          exprMergeMap  = M.fromListWith exprCondMerge exprMergeList
          exprMergeResult = [(UUExpr e c, mus) | (e, (c, mus)) <- M.toList exprMergeMap]
  
  
  concatMethodUsers :: MethodUsers -> MethodUsers -> MethodUsers
  concatMethodUsers (a,b,c) (d,e,f) = (a++d, b++e, c++f)
  
  -- ==============================
  -- Function: Create a MethodUsesMap
  --     by inverting a RuleUsesMap and adding uses from submodule instance
  
  getMethodUUExprs :: ExprUses -> [(MethodId, [UniqueUse])]
  getMethodUUExprs = toListMethodExprUses . getMethodExprUses
  
  getMethodUUActions :: ActionUses -> [(MethodId, [UniqueUse])]
  getMethodUUActions = toListMethodActionUses . getMethodActionUses
  
  createMethodUsesMap :: RuleUsesMap -> [AVInst] -> UCM (MethodUsesMap)
  createMethodUsesMap rmap avis = do
    let methodUsesMap0 = invertRuleUsesMap rmap
    instUses <- aInstUseMap avis
    -- reverse the instance use-map
    let inst_edges = [(mId, [(uuse, ([], [], [instId])) | uuse <- us])
                           | (instId, uses) <- instUses,
                             -- uses for each method
                             (mId, us) <- getMethodUUExprs uses ]
    -- add the instance edges to the initial map (of just rule uses)
    -- add the edges to the initial map (of just rule uses)
        methodUsesMap =
            foldr (uncurry (M.insertWith (mergeWith muUnion))) methodUsesMap0 inst_edges
        -- function for merging the new edges
        -- XXX takes advantage of the new edges not having rule uses
        muUnion (_,_,zs) (xs',ys',zs') = (xs', ys', union zs zs')
  
    return (methodUsesMap)
  
  -- convert (rule -> method -> uses) to (method -> uses -> users)
  -- (list of instance users will be empty in the map)
  invertRuleUsesMap :: RuleUsesMap -> MethodUsesMap
  invertRuleUsesMap rMap =
      foldr (uncurry (M.insertWith mergeUseMapData)) M.empty $
      [cvt rId uses | (rId, (_, RuleUses pUses rUses wUses)) <- M.toList rMap,
                      let pMUses = getMethodUUExprs pUses,
                      let rMUses = getMethodUUExprs rUses,
                      let wMUses = getMethodUUActions wUses,
                      uses <- map Left pMUses ++ map Right (wMUses ++ rMUses)]
      where
          -- convert a Left/Right use into the proper triple form, for merging
          -- (Left for predicate uses, Right for action reads/writes)
          cvt rId (Left (mId, us)) =
              (mId, [(uUse, ([rId], [], [])) | uUse <- us])
          cvt rId (Right (mId, us)) =
              (mId, [(uUse, ([], [rId], [])) | uUse <- us])
  
  -- create a mapping from an instance Id to the list of method call uses
  -- in the instantiation of that submodule
  -- (just returns the list form of the map, not a Map)
  -- there is redundant computation here because we rebuild
  -- the defUseMap and the defMap instead of reusing them
  aInstUseMap :: [AVInst] -> UCM [(AId, ExprUses)]
  aInstUseMap avis = mapM iUses avis
    where iUses avi = do
            arg_uses <- (mapM eDomain (avi_iargs avi) >>= mergeExprUsesM)
            return (avi_vname avi, arg_uses)
  
  -- ==============================
  -- Errors
  
  errNotInUseMap :: ARuleId -> a
  errNotInUseMap r =
      internalError $
          "AUses: inconsistent ATS (rule " ++ ppString r ++ " not in use map)"
  
  errNoDef :: AId -> a
  errNoDef d =
      internalError $
          "AUses: inconsistent ATS (no definition for " ++ ppString d ++ ")"
  
  -- ==============================
  