#!/usr/bin/runhaskell

import Prelude hiding (fail, uncurry)
import Data.Typeable
import Data.Maybe (fromMaybe)
import Control.Monad (liftM)
import qualified Termlib.Problem as Prob
import qualified Termlib.Trs as Trs
import qualified Tct.Processor.Args as A
import Tct.Methods
import Tct.Tcti
import Tct
import Tct.Processors((<|>))
import qualified Tct.Processor as P
import qualified Tct.Processor.Transformations as T
import Tct.Method.Predicates as Preds
import qualified Tct.Method.DP.DependencyGraph as DG

--------------------------------------------------------------------------------
--- tct program


main :: IO ()
main = tct defaultConfig { processors = strategy (const $ dc False 6) "competition"
                                        <|> strategy (const checknondup) "checknondup"
                                        <|> strategy (const cdimatrices) "cdimatrices"
                                        <|> strategy (const $ algmatrices 6) "algmatrices"
                                        <|> strategy (const $ edamatrices 6) "edamatrices"
                                        <|> strategy (const $ idamatrices 4) "idamatrices"
                                        <|> strategy (const $ arcmatrices 6) "arcmatrices"
                                        <|> strategy (const bothbounds) "bothbounds"
                                        <|> processors defaultConfig
                          , recompile = False} 

--------------------------------------------------------------------------------
-- abbreviations

-- matrix default options

dos = defaultOptions { cbits = Just 4, bits = 3}
lin   = dos { dim = 2, degree = Just 1}
quad  = dos { dim = 3, degree = Just 2}
cubic = dos { dim = 4, degree = Just 3}

lin2   = dos { dim = 1, degree = Just 1}
quad2  = dos { dim = 2, degree = Nothing}
cubic2 = dos { dim = 3, degree = Nothing}
quartic2 = dos { dim = 4, degree = Nothing}
quintic2 = dos { dim = 5, degree = Nothing}

-- linear, quadratic, cubic matrices
lm = matrix lin
qm = matrix quad
cm = matrix cubic

-- linear, quadratic, cubic weightgap transformation
lwg = weightgap lin
qwg = weightgap quad
cwg = weightgap cubic

linwg = weightgap lin2
quadwg = weightgap quad2
cubicwg = weightgap cubic2
quarticwg = weightgap quartic2
quinticwg = weightgap quintic2

--- try exhaustively:
--- exhaustively t == t+
--- te t = try (exhaustively t) == t*
te t = try (exhaustively t)

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

ifnondup p = ite (Preds.isDuplicating Strict ) fail p

checknondup = ifnondup success

cdimatrices = ifnondup $ matrix defaultOptions {dim = 2, degree = Nothing, cbits = Nothing, bits = 3, cert = Algebraic}

algmatrices bound = ifnondup $ fastest [matrix defaultOptions {dim = i, degree = Nothing, cbits = Just 4, bits = 3, cert = Algebraic} | i <- [1..bound]]

edamatrices bound = ifnondup $ fastest [matrix defaultOptions {dim = i, degree = Nothing, cbits = Just 4, bits = 3, cert = Automaton} | i <- [1..bound]]

idamatrices bound = ifnondup $ fastest [matrix defaultOptions {dim = i, degree = Just j, cbits = Just 4, bits = 3, cert = Automaton} | i <- [1..bound], j <- [1..i]]

arcmatrices bound = ifnondup $ fastest [arctic defaultOptions {dim = i, bits = 3} | i <- [1..bound]]

bothbounds = ifnondup $ bounds Minimal Match `orFaster` bounds PerSymbol Match

dc ip bound = ite (Preds.isDuplicating Strict) fail (if ip then P.someInstance innermost else P.someInstance full)
      where matrices simple c | simple = empty `before` fastest [matrix defaultOptions {dim = i, degree = Nothing, cbits= Just 4, bits=3, cert=c} | i <- [1..bound]]
                              | otherwise = empty `before` fastest [ matrix defaultOptions {dim = i, degree = Just j, cbits= Just 4, bits=3, cert=c} | (i,j) <- zip [1..bound] [1..]]

            direct      = matrices False Algebraic
            insidewg    = matrices False Algebraic
            matchbounds = bounds Minimal Match `orFaster` bounds PerSymbol Match
            wgs         = linwg <> quadwg <> cubicwg <> quarticwg <> quinticwg
            strategy    = direct `orFaster` (te wgs >>| insidewg) `orFaster` matchbounds
           
            innermost = try irr >>| try uncurry >>| strategy
            full =  try uncurry >>| strategy

rc usetuples = try irr >>| matricesBlockOf 2 `orFaster` matchbounds `orFaster` dp
    where matricesForDegree deg = [matrix defaultOptions {dim = n, degree = Just deg} | n <- [max 1 deg..max 5 deg]] -- brauchbare matrizen fuer einen grad
          
          matricesBlockOf l = fastest [ sequentially $ concatMap (\ j -> matricesForDegree (i + (j * l))) [0..] | i <- [1..max 1 l]] 
          -- fastest [ sequentially (matricesForDegree 1 ++ matricesForDegree (1 + l) ++ matricesForDegree (1 + 2l) ...  ] 
          --           , ..., 
          --           sequentially (matricesForDegree l ++ matricesForDegree (l + l) ++ matricesForDegree (l + 2l) ...  ] 
          -- dh l prozesse laufen parallel, und im rad sequentiell
          
          
          matchbounds = timeout 5 $ bounds Minimal Match `orFaster` bounds PerSymbol Match
          
          dp       = (if usetuples then dependencyTuples else dependencyPairs)
                     >>| usableRules 
                     >>| (insideDP 
                         `orFaster` (pathAnalysis >>|| usableRules >>| insideDP))
             where insideDP = te dpsimp >>| empty `before` (try wgUsables >>| te (try dpsimp >>> wgAll) >>| directs)
                   wgAll     = lwg <> qwg <> cwg
                   wgUsables = weightgap lin {on = WgOnTrs} 
                               <> weightgap quad {on = WgOnTrs} 
                               <> weightgap cubic {on = WgOnTrs}
                   -- composeMult = compose splitWithoutLeafs Mutl elim 
                   -- elim     = P.someInstance (try dpsimp >>| directs `before` insideDP) -- arrr
                   
                   directs  = empty `before` (matricesBlockOf 3 `orFaster` matchbounds)
                      
                   dpsimp   = removeTails >>> try simpDPRHS >>> usableRules


-- competition = strategy (const $ dc False  6) "competition 2011"
                              

--- dc strategies

            
-- convenience zum einhaengen von prozessoren
-- proc proc name = processor (const proc) Description { as = name, args = A.Unit, descr = [] }