module UHC.Light.Compiler.Core.Merge
( cModMerge )
where
import UHC.Light.Compiler.Opts
import UHC.Light.Compiler.Base.Common
import UHC.Light.Compiler.Ty
import UHC.Light.Compiler.Core hiding (cModMerge)
import UHC.Light.Compiler.AbstractCore
import UHC.Light.Compiler.Module.Merge
import Data.List
import Data.Maybe
import qualified Data.Set as Set
import qualified Data.Map as Map
import UHC.Util.Utils
import Control.Monad.Identity
import Control.Monad.State
import Data.Array
import qualified UHC.Util.FastSeq as Seq
import UHC.Light.Compiler.Core.FvS
import UHC.Light.Compiler.Core.ModAsMap
import UHC.Light.Compiler.Core.ExtractFFE


{-# LINE 45 "src/ehc/Core/Merge.chs" #-}
instance ModPuller
           CModule
           (CModuleDatabase, Map.Map HsName CModuleDatabase)
           (HsName,CExportL,CImportL,CDeclMetaL)
           CModule CExpr CBindCateg CBind
  where
    mpullSplit mmain@(CModule_Mod modNm _ _ _ _) mimpL =
        ( cmoddbMainExpr modDbMain
        ,
          Just (CBindCateg_FFE, [ (effeBind e, effeFvS e) | m <- mmain : mimpL, e <- cmodExtractFFE m ])
        , ( modDbMain
          , Map.unions [ Map.singleton (cmoddbModNm db) db | db <- modDbMain : modDbImp ]
          )
        , ( modNm
          -- TBD: combine this in some way with the FFE implicit exports...
          , Set.toList $ Set.fromList $ concatMap cmoddbExports $ modDbMain : modDbImp
          , Set.toList $ Set.fromList $ concatMap cmoddbImports $ modDbMain : modDbImp
          , concatMap cmoddbMeta $ modDbMain : modDbImp
        ) )
      where modDbMain =     cexprModAsDatabase mmain
            modDbImp  = map cexprModAsDatabase mimpL
            modDbMp   = Map.unions [ Map.singleton (cmoddbModNm db) db | db <- modDbMain : modDbImp ]

    mpullUsedBindings n (modDbMain,modDbMp) = return $ do
        db <- maybe (Just modDbMain) (\m -> Map.lookup m modDbMp) $ hsnQualifier n
        (bi,_) <- cmoddbLookup n db
        let (cat,bsarr) = cmoddbBindArr db ! bi
            bs = elems bsarr
        return
          ( cat, bs
          , Set.fromList $ map cbindNm bs
          )

    mpullRelevantExprs = cbindExprs

    mpullFreeVars = cexprFvS

    mpullBindingsAddToMod (modNm,allExports,allImports,allMeta) rootExpr bs _ = CModule_Mod modNm allExports allImports allMeta (acoreLetN bs $ rootExpr)

{-# LINE 90 "src/ehc/Core/Merge.chs" #-}
-- | merge by pulling
cModMerge :: (CModule,[CModule]) -> CModule
cModMerge mods@(mmain,mimpL)
  = mkM mmain
  where (mkM,_) = modMergeByPullingIn mods