content: {-|
  Copyright   :  Copyright (c) 2016, RISE SICS AB
  License     :  BSD3 (see the LICENSE file)
  Maintainer  :  rcas@acm.org
  -}
  {-
  Main authors:
    Roberto Castaneda Lozano <rcas@acm.org>
  
  Contributing authors:
    Patric Hedlin <patric.hedlin@ericsson.com>
    Mats Carlsson <mats.carlsson@ri.se>
  
  This file is part of Unison, see http://unison-code.github.io
  -}
  module Unison.Tools.Model.PresolverParameters (parameters) where
  
  import Data.Graph.Inductive
  import Data.List
  import Data.Aeson (toJSON)
  
  import Common.Util
  
  import Unison
  import Unison.Target.API
  import qualified Unison.Graphs.PG as PG
  
  import Unison.Tools.Model.Definitions()
  
  import qualified Data.Map as M
  import qualified Data.Set as S
  
  parameters oldModel (_, dgs, _, _, ra, _)
    f @ Function {fCode = code} target _ps =
    let oif         = operandInfo target
        pgs         = map (PG.nonNegative . PG.fromDependencyGraph oif) dgs
        domuses     = if oldModel then []
                      else sort $ concatMap dominatedUses pgs
        r2as        = regAtoms ra
        precs       = if oldModel then []
                      else concatMap (pgPrecs . PG.mandatory . PG.positive) pgs
        ts          = tUniqueOps $ flatten code
        assignhints = [(p, head $ r2as M.! r) | (p, r) <- assignmentHints f]
        interchangeable = sort $ concatMap interchangeableCopies code
        -- Default (empty presolver parameters)
        optional_min  = replicate (length code) 0 :: [Integer]
        active_tables = [] :: [Integer]
        tmp_tables = [] :: [Integer]
        nogoods = [] :: [Integer]
        nogoods2 = [] :: [Integer]
        precedences = [] :: [Integer]
        precedences2 = [] :: [Integer]
        before = [] :: [Integer]
        before2 = [] :: [Integer]
        across = [] :: [Integer]
        set_across = [] :: [Integer]
        domops = [] :: [Integer]
        last_use = [] :: [Integer]
        dominates = [] :: [Integer]
        difftemps = [] :: [Integer]
        diffregs = [] :: [Integer]
        calleesaved_spill = [] :: [Integer]
        strictly_congr = [] :: [Integer]
        quasi_adjacent = [] :: [Integer]
        long_latency_index = [] :: [Integer]
        long_latency_def_use = [] :: [Integer]
        subsumed_resources = map (\_ -> [] :: [Integer]) code
        temp_domain = map (\_ -> [] :: [Integer]) ts
        value_precede_chains = [] :: [Integer]
        wcet = [] :: [Integer]
    in
     [
        -- Parameters not generated by the SICStus-based presolver
  
        -- set of dominated uses
        -- example: domuses[2][0]: dominated operand in the third dominated use
        --          domuses[2][1]: dominant operand in the third dominated use
        --          domuses[2][2]: definer operand in the third dominated use
        ("domuses", toJSON domuses),
  
        -- set of precedences
        -- example: prec[1][0]: source of the second precedence
        --          prec[1][1]: target of the second precedence
        ("precs", toJSON precs),
  
        -- set of register assignment hints
        -- example: assignhints[3][0]: operand of fourth hint
        --          assignhints[3][0]: first register atom of fourth hint
        ("assignhints", toJSON assignhints),
  
        -- sets of interchangeable copies
        -- example: interchangeable[2][6]: seventh copy in third interchangeable set
        ("interchangeable", toJSON interchangeable),
  
        -- Default (empty) presolver parameters, see presolver doc
  
        ("optional_min", toJSON optional_min),
        ("active_tables", toJSON active_tables),
        ("tmp_tables", toJSON tmp_tables),
        ("nogoods", toJSON nogoods),
        ("nogoods2", toJSON nogoods2),
        ("precedences", toJSON precedences),
        ("precedences2", toJSON precedences2),
        ("before", toJSON before),
        ("before2", toJSON before2),
        ("across", toJSON across),
        ("set_across", toJSON set_across),
        ("domops", toJSON domops),
        ("last_use", toJSON last_use),
        ("dominates", toJSON dominates),
        ("difftemps", toJSON difftemps),
        ("diffregs", toJSON diffregs),
        ("calleesaved_spill", toJSON calleesaved_spill),
        ("strictly_congr", toJSON strictly_congr),
        ("quasi_adjacent", toJSON quasi_adjacent),
        ("long_latency_index", toJSON long_latency_index),
        ("long_latency_def_use", toJSON long_latency_def_use),
        ("subsumed_resources", toJSON subsumed_resources),
        ("temp_domain", toJSON temp_domain),
        ("value_precede_chains", toJSON value_precede_chains),
        ("wcet", toJSON wcet)
  
       ]
  
  dominatedUses pg
    | noNodes pg < blockLimit =
      let code  = PG.toCode pg
          pg'   = trc pg
          ts    = sort $ map undoPreAssign $ tUniqueOps code
          t2is  = [(t, potentialDefiner t code, potentialUsers t code) | t <- ts]
          t2is' = [(t, d, filter (precedesInPG pg d) us) | (t, d, us) <- t2is]
          duses = concatMap (dominatedUseTriples pg') t2is'
      in duses
    | otherwise = []
  
  dominatedUseTriples pg (t, d, us) =
    [mapTriple (tempOperand t) (u, u', d) | u <- us, u' <- us,
     oId u < oId u', precedesInPG pg u u']
  
  precedesInPG pg i i' = PG.toNodeId i' `elem` suc pg (PG.toNodeId i)
  
  pgPrecs pg = nub $ sort $ [(i, j) | (i, j, _) <- labEdges pg]
  
  assignmentHints Function { fCode = code } =
    let ts    = tUniqueOps $ flatten code
        t2r   = [(undoPreAssign t, r) | t @ Temporary {tReg = Just r} <- ts]
        ps    = concatMap boundaryOps code
        hints = concatMap (operandHints (M.fromList t2r)) ps
    in hints
  
  operandHints t2r p = [(p, t2r M.! t) | t <- extractTemps p, M.member t t2r]
  
  boundaryOps Block {bCode = code} =
    concatMap oAllOperands $ filter isDelimiter code
  
  -- Maximum number of nodes in a block for dominated uses
  blockLimit = 500
  
  interchangeableCopies Block {bCode = code} =
      let copies = filter isCopy code
          int    = fromListMult
                   [((oInstructions o, oUseTemps o, oUsers code o), oId o)
                   | o <- copies]
      in [sort os | (_, os) <- M.toList int, length os > 1]
  
  oUseTemps = map extractTemps . oUses
  
  oUsers code o =
    let [t] = extractTemps $ copyDestination o
    in S.fromList $
       filter (not . null)
       [[p | p <- oUseOperands o, isMOperand p, t `elem` altTemps p] | o <- code]
  