content: 
  
  -----------------------------------------------------------------------------
  --
  -- Stg to C-- code generation: the binding environment
  --
  -- (c) The University of Glasgow 2004-2006
  --
  -----------------------------------------------------------------------------
  module GHC.StgToCmm.Env (
          CgIdInfo,
  
          mkCgIdInfo, litIdInfo, lneIdInfo, rhsIdInfo, mkRhsInit,
          idInfoToAmode,
  
          addBindC, addBindsC,
  
          bindArgsToRegs, bindToReg, rebindToReg,
          bindArgToReg, idToReg,
          getCgIdInfo, getCgInfo_maybe,
          maybeLetNoEscape,
          ) where
  
  import GHC.Prelude
  
  import GHC.Platform
  import GHC.StgToCmm.Monad
  import GHC.StgToCmm.Closure
  
  import GHC.Cmm.CLabel
  
  import GHC.Cmm.BlockId
  import GHC.Cmm.Expr
  import GHC.Cmm.Utils
  import GHC.Types.Id
  import GHC.Cmm.Graph
  import GHC.Types.Name
  import GHC.Core.Type
  import GHC.Core.TyCo.Compare( eqType )
  import GHC.Builtin.Types.Prim
  import GHC.Types.Unique.FM
  import GHC.Types.Var.Env
  
  import GHC.Utils.Outputable
  import GHC.Utils.Panic
  
  import GHC.Builtin.Names (getUnique)
  
  
  -------------------------------------
  --        Manipulating CgIdInfo
  -------------------------------------
  
  mkCgIdInfo :: Id -> LambdaFormInfo -> CmmExpr -> CgIdInfo
  mkCgIdInfo id lf expr
    = CgIdInfo { cg_id = id, cg_lf = lf
               , cg_loc = CmmLoc expr }
  
  litIdInfo :: Platform -> Id -> LambdaFormInfo -> CmmLit -> CgIdInfo
  litIdInfo platform id lf lit
    = CgIdInfo { cg_id = id, cg_lf = lf
               , cg_loc = CmmLoc (addDynTag platform (CmmLit lit) tag) }
    where
      tag = lfDynTag platform lf
  
  lneIdInfo :: Platform -> Id -> [NonVoid Id] -> CgIdInfo
  lneIdInfo platform id regs
    = CgIdInfo { cg_id = id, cg_lf = lf
               , cg_loc = LneLoc blk_id (map (idToReg platform) regs) }
    where
      lf     = mkLFLetNoEscape
      blk_id = mkBlockId (idUnique id)
  
  
  rhsIdInfo :: Id -> LambdaFormInfo -> FCode (CgIdInfo, LocalReg)
  rhsIdInfo id lf_info
    = do platform <- getPlatform
         reg <- newTemp (gcWord platform)
         return (mkCgIdInfo id lf_info (CmmReg (CmmLocal reg)), reg)
  
  mkRhsInit :: Platform -> LocalReg -> LambdaFormInfo -> CmmExpr -> CmmAGraph
  mkRhsInit platform reg lf_info expr
    = mkAssign (CmmLocal reg) (addDynTag platform expr (lfDynTag platform lf_info))
  
  -- | Returns a 'CmmExpr' for the *tagged* pointer
  idInfoToAmode :: CgIdInfo -> CmmExpr
  idInfoToAmode CgIdInfo { cg_loc = CmmLoc e } = e
  idInfoToAmode cg_info
    = pprPanic "idInfoToAmode" (ppr (cg_id cg_info))        -- LneLoc
  
  -- | A tag adds a byte offset to the pointer
  addDynTag :: Platform -> CmmExpr -> DynTag -> CmmExpr
  addDynTag = cmmOffsetB
  
  maybeLetNoEscape :: CgIdInfo -> Maybe (BlockId, [LocalReg])
  maybeLetNoEscape CgIdInfo { cg_loc = LneLoc blk_id args} = Just (blk_id, args)
  maybeLetNoEscape _other                                      = Nothing
  
  
  
  ---------------------------------------------------------
  --        The binding environment
  --
  -- There are three basic routines, for adding (addBindC),
  -- modifying(modifyBindC) and looking up (getCgIdInfo) bindings.
  ---------------------------------------------------------
  
  addBindC :: CgIdInfo -> FCode ()
  addBindC stuff_to_bind = do
          binds <- getBinds
          setBinds $ extendVarEnv binds (cg_id stuff_to_bind) stuff_to_bind
  
  addBindsC :: [CgIdInfo] -> FCode ()
  addBindsC new_bindings = do
          binds <- getBinds
          let new_binds = foldl' (\ binds info -> extendVarEnv binds (cg_id info) info)
                                 binds
                                 new_bindings
          setBinds new_binds
  
  -- Inside GHC the average module creates 385 external references
  -- with notable cgIdInfo (so not generated by mkLFArgument).
  -- On average 200 of these are covered by True/False/[]
  -- and nullary constructors make up ~80.
  -- One would think it would be worthwhile to cache these.
  -- Sadly it's not. See #16937
  
  getCgIdInfo :: Id -> FCode CgIdInfo
  getCgIdInfo id
    = do  { platform <- getPlatform
          ; local_binds <- getBinds -- Try local bindings first
          ; case lookupVarEnv local_binds id of {
              Just info -> -- pprTrace "getCgIdInfoLocal" (ppr id) $
                return info ;
              Nothing   -> do {
  
                  -- Should be imported; make up a CgIdInfo for it
            let name = idName id
          ; if isExternalName name then
                let ext_lbl
                        | isBoxedType (idType id)
                        = mkClosureLabel name $ idCafInfo id
                        | isUnliftedType (idType id)
                            -- An unlifted external Id must refer to a top-level
                            -- string literal. See Note [Bytes label] in "GHC.Cmm.CLabel".
                        = assert (idType id `eqType` addrPrimTy) $
                          mkBytesLabel name
                        | otherwise
                        = pprPanic "GHC.StgToCmm.Env: label not found" (ppr id <+> dcolon <+> ppr (idType id))
                in return $
                    litIdInfo platform id (importedIdLFInfo id) (CmmLabel ext_lbl)
            else
                cgLookupPanic id -- Bug, id is neither in local binds nor is external
          }}}
  
  -- | Retrieve cg info for a name if it already exists.
  getCgInfo_maybe :: Name -> FCode (Maybe CgIdInfo)
  getCgInfo_maybe name
    = do  { local_binds <- getBinds -- Try local bindings first
          ; return $ lookupVarEnv_Directly local_binds (getUnique name) }
  
  cgLookupPanic :: Id -> FCode a
  cgLookupPanic id
    = do  local_binds <- getBinds
          pprPanic "GHC.StgToCmm.Env: variable not found"
                  (vcat [ppr id,
                  text "local binds for:",
                  pprUFM local_binds $ \infos ->
                    vcat [ ppr (cg_id info) | info <- infos ]
                ])
  
  
  ------------------------------------------------------------------------
  --        Interface functions for binding and re-binding names
  ------------------------------------------------------------------------
  
  bindToReg :: NonVoid Id -> LambdaFormInfo -> FCode LocalReg
  -- Bind an Id to a fresh LocalReg
  bindToReg nvid@(NonVoid id) lf_info
    = do platform <- getPlatform
         let reg = idToReg platform nvid
         addBindC (mkCgIdInfo id lf_info (CmmReg (CmmLocal reg)))
         return reg
  
  rebindToReg :: NonVoid Id -> FCode LocalReg
  -- Like bindToReg, but the Id is already in scope, so
  -- get its LF info from the envt
  rebindToReg nvid@(NonVoid id)
    = do  { info <- getCgIdInfo id
          ; bindToReg nvid (cg_lf info) }
  
  bindArgToReg :: NonVoid Id -> FCode LocalReg
  bindArgToReg nvid@(NonVoid id) = bindToReg nvid (mkLFArgument id)
  
  bindArgsToRegs :: [NonVoid Id] -> FCode [LocalReg]
  bindArgsToRegs = mapM bindArgToReg
  
  idToReg :: Platform -> NonVoid Id -> LocalReg
  -- Make a register from an Id, typically a function argument,
  -- free variable, or case binder
  --
  -- We re-use the Unique from the Id to make it easier to see what is going on
  --
  -- By now the Ids should be uniquely named; else one would worry
  -- about accidental collision
  idToReg platform (NonVoid id)
               = LocalReg (idUnique id)
                          (primRepCmmType platform (idPrimRepU id))
  