module Test.SBench.Space.OptionSet where

import Test.SBench.Options
import Test.SBench.STerm ( Algorithm, STerm(..) )

-- | * Compiler options

-- | Options always added when compiling for space profiling.
generalCOpts :: CompilerOptions
generalCOpts =
    [ "--make"
    , "-prof"
    , "-rtsopts"
    ]

-- | default compiler options additional to 'generalCOpts'.
defltCOpts :: CompilerOptions
defltCOpts = 
    [ "-auto-all" 
    , "-caf-all"
    , "-O2"
    ]


-- * Build options

-- | By default repetitions are calculated automatically
defltRep :: Maybe Repetitions
defltRep = Nothing

-- | Default profiling options.
defltProfOpts :: ProfilingOptions
defltProfOpts = 
    [ PPBreakdown  BCostCentreStack  -- RTS heap prof settings
    , PPInterval 0.02
    , PPNameLength 60
    ]

-- | Default test options, i.e. default options for compiling and running
--   a program for space profiling.
defltTestOpts :: TestOpts
defltTestOpts = TOpts
  { cOpts = defltCOpts
  , rOpts = ROpts
    { threadNum = Nothing
    , profOpts  = defltProfOpts
    , memOpts   = []
    , progArgs  = []
    }
  , reps  = Nothing
  , nfInp = False
  }

addCC :: Algorithm a -> TestOpts -> TestOpts
addCC alg opts = 
    opts { 
      rOpts = (rOpts opts) { 
        profOpts = PPRestriction RCCStackAny (stCC alg) : (profOpts (rOpts opts))
        }
      }

setRepetitions ::  Repetitions -> TestOpts -> TestOpts
setRepetitions rep opts = opts { reps = Just rep }

autoRepeat :: TestOpts -> TestOpts
autoRepeat opts = opts { reps = Nothing }

setMemSizes :: [MemSize] -> TestOpts -> TestOpts
setMemSizes ms opts =
    opts {rOpts = (rOpts opts) {memOpts = ms } }

setNfInput :: Bool -> TestOpts -> TestOpts
setNfInput b opts = opts { nfInp = b }