Commit 098f818b authored by chak@cse.unsw.edu.au.'s avatar chak@cse.unsw.edu.au.
Browse files

Improved VectInfo

- We need to keep pairs of (f, f_CC) in VectInfo as it is difficult
  to obtain Names from OccNames (of imported modules) in Core passes.
- There is a choice of keeping Names or Vars in VectInfo.  We go with Vars
  for now; mainly to avoid converting between Names and Vars repeatedly for
  the same VectInfo in other than one-shot mode.

  Again goes to the HEAD straight away to avoid conflicts down the road.
parent 30b123f6
......@@ -19,7 +19,7 @@ module LoadIface (
#include "HsVersions.h"
import {-# SOURCE #-} TcIface( tcIfaceDecl, tcIfaceRules, tcIfaceInst,
tcIfaceFamInst )
tcIfaceFamInst, tcIfaceVectInfo )
import DynFlags
import IfaceSyn
......@@ -239,6 +239,8 @@ loadInterface doc_str mod from
; new_eps_insts <- mapM tcIfaceInst (mi_insts iface)
; new_eps_fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface)
; new_eps_rules <- tcIfaceRules ignore_prags (mi_rules iface)
; new_eps_vect_info <- tcIfaceVectInfo mod (mkNameEnv new_eps_decls)
(mi_vect_info iface)
; let { final_iface = iface {
mi_decls = panic "No mi_decls in PIT",
......@@ -246,11 +248,6 @@ loadInterface doc_str mod from
mi_fam_insts = panic "No mi_fam_insts in PIT",
mi_rules = panic "No mi_rules in PIT"
}
; new_eps_vect_info =
VectInfo {
vectInfoCCVar = mkNameSet
(ifaceVectInfoCCVar . mi_vect_info $ iface)
}
}
; updateEps_ $ \ eps ->
......@@ -587,6 +584,7 @@ pprModIface iface
, vcat (map ppr (mi_insts iface))
, vcat (map ppr (mi_fam_insts iface))
, vcat (map ppr (mi_rules iface))
, pprVectInfo (mi_vect_info iface)
, pprDeprecs (mi_deprecs iface)
]
where
......@@ -659,6 +657,10 @@ pprFixities fixes = ptext SLIT("fixities") <+> pprWithCommas pprFix fixes
where
pprFix (occ,fix) = ppr fix <+> ppr occ
pprVectInfo :: IfaceVectInfo -> SDoc
pprVectInfo (IfaceVectInfo names) =
ptext SLIT("Closured converted:") <+> hsep (map ppr names)
pprDeprecs NoDeprecs = empty
pprDeprecs (DeprecAll txt) = ptext SLIT("Deprecate all") <+> doubleQuotes (ftext txt)
pprDeprecs (DeprecSome prs) = ptext SLIT("Deprecate") <+> vcat (map pprDeprec prs)
......
......@@ -195,6 +195,8 @@ import TcRnMonad
import HscTypes
import DynFlags
import VarEnv
import Var
import Name
import NameEnv
import NameSet
......@@ -337,7 +339,8 @@ mkIface hsc_env maybe_old_iface
deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
ifFamInstTcName = ifaceTyConName . ifFamInstTyCon
flattenVectInfo (VectInfo ccVar) = IfaceVectInfo (nameSetToList ccVar)
flattenVectInfo (VectInfo ccVar) =
IfaceVectInfo [Var.varName v | (v, _) <- varEnvElts ccVar]
-----------------------------
writeIfaceFile :: DynFlags -> ModLocation -> ModIface -> IO ()
......
......@@ -3,6 +3,7 @@ module TcIface where
tcIfaceDecl :: GHC.Base.Bool -> IfaceSyn.IfaceDecl -> TcRnTypes.IfL TypeRep.TyThing
tcIfaceInst :: IfaceSyn.IfaceInst -> TcRnTypes.IfL InstEnv.Instance
tcIfaceRules :: GHC.Base.Bool -> [IfaceSyn.IfaceRule] -> TcRnTypes.IfL [CoreSyn.CoreRule]
tcIfaceVectInfo :: Module.Module -> HscTypes.TypeEnv -> HscTypes.IfaceVectInfo -> TcRnTypes.IfL VectInfo
tcIfaceFamInst :: IfaceSyn.IfaceFamInst -> TcRnTypes.IfL FamInstEnv.FamInst
......@@ -8,8 +8,8 @@ Type checking of type signatures in interface files
\begin{code}
module TcIface (
tcImportDecl, checkWiredInTyCon, tcHiBootIface, typecheckIface,
tcIfaceDecl, tcIfaceInst, tcIfaceFamInst, tcIfaceRules, tcIfaceGlobal,
tcExtCoreBindings
tcIfaceDecl, tcIfaceInst, tcIfaceFamInst, tcIfaceRules,
tcIfaceVectInfo, tcIfaceGlobal, tcExtCoreBindings
) where
#include "HsVersions.h"
......@@ -38,9 +38,9 @@ import DataCon
import TysWiredIn
import Var ( TyVar )
import qualified Var
import VarEnv
import Name
import NameEnv
import NameSet
import OccName
import Module
import UniqFM
......@@ -200,8 +200,8 @@ typecheckIface iface
; rules <- tcIfaceRules ignore_prags (mi_rules iface)
-- Vectorisation information
; let vect_info = VectInfo
(mkNameSet (ifaceVectInfoCCVar (mi_vect_info iface)))
; vect_info <- tcIfaceVectInfo (mi_module iface) type_env
(mi_vect_info iface)
-- Exports
; exports <- ifaceExportNames (mi_exports iface)
......@@ -576,6 +576,34 @@ tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bnd
\end{code}
%************************************************************************
%* *
Vectorisation information
%* *
%************************************************************************
\begin{code}
tcIfaceVectInfo :: Module -> TypeEnv -> IfaceVectInfo -> IfL VectInfo
tcIfaceVectInfo mod typeEnv (IfaceVectInfo names)
= do { ccVars <- mapM ccMapping names
; return $ VectInfo (mkVarEnv ccVars)
}
where
ccMapping name
= do { ccName <- lookupOrig mod (mkCloOcc (nameOccName name))
; let { var = lookup name
; ccVar = lookup ccName
}
; return (var, (var, ccVar))
}
lookup name = case lookupTypeEnv typeEnv name of
Just (AnId var) -> var
Just _ ->
panic "TcIface.tcIfaceVectInfo: wrong TyThing"
Nothing ->
panic "TcIface.tcIfaceVectInfo: unknown name"
\end{code}
%************************************************************************
%* *
Types
......
......@@ -6,9 +6,12 @@ import TcRnTypes ( IfL )
import InstEnv ( Instance )
import FamInstEnv ( FamInst )
import CoreSyn ( CoreRule )
import HscTypes ( TypeEnv, VectInfo, IfaceVectInfo )
import Module ( Module )
tcIfaceDecl :: Bool -> IfaceDecl -> IfL TyThing
tcIfaceRules :: Bool -> [IfaceRule] -> IfL [CoreRule]
tcIfaceVectInfo:: Module -> TypeEnv -> IfaceVectInfo -> IfL VectInfo
tcIfaceInst :: IfaceInst -> IfL Instance
tcIfaceFamInst :: IfaceFamInst -> IfL FamInst
\end{code}
......
......@@ -90,7 +90,9 @@ import InstEnv ( InstEnv, Instance )
import FamInstEnv ( FamInstEnv, FamInst )
import Rules ( RuleBase )
import CoreSyn ( CoreBind )
import VarEnv
import VarSet
import Var
import Id
import Type ( TyThing(..) )
......@@ -1244,23 +1246,34 @@ The following information is generated and consumed by the vectorisation
subsystem. It communicates the vectorisation status of declarations from one
module to another.
Why do we need both f and f_CC in the ModGuts/ModDetails/EPS version VectInfo
below? We need to know `f' when converting to IfaceVectInfo. However, during
closure conversion, we need to know `f_CC', whose `Var' we cannot lookup based
on just the OccName easily in a Core pass.
\begin{code}
-- ModGuts version
data VectInfo = VectInfo {
vectInfoCCVar :: NameSet
}
-- ModGuts/ModDetails/EPS version
data VectInfo
= VectInfo {
vectInfoCCVar :: VarEnv (Var, Var) -- (f, f_CC) keyed on f
-- always tidy, even in ModGuts
}
-- ModIface version
data IfaceVectInfo = IfaceVectInfo {
ifaceVectInfoCCVar :: [Name]
}
data IfaceVectInfo
= IfaceVectInfo {
ifaceVectInfoCCVar :: [Name] -- all variables in here have
-- a closure-converted variant
-- the name of the CC'ed variant
-- is determined by `mkCloOcc'
}
noVectInfo :: VectInfo
noVectInfo = VectInfo emptyNameSet
noVectInfo = VectInfo emptyVarEnv
plusVectInfo :: VectInfo -> VectInfo -> VectInfo
plusVectInfo vi1 vi2 =
VectInfo (vectInfoCCVar vi1 `unionNameSets` vectInfoCCVar vi2)
VectInfo (vectInfoCCVar vi1 `plusVarEnv` vectInfoCCVar vi2)
noIfaceVectInfo :: IfaceVectInfo
noIfaceVectInfo = IfaceVectInfo []
......
......@@ -32,7 +32,7 @@ import Name ( Name, getOccName, nameOccName, mkInternalName,
localiseName, isExternalName, nameSrcLoc,
isWiredInName, getName
)
import NameSet ( NameSet, elemNameSet, filterNameSet )
import NameSet ( NameSet, elemNameSet )
import IfaceEnv ( allocateGlobalBinder )
import NameEnv ( filterNameEnv, mapNameEnv )
import OccName ( TidyOccEnv, initTidyOccEnv, tidyOccName )
......@@ -287,12 +287,6 @@ tidyProgram hsc_env
; implicit_binds = getImplicitBinds type_env
; all_tidy_binds = implicit_binds ++ tidy_binds
; alg_tycons = filter isAlgTyCon (typeEnvTyCons type_env)
; tidy_vect_info = VectInfo
(filterNameSet (isElemId type_env)
(vectInfoCCVar vect_info))
-- filter against `type_env', not `tidy_type_env', as we must
-- keep all implicit names
}
; endPass dflags "Tidy Core" Opt_D_dump_simpl all_tidy_binds
......@@ -314,7 +308,7 @@ tidyProgram hsc_env
md_fam_insts = fam_insts,
md_exports = exports,
md_modBreaks = modBreaks,
md_vect_info = tidy_vect_info
md_vect_info = vect_info -- is already tidy
})
}
......@@ -323,11 +317,6 @@ lookup_dfun type_env dfun_id
Just (AnId dfun_id') -> dfun_id'
other -> pprPanic "lookup_dfun" (ppr dfun_id)
isElemId type_env name
= case lookupTypeEnv type_env name of
Just (AnId _) -> True
_ -> False
tidyTypeEnv :: Bool -> NameSet -> TypeEnv -> [CoreBind] -> TypeEnv
-- The competed type environment is gotten from
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment