module UHC.Light.Compiler.CodeGen.Const
( module UHC.Light.Compiler.CodeGen.BasicAnnot
, CFld, ConstRef (..)
, cfldGlobInx
, Const (..)
, isFFIConst
, ConstSt (..), emptyConstSt
, add
, addStr, addNm, addFFIFun, addFFICallEncWrapper )
where
import UHC.Light.Compiler.Base.Common
import UHC.Light.Compiler.Base.HsName.Builtin
import UHC.Light.Compiler.CodeGen.RefGenerator
import UHC.Util.Utils
import UHC.Util.Pretty as Pretty
import Data.Bits
import Data.Maybe
import qualified UHC.Util.FastSeq as Seq
import qualified Data.Map as Map
import qualified Data.Set as Set
import Control.Monad
import Control.Monad.State
import UHC.Light.Compiler.CodeGen.BasicAnnot

{-# LINE 28 "src/ehc/CodeGen/Const.chs" #-}
-- | Ref as Fld for Const, made up of 2 indices, global for all constants, and per category
data ConstRef = ConstRef
  { constrefGlobal		:: !Int
  , constrefInCateg		:: !Int
  }

instance Show ConstRef where
  show r = "CRef_" ++ show (constrefGlobal r) ++ "_" ++ show (constrefInCateg r)

type CFld = Fld' ConstRef

instance RefOfFld CFld Int where
  refOfFld = constrefGlobal . fromJust . _fldInx

instance RefOfFld CFld HsName where
  refOfFld = fromJust . _fldNm

{-# LINE 47 "src/ehc/CodeGen/Const.chs" #-}
-- | Global index of CFld
cfldGlobInx :: CFld -> Int
cfldGlobInx = refOfFld
{-# INLINE cfldGlobInx #-}

{-# LINE 54 "src/ehc/CodeGen/Const.chs" #-}
-- | Representation of constant info to be stored globally, if a further codegen phase chooses to.
--   Later reference than is via a CFld.
data Const
  = Const_FFIFunction
  	  { constFFIFunNm 		:: !String
  	  }
  | Const_FFICallEncWrapper
  	  { constFFIArgSizes  	:: ![BasicSize]
  	  }
  | Const_String
  	  { constString  		:: !String
  	  }
  | Const_Nm
  	  { constNm  			:: !HsName
  	  }
  deriving(Eq,Ord,Show)

{-# LINE 73 "src/ehc/CodeGen/Const.chs" #-}
-- | Is FFI related Const?
isFFIConst :: Const -> Bool
isFFIConst (Const_FFIFunction 			{})	= True
isFFIConst (Const_FFICallEncWrapper 	{})	= True
isFFIConst _								= False

{-# LINE 81 "src/ehc/CodeGen/Const.chs" #-}
-- | String representation of const category, to be used for counting and name gen
categ :: Const -> String
categ (Const_FFIFunction 		{})	= "funffi"
categ (Const_FFICallEncWrapper 	{})	= "encffi"
categ (Const_String 			{})	= "str"
categ (Const_Nm 				{})	= "nm"

{-# LINE 95 "src/ehc/CodeGen/Const.chs" #-}
data ConstSt = ConstSt
  { conststMp			:: !(Map.Map Const CFld)
  , conststGlobalCnt	:: !Int
  , conststInCategCntMp	:: !(Map.Map String Int)
  }

emptyConstSt = ConstSt Map.empty 0 Map.empty

{-# LINE 109 "src/ehc/CodeGen/Const.chs" #-}
-- | Add a Const, reusing if already exists, monadically
addM :: Const -> State ConstSt CFld
addM c = do
  st <- get
  case Map.lookup c (conststMp st) of
    Just r -> return r
    _      -> do put $ st
                   { conststMp 				= Map.insert c ref (conststMp st)
                   , conststGlobalCnt 		= ginx+1
                   , conststInCategCntMp 	= Map.insert cat (cinx+1) (conststInCategCntMp st)
                   }
                 return ref
      where ginx = conststGlobalCnt st
            cat  = categ c
            cinx = Map.findWithDefault 0 cat $ conststInCategCntMp st
            ref  = Fld (Just $ mkHNm $ cat ++ show cinx) (Just $ ConstRef ginx cinx)

-- | Add a Const, reusing if already exists
add :: Const -> ConstSt -> (CFld,ConstSt)
add c = runState $ addM c


{-# LINE 133 "src/ehc/CodeGen/Const.chs" #-}
addStr :: String -> ConstSt -> (CFld,ConstSt)
addStr s = add (Const_String s)

addNm :: HsName -> ConstSt -> (CFld,ConstSt)
addNm nm = add (Const_Nm nm)

addFFIFun :: String -> ConstSt -> (CFld,ConstSt)
addFFIFun nm = add (Const_FFIFunction nm)

addFFICallEncWrapper :: [BasicSize] -> ConstSt -> (CFld,ConstSt)
addFFICallEncWrapper szs = add (Const_FFICallEncWrapper szs)