{-# LANGUAGE GADTs, TemplateHaskell #-}

module UHC.Light.Compiler.EHC.BuildFunction
( module Data.Functor.Identity
, bcacheLookup, bcacheInsert, bcacheInsertDpd )
where
import UHC.Light.Compiler.EHC.Common
import UHC.Light.Compiler.EHC.CompileUnit
import Control.Applicative
import Data.Functor.Identity
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.IntMap as IMap
import Data.Maybe
import UHC.Util.Hashable
import UHC.Util.Lens
import qualified UHC.Util.RelMap as Rel
import Data.Typeable
import UHC.Light.Compiler.EHC.CompileRun.Base
import UHC.Util.Time
import qualified UHC.Light.Compiler.HS.ModImpExp as HSSemMod
import UHC.Light.Compiler.Base.PackageDatabase
import qualified UHC.Light.Compiler.Base.Pragma as Pragma







{-# LINE 63 "src/ehc/EHC/BuildFunction.chs" #-}
deriving instance Typeable Identity

{-# LINE 71 "src/ehc/EHC/BuildFunction.chs" #-}
-- | Lookup BCachedVal in 'BCache', preserving type info
bcacheLookup :: (Typeable res, Typeable f, Typeable m) => BFun' m res -> BCache m -> Maybe (f res)
bcacheLookup key (BCache {_bcacheCache=cache}) = do
    vals <- IMap.lookup (hash key) cache
    lookup key $ catMaybes $ map cvt vals
  where
    cvt (BFunCacheEntry {bfceFun=f, bfceVal=v}) = case (cast f, cast v) of
      (Just f', Just v') -> Just (f',v')
      _                  -> Nothing

-- | Add to 'BCache'
bcacheInsert :: (Typeable res, Typeable f) => BFun' m res -> f res -> BCache m -> BCache m
bcacheInsert k v bc@(BCache {_bcacheCache=c}) = bc { _bcacheCache = IMap.insertWith (++) (hash k) [BFunCacheEntry k v] c }

-- | Add dependency to 'BCache'
bcacheInsertDpd
  :: (Typeable res1, Typeable res2)
     =>
        BFun' m res1			-- ^ dependee
     -> BFun' m res2			-- ^ depends on
     -> BCache m -> BCache m
bcacheInsertDpd f1 f2 bc@(BCache {_bcacheDpdRel=dpd}) = bc { _bcacheDpdRel = Rel.insert (BFun f1) (BFun f2) dpd }