{-# OPTIONS_GHC -XTemplateHaskell #-}
module Igor2.Config (

    
    SCR(..), RecArgComp(..), defaultSCR,
    
    setDebug, setSimplify, setEnhanced, setPara, setRpdRlSplt, setDumpLog, 
    setVerbose, setVerbosity, setMaxLoops,setMaxTiers, setCmpRecArg, 
    setTargets, addTargets, delTargets, setBackground, addBackground, 
    delBackground, setPredicates, addPredicates, setCtxFile, delPredicates
    ) where

import Prelude hiding ((<$>))

import Data.List ((\\))

import Syntax
import Igor2.Ppr
import Igor2.Logging


--------------------------------------------------------------------------------
-- Synthesis Configuration Record (SCR)
--------------------------------------------------------------------------------

data SCR = SCR
    { scr_debug      :: Bool
    , scr_simplify   :: Bool
    , scr_enhanced   :: Bool
    , scr_para       :: Bool
    , scr_greedySplt  :: Bool
    , scr_accum      :: Bool
    , scr_greedyMtch :: Bool
    , scr_dumpLog    :: Bool
    , scr_verbose    :: Bool
    , scr_verbosity  :: Priority
    , scr_maxLoops   :: Integer
    , scr_maxTiers   :: Integer
    , scr_redOrder  :: RecArgComp
    , scr_tgts       :: [Name]
    , scr_bgks       :: [Name]
    , scr_preds      :: [(Name,Type)]
    , scr_ctxFile    :: FilePath
    }deriving(Eq,Show)

data RecArgComp = Linear | AWise
    deriving(Eq,Show,Read)
     
defaultSCR = SCR
    { scr_debug      = False
    , scr_simplify   = False
    , scr_enhanced   = False
    , scr_para       = False
    , scr_greedySplt  = False
    , scr_accum      = False
    , scr_greedyMtch = True
    , scr_dumpLog    = False
    , scr_verbose    = False
    , scr_verbosity  = INFO
    , scr_maxLoops   = (-1)
    , scr_maxTiers   = 0
    , scr_redOrder  = AWise
    , scr_tgts       = []
    , scr_bgks       = []
    , scr_preds      = defaultPredicates
    , scr_ctxFile    = ""
    }

defaultPredicates =
    [('(==), forallT [(''Eq, "a")] $ arrowT [varT "a", varT "a", boolCon])
--    , '(/=), forallT [(''Eq, "a")] $ arrowT [varT "a", varT "a", boolCon])
    ,('(<), forallT [(''Ord, "a")] $ arrowT [varT "a", varT "a", boolCon])
--    ,('(>=), forallT [(''Ord, "a")] $ arrowT [varT "a", varT "a", boolCon])
    ,('(>), forallT [(''Ord, "a")] $ arrowT [varT "a", varT "a", boolCon])
--    ,('(<=), forallT [(''Ord, "a")] $ arrowT [varT "a", varT "a", boolCon])
    ]
   

setDebug v scr = scr{scr_debug = v}
setSimplify   v scr = scr{scr_simplify = v}
setEnhanced   v scr = scr{scr_enhanced = v}
setRpdRlSplt  v scr = scr{scr_greedySplt = v}
setAccum      v scr = scr{scr_accum = v}
setPara       v scr = scr{scr_para = v}
setDumpLog    v scr = scr{scr_dumpLog = v}
setVerbose    v scr = scr{scr_verbose = v}
setVerbosity  v scr = scr{scr_verbosity = v}
setMaxLoops   v scr = scr{scr_maxLoops = v}
setMaxTiers   v scr = scr{scr_maxTiers = v}
setCmpRecArg  v scr = scr{scr_redOrder = v}
setTargets    v scr = scr{scr_tgts = v}
setCtxFile    v scr = scr{scr_ctxFile = v}
addTargets    v scr = scr{scr_tgts = (scr_tgts scr) ++ v}
delTargets    v scr = scr{scr_tgts = (scr_tgts scr) \\ v}
setBackground v scr = scr{scr_bgks = v}
addBackground v scr = scr{scr_bgks = (scr_bgks scr) ++ v}
delBackground v scr = scr{scr_bgks = (scr_bgks scr) \\ v}
setPredicates v scr = scr{scr_preds = v}
addPredicates v scr = scr{scr_preds = (scr_preds scr) ++ v}
delPredicates v scr = scr{scr_preds = (scr_preds scr) \\ v}

instance Pretty SCR where
    pretty c = (fill 20 (text "Targets") <+> hsep (map (squotes.pretty) (scr_tgts c)) <$>
                fill 20 (text "Background") <+> 
                    (if null (scr_bgks c) then text "<none>"
                       else hsep (map (squotes.pretty) (scr_bgks c))) <$>             
                fill 20 (text "Simplified") <+> bool (scr_simplify c) <$>                            
                fill 20 (text "Greedy rule-splitting") <+> bool (scr_greedySplt c) <$> 
                fill 20 (text "Accumulators") <+> bool (scr_accum c) <$>
                fill 20 (text "Enhanced") <+> bool (scr_enhanced c) <$> 
                fill 20 (text "Use paramorphisms") <+> bool (scr_para c) <$>   
                fill 20 (text "Compare rec args") <+> pretty (show.scr_redOrder $ c) <$>             
                fill 20 (text "DumpLog") <+> bool (scr_dumpLog c) <$>
                fill 20 (text "Debug") <+> bool (scr_debug c)  <$>
                fill 20 (text "Maximal tiers") <+> integer (scr_maxTiers c) <$>                   
                fill 20 (text "Maximal loops") <+> integer (scr_maxLoops c) <>
                linebreak )