Fixed reading and generating VectInfo as well as naming of vectorised versions...

Fixed reading and generating VectInfo as well as naming of vectorised versions of imported identifiers

compiler/basicTypes/Module.lhs

@@ -11,15 +11,15 @@ the keys.
 \begin{code}
 module Module 
     (
-	-- * The ModuleName type
-	ModuleName,
-	pprModuleName,
-	moduleNameFS,
-	moduleNameString,
-        moduleNameSlashes,
-	mkModuleName,
-	mkModuleNameFS,
-	stableModuleNameCmp,
+        -- * The ModuleName type
+        ModuleName,
+        pprModuleName,
+        moduleNameFS,
+        moduleNameString,
+        moduleNameSlashes, moduleNameColons,
+        mkModuleName,
+        mkModuleNameFS,
+        stableModuleNameCmp,
 
         -- * The PackageId type
         PackageId,
@@ -205,10 +205,17 @@ mkModuleName s = ModuleName (mkFastString s)
 mkModuleNameFS :: FastString -> ModuleName
 mkModuleNameFS s = ModuleName s
 
--- | Returns the string version of the module name, with dots replaced by slashes
+-- |Returns the string version of the module name, with dots replaced by slashes.
+--
 moduleNameSlashes :: ModuleName -> String
 moduleNameSlashes = dots_to_slashes . moduleNameString
   where dots_to_slashes = map (\c -> if c == '.' then pathSeparator else c)
+
+-- |Returns the string version of the module name, with dots replaced by underscores.
+--
+moduleNameColons :: ModuleName -> String
+moduleNameColons = dots_to_colons . moduleNameString
+  where dots_to_colons = map (\c -> if c == '.' then ':' else c)
 \end{code}
 
 %************************************************************************

compiler/basicTypes/Name.lhs

@@ -42,6 +42,7 @@ module Name (
 	mkFCallName, mkIPName,
         mkTickBoxOpName,
 	mkExternalName, mkWiredInName,
+  mkLocalisedOccName,
 
 	-- ** Manipulating and deconstructing 'Name's
 	nameUnique, setNameUnique,
@@ -326,6 +327,18 @@ localiseName :: Name -> Name
 localiseName n = n { n_sort = Internal }
 \end{code}
 
+\begin{code}
+-- |Create a localised variant of a name.  
+--
+-- If the name is external, encode the original's module name to disambiguate.
+--
+mkLocalisedOccName :: (Maybe String -> OccName -> OccName) -> Name -> OccName
+mkLocalisedOccName mk_occ name = mk_occ origin (nameOccName name)
+  where
+    origin | isExternalName name = Just (moduleNameColons . moduleName . nameModule $ name)
+           | otherwise           = Nothing
+\end{code}
+
 %************************************************************************
 %*									*
 \subsection{Hashing and comparison}

compiler/basicTypes/OccName.lhs

@@ -541,14 +541,12 @@ isDerivedOccName occ =
 
 \begin{code}
 mkDataConWrapperOcc, mkWorkerOcc, mkDefaultMethodOcc, mkGenDefMethodOcc,
-  	mkDerivedTyConOcc, mkClassTyConOcc, mkClassDataConOcc, mkDictOcc,
- 	mkIPOcc, mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2,
- 	mkGenD, mkGenR, mkGenRCo,
-	mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc, mkNewTyCoOcc,
-	mkInstTyCoOcc, mkEqPredCoOcc, mkClassOpAuxOcc,
-        mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc,
-	mkVectOcc, mkVectTyConOcc, mkVectDataConOcc, mkVectIsoOcc,
-	mkPDataTyConOcc, mkPDataDataConOcc, mkPReprTyConOcc, mkPADFunOcc
+  mkDerivedTyConOcc, mkClassTyConOcc, mkClassDataConOcc, mkDictOcc,
+  mkIPOcc, mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2,
+  mkGenD, mkGenR, mkGenRCo,
+  mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc, mkNewTyCoOcc,
+  mkInstTyCoOcc, mkEqPredCoOcc, mkClassOpAuxOcc,
+  mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc
    :: OccName -> OccName
 
 -- These derived variables have a prefix that no Haskell value could have
@@ -598,18 +596,24 @@ mkDataTOcc = mk_simple_deriv varName  "$t"
 mkDataCOcc = mk_simple_deriv varName  "$c"
 
 -- Vectorisation
-mkVectOcc          = mk_simple_deriv varName  "$v_"
-mkVectTyConOcc     = mk_simple_deriv tcName   ":V_"
-mkVectDataConOcc   = mk_simple_deriv dataName ":VD_"
-mkVectIsoOcc       = mk_simple_deriv varName  "$VI_"
-mkPDataTyConOcc    = mk_simple_deriv tcName   ":VP_"
-mkPDataDataConOcc  = mk_simple_deriv dataName ":VPD_"
-mkPReprTyConOcc    = mk_simple_deriv tcName   ":VR_"
-mkPADFunOcc        = mk_simple_deriv varName  "$PA_"
+mkVectOcc, mkVectTyConOcc, mkVectDataConOcc, mkVectIsoOcc, mkPADFunOcc, mkPReprTyConOcc,
+  mkPDataTyConOcc, mkPDataDataConOcc :: Maybe String -> OccName -> OccName
+mkVectOcc         = mk_simple_deriv_with varName  "$v_"
+mkVectTyConOcc    = mk_simple_deriv_with tcName   ":V_"
+mkVectDataConOcc  = mk_simple_deriv_with dataName ":VD_"
+mkVectIsoOcc      = mk_simple_deriv_with varName  "$VI_"
+mkPADFunOcc       = mk_simple_deriv_with varName  "$PA_"
+mkPReprTyConOcc   = mk_simple_deriv_with tcName   ":VR_"
+mkPDataTyConOcc   = mk_simple_deriv_with tcName   ":VP_"
+mkPDataDataConOcc = mk_simple_deriv_with dataName ":VPD_"
 
 mk_simple_deriv :: NameSpace -> String -> OccName -> OccName
 mk_simple_deriv sp px occ = mk_deriv sp px (occNameString occ)
 
+mk_simple_deriv_with :: NameSpace -> String -> Maybe String -> OccName -> OccName
+mk_simple_deriv_with sp px Nothing     occ = mk_deriv sp px                  (occNameString occ)
+mk_simple_deriv_with sp px (Just with) occ = mk_deriv sp (px ++ with ++ "_") (occNameString occ)
+
 -- Data constructor workers are made by setting the name space
 -- of the data constructor OccName (which should be a DataName)
 -- to VarName

compiler/iface/TcIface.lhs

@@ -722,7 +722,7 @@ tcIfaceVectInfo mod typeEnv (IfaceVectInfo
        }
   where
     vectVarMapping name 
-      = do { vName <- lookupOrig mod (mkVectOcc (nameOccName name))
+      = do { vName <- lookupOrig mod (mkLocalisedOccName mkVectOcc name)
            ; var  <- forkM (text ("vect var")  <+> ppr name)  $
                      tcIfaceExtId name
            ; vVar <- forkM (text ("vect vVar") <+> ppr vName) $
@@ -730,9 +730,9 @@ tcIfaceVectInfo mod typeEnv (IfaceVectInfo
            ; return (var, (var, vVar))
            }
     vectTyConMapping name 
-      = do { vName   <- lookupOrig mod (mkVectTyConOcc (nameOccName name))
-           ; paName  <- lookupOrig mod (mkPADFunOcc    (nameOccName name))
-           ; isoName <- lookupOrig mod (mkVectIsoOcc   (nameOccName name))
+      = do { vName   <- lookupOrig mod (mkLocalisedOccName mkVectTyConOcc name)
+           ; paName  <- lookupOrig mod (mkLocalisedOccName mkPADFunOcc    name)
+           ; isoName <- lookupOrig mod (mkLocalisedOccName mkVectIsoOcc   name)
            -- FIXME: we will need to use tcIfaceTyCon/tcIfaceExtId on some of these (but depends
            --   on how we exactly define the 'VECTORISE type' pragma to work)
            ; let { tycon    = lookupTyCon name
@@ -748,8 +748,8 @@ tcIfaceVectInfo mod typeEnv (IfaceVectInfo
                     )
            }
     vectTyConReuseMapping scalarNames name 
-      = do { paName  <- lookupOrig mod (mkPADFunOcc  (nameOccName name))
-           ; isoName <- lookupOrig mod (mkVectIsoOcc (nameOccName name))
+      = do { paName  <- lookupOrig mod (mkLocalisedOccName mkPADFunOcc  name)
+           ; isoName <- lookupOrig mod (mkLocalisedOccName mkVectIsoOcc name)
            ; tycon <- forkM (text ("vect reuse tycon") <+> ppr name) $
                       tcIfaceTyCon (IfaceTc name) -- somewhat naughty for wired in tycons, but ok
            ; if name `elemNameSet` scalarNames
@@ -773,7 +773,7 @@ tcIfaceVectInfo mod typeEnv (IfaceVectInfo
            }}
     vectDataConMapping datacon
       = do { let name = dataConName datacon
-           ; vName <- lookupOrig mod (mkVectDataConOcc (nameOccName name))
+           ; vName <- lookupOrig mod (mkLocalisedOccName mkVectDataConOcc name)
            ; let vDataCon = lookupDataCon vName
            ; return (name, (datacon, vDataCon))
            }

compiler/main/HscTypes.lhs

@@ -1889,6 +1889,17 @@ concatVectInfo = foldr plusVectInfo noVectInfo
 
 noIfaceVectInfo :: IfaceVectInfo
 noIfaceVectInfo = IfaceVectInfo [] [] [] [] []
+
+instance Outputable VectInfo where
+  ppr info = vcat
+             [ ptext (sLit "variables     :") <+> ppr (vectInfoVar          info)
+             , ptext (sLit "tycons        :") <+> ppr (vectInfoTyCon        info)
+             , ptext (sLit "datacons      :") <+> ppr (vectInfoDataCon      info)
+             , ptext (sLit "PA dfuns      :") <+> ppr (vectInfoPADFun       info)
+             , ptext (sLit "iso           :") <+> ppr (vectInfoIso          info)
+             , ptext (sLit "scalar vars   :") <+> ppr (vectInfoScalarVars   info)
+             , ptext (sLit "scalar tycons :") <+> ppr (vectInfoScalarTyCons info)
+             ]
 \end{code}
 
 %************************************************************************

compiler/main/TidyPgm.lhs

@@ -217,9 +217,10 @@ RecompilationAvoidance commentary:
 First we figure out which Ids are "external" Ids.  An
 "external" Id is one that is visible from outside the compilation
 unit.  These are
-	a) the user exported ones
-	b) ones mentioned in the unfoldings, workers, 
-	   or rules of externally-visible ones 
+  a) the user exported ones
+  b) ones mentioned in the unfoldings, workers, 
+     rules of externally-visible ones ,
+     or vectorised versions of externally-visible ones
 
 While figuring out which Ids are external, we pick a "tidy" OccName
 for each one.  That is, we make its OccName distinct from the other
@@ -286,35 +287,38 @@ RHSs, so that they print nicely in interfaces.
 
 \begin{code}
 tidyProgram :: HscEnv -> ModGuts -> IO (CgGuts, ModDetails)
-tidyProgram hsc_env  (ModGuts { mg_module = mod, mg_exports = exports, 
-				mg_types = type_env, 
-				mg_insts = insts, mg_fam_insts = fam_insts,
-				mg_binds = binds, 
-				mg_rules = imp_rules,
-                                mg_vect_info = vect_info,
-                                mg_anns = anns,
-                                mg_deps = deps, 
-				mg_foreign = foreign_stubs,
-			        mg_hpc_info = hpc_info,
-                                mg_modBreaks = modBreaks })
-
-  = do	{ let { dflags     = hsc_dflags hsc_env
-	      ; omit_prags = dopt Opt_OmitInterfacePragmas dflags
-	      ; expose_all = dopt Opt_ExposeAllUnfoldings  dflags
-	      ; th	   = xopt Opt_TemplateHaskell      dflags
+tidyProgram hsc_env  (ModGuts { mg_module    = mod
+                              , mg_exports   = exports
+                              , mg_types     = type_env
+                              , mg_insts     = insts
+                              , mg_fam_insts = fam_insts
+                              , mg_binds     = binds
+                              , mg_rules     = imp_rules
+                              , mg_vect_info = vect_info
+                              , mg_anns      = anns
+                              , mg_deps      = deps 
+                              , mg_foreign   = foreign_stubs
+                              , mg_hpc_info  = hpc_info
+                              , mg_modBreaks = modBreaks 
+                              })
+
+  = do  { let { dflags     = hsc_dflags hsc_env
+              ; omit_prags = dopt Opt_OmitInterfacePragmas dflags
+              ; expose_all = dopt Opt_ExposeAllUnfoldings  dflags
+              ; th         = xopt Opt_TemplateHaskell      dflags
               }
-	; showPass dflags CoreTidy
+        ; showPass dflags CoreTidy
 
-    	; let { implicit_binds = getImplicitBinds type_env }
+        ; let { implicit_binds = getImplicitBinds type_env }
 
         ; (unfold_env, tidy_occ_env)
               <- chooseExternalIds hsc_env mod omit_prags expose_all 
-                                   binds implicit_binds imp_rules
+                                   binds implicit_binds imp_rules (vectInfoVar vect_info)
 
         ; let { ext_rules = findExternalRules omit_prags binds imp_rules unfold_env }
-	        -- Glom together imp_rules and rules currently attached to binders
-		-- Then pick just the ones we need to expose
-		-- See Note [Which rules to expose]
+                -- Glom together imp_rules and rules currently attached to binders
+                -- Then pick just the ones we need to expose
+                -- See Note [Which rules to expose]
 
 	; let { (tidy_env, tidy_binds)
                  = tidyTopBinds hsc_env unfold_env tidy_occ_env binds }
@@ -498,20 +502,22 @@ tidyVectInfo (_, var_env) info@(VectInfo { vectInfoVar          = vars
          , vectInfoScalarVars   = tidy_scalarVars
          }
   where
-    tidy_vars = mkVarEnv
-              $ map tidy_var_mapping
-              $ varEnvElts vars
-
-    tidy_pas = mapNameEnv tidy_snd_var pas
+      -- we only export mappings whose co-domain is exported (otherwise, the iface is inconsistent)
+    tidy_vars = mkVarEnv [ (tidy_var, (tidy_var, tidy_var_v))
+                         | (var, var_v) <- varEnvElts vars
+                         , let tidy_var   = lookup_var var
+                               tidy_var_v = lookup_var var_v
+                         , isExportedId tidy_var_v
+                         ]
+
+    tidy_pas  = mapNameEnv tidy_snd_var pas
     tidy_isos = mapNameEnv tidy_snd_var isos
 
-    tidy_var_mapping (from, to) = (from', (from', lookup_var to))
-      where from' = lookup_var from
     tidy_snd_var (x, var) = (x, lookup_var var)
 
-    tidy_scalarVars = mkVarSet
-                    $ map lookup_var
-                    $ varSetElems scalarVars
+    tidy_scalarVars = mkVarSet [ lookup_var var 
+                               | var <- varSetElems scalarVars
+                               , isGlobalId var || isExportedId var]
       
     lookup_var var = lookupWithDefaultVarEnv var_env var var
 \end{code}
@@ -602,13 +608,14 @@ type UnfoldEnv  = IdEnv (Name{-new name-}, Bool {-show unfolding-})
 chooseExternalIds :: HscEnv
                   -> Module
                   -> Bool -> Bool
-		  -> [CoreBind]
                   -> [CoreBind]
-		  -> [CoreRule]
+                  -> [CoreBind]
+                  -> [CoreRule]
+                  -> VarEnv (Var, Var)
                   -> IO (UnfoldEnv, TidyOccEnv)
-	-- Step 1 from the notes above
+                  -- Step 1 from the notes above
 
-chooseExternalIds hsc_env mod omit_prags expose_all binds implicit_binds imp_id_rules
+chooseExternalIds hsc_env mod omit_prags expose_all binds implicit_binds imp_id_rules vect_vars
   = do { (unfold_env1,occ_env1) <- search init_work_list emptyVarEnv init_occ_env
        ; let internal_ids = filter (not . (`elemVarEnv` unfold_env1)) binders
        ; tidy_internal internal_ids unfold_env1 occ_env1 }
@@ -627,11 +634,13 @@ chooseExternalIds hsc_env mod omit_prags expose_all binds implicit_binds imp_id_
   init_ext_ids   = sortBy (compare `on` getOccName) $
                    filter is_external binders
 
-  -- An Id should be external if either (a) it is exported or
-  -- (b) it appears in the RHS of a local rule for an imported Id.   
+  -- An Id should be external if either (a) it is exported,
+  -- (b) it appears in the RHS of a local rule for an imported Id, or
+  -- (c) it is the vectorised version of an imported Id
   -- See Note [Which rules to expose]
-  is_external id = isExportedId id || id `elemVarSet` rule_rhs_vars
-  rule_rhs_vars = foldr (unionVarSet . ruleRhsFreeVars) emptyVarSet imp_id_rules
+  is_external id = isExportedId id || id `elemVarSet` rule_rhs_vars || id `elemVarSet` vect_var_vs
+  rule_rhs_vars  = foldr (unionVarSet . ruleRhsFreeVars) emptyVarSet imp_id_rules
+  vect_var_vs    = mkVarSet [var_v | (var, var_v) <- nameEnvElts vect_vars, isGlobalId var]
 
   binders          = bindersOfBinds binds
   implicit_binders = bindersOfBinds implicit_binds

compiler/vectorise/Vectorise.hs

@@ -25,7 +25,6 @@ import CoreSyn
 import CoreMonad            ( CoreM, getHscEnv )
 import Type
 import Id
-import OccName
 import DynFlags
 import BasicTypes           ( isStrongLoopBreaker )
 import Outputable
@@ -250,7 +249,7 @@ vectTopBinder var inline expr
 
           -- Make the vectorised version of binding's name, and set the unfolding used for inlining
       ; var' <- liftM (`setIdUnfoldingLazily` unfolding) 
-                $  cloneId mkVectOcc var vty
+                $  mkVectId var vty
 
           -- Add the mapping between the plain and vectorised name to the state.
       ; defGlobalVar var var'

compiler/vectorise/Vectorise/Monad.hs

@@ -35,15 +35,16 @@ import HscTypes hiding ( MonadThings(..) )
 import DynFlags
 import MonadUtils (liftIO)
 import TyCon
-import Var
+import VarSet
 import VarEnv
+import Var
 import Id
 import DsMonad
+import ErrUtils
 import Outputable
 import FastString
 
 import Control.Monad
-import VarSet
 
 -- |Run a vectorisation computation.
 --
@@ -53,10 +54,20 @@ initV :: HscEnv
       -> VM a
       -> IO (Maybe (VectInfo, a))
 initV hsc_env guts info thing_inside
-  = do { (_, Just r) <- initDs hsc_env (mg_module guts) (mg_rdr_env guts) (mg_types guts) go
-       ; return r
+  = do { (_, Just res) <- initDs hsc_env (mg_module guts) (mg_rdr_env guts) (mg_types guts) go
+
+       ; dumpIfVtTrace "Incoming VectInfo" (ppr info)
+       ; case res of
+           Nothing
+             -> dumpIfVtTrace "Vectorisation FAILED!" empty
+           Just (info', _)
+             -> dumpIfVtTrace "Outgoing VectInfo" (ppr info')
+
+       ; return res
        }
   where
+    dumpIfVtTrace = dumpIfSet_dyn (hsc_dflags hsc_env) Opt_D_dump_vt_trace
+
     go 
       = do {   -- pick a DPH backend
            ; dflags <- getDOptsDs
@@ -114,9 +125,12 @@ builtins f = VM $ \bi genv lenv -> return (Yes genv lenv (`f` bi))
 
 
 -- Var ------------------------------------------------------------------------
--- | Lookup the vectorised and\/or lifted versions of this variable.
---  If it's in the global environment we get the vectorised version.
---      If it's in the local environment we get both the vectorised and lifted version.
+
+-- |Lookup the vectorised, and if local, also the lifted versions of a variable.
+--
+-- * If it's in the global environment we get the vectorised version.
+-- * If it's in the local environment we get both the vectorised and lifted version.
+--
 lookupVar :: Var -> VM (Scope Var (Var, Var))
 lookupVar v
  = do r <- readLEnv $ \env -> lookupVarEnv (local_vars env) v
@@ -144,13 +158,16 @@ dumpVar var
 
 -- Global scalars --------------------------------------------------------------
 
+-- |Mark the given variable as scalar — i.e., executing the associated code does not involve any
+-- parallel array computations.
+--
 addGlobalScalar :: Var -> VM ()
-addGlobalScalar var 
+addGlobalScalar var
   = do { traceVt "addGlobalScalar" (ppr var)
        ; updGEnv $ \env -> env{global_scalar_vars = extendVarSet (global_scalar_vars env) var}
        }
-     
-     
+
+
 -- Primitives -----------------------------------------------------------------
 
 lookupPrimPArray :: TyCon -> VM (Maybe TyCon)

compiler/vectorise/Vectorise/Monad/Naming.hs

+-- |Computations in the vectorisation monad concerned with naming and fresh variable generation.
 
--- | Computations in the vectorisation monad concerned with naming
---   and fresh variable generation.
 module Vectorise.Monad.Naming
-	( cloneName
-	, cloneId
-	, cloneVar
-	, newExportedVar
-	, newLocalVar
-	, newLocalVars
-	, newDummyVar
-	, newTyVar)
-where
+  ( mkLocalisedName
+  , mkVectId
+  , cloneVar
+  , newExportedVar
+  , newLocalVar
+  , newLocalVars
+  , newDummyVar
+  , newTyVar
+  ) where
+
 import Vectorise.Monad.Base
 
 import DsMonad
@@ -20,38 +20,43 @@ import Name
 import SrcLoc
 import Id
 import FastString
-import Control.Monad
-
-
--- Naming ---------------------------------------------------------------------	
--- | Clone a name, using the provide function to transform its `OccName`.	
-cloneName :: (OccName -> OccName) -> Name -> VM Name
-cloneName mk_occ name = liftM make (liftDs newUnique)
-  where
-    occ_name = mk_occ (nameOccName name)
-
-    make u | isExternalName name = mkExternalName u (nameModule name)
-                                                    occ_name
-                                                    (nameSrcSpan name)
-           | otherwise           = mkSystemName u occ_name
 
+import Control.Monad
 
--- | Clone an `Id`, using the provided function to transform its `OccName`. 
-cloneId :: (OccName -> OccName) -> Id -> Type -> VM Id
-cloneId mk_occ id ty
-  = do
-      name <- cloneName mk_occ (getName id)
-      let id' | isExportedId id = Id.mkExportedLocalId name ty
-              | otherwise       = Id.mkLocalId         name ty
-      return id'
 
+-- Naming ---------------------------------------------------------------------
 
--- | Make a fresh instance of this var, with a new unique.
+-- |Create a localised variant of a name, using the provided function to transform its `OccName`.
+--
+-- If the name external, encode the orignal name's module into the new 'OccName'.  The result is
+-- always an internal system name.
+--
+mkLocalisedName :: (Maybe String -> OccName -> OccName) -> Name -> VM Name
+mkLocalisedName mk_occ name = liftM make (liftDs newUnique)
+  where
+    occ_name = mkLocalisedOccName mk_occ name
+    make u   = mkSystemName u occ_name
+
+-- |Produce the vectorised variant of an `Id` with the given type.
+--
+-- Force the new name to be a system name and, if the original was an external name, disambiguate
+-- the new name with the module name of the original.
+--
+mkVectId :: Id -> Type -> VM Id
+mkVectId id ty
+  = do { name <- mkLocalisedName mkVectOcc (getName id)
+       ; let id' | isExportedId id = Id.mkExportedLocalId name ty
+                 | otherwise       = Id.mkLocalId         name ty
+       ; return id'
+       }
+
+-- |Make a fresh instance of this var, with a new unique.
+--
 cloneVar :: Var -> VM Var
 cloneVar var = liftM (setIdUnique var) (liftDs newUnique)
 
-
--- | Make a fresh exported variable with the given type.
+-- |Make a fresh exported variable with the given type.
+--
 newExportedVar :: OccName -> Type -> VM Var
 newExportedVar occ_name ty 
  = do mod <- liftDs getModuleDs
@@ -61,30 +66,29 @@ newExportedVar occ_name ty
       
       return $ Id.mkExportedLocalId name ty
 
-
--- | Make a fresh local variable with the given type.
---   The variable's name is formed using the given string as the prefix.
+-- |Make a fresh local variable with the given type.
+-- The variable's name is formed using the given string as the prefix.
+--
 newLocalVar :: FastString -> Type -> VM Var
 newLocalVar fs ty
  = do u <- liftDs newUnique
       return $ mkSysLocal fs u ty
 
-
--- | Make several fresh local varaiables with the given types.
---   The variable's names are formed using the given string as the prefix.
+-- |Make several fresh local variables with the given types.
+-- The variable's names are formed using the given string as the prefix.
+--
 newLocalVars :: FastString -> [Type] -> VM [Var]
 newLocalVars fs = mapM (newLocalVar fs)
 
-
--- | Make a new local dummy variable.
+-- |Make a new local dummy variable.
+--
 newDummyVar :: Type -> VM Var
 newDummyVar = newLocalVar (fsLit "vv")
 
-
--- | Make a fresh type variable with the given kind.
---   The variable's name is formed using the given string as the prefix.
+-- |Make a fresh type variable with the given kind.
+-- The variable's name is formed using the given string as the prefix.
+--
 newTyVar :: FastString -> Kind -> VM Var
 newTyVar fs k
  = do u <- liftDs newUnique
       return $ mkTyVar (mkSysTvName u fs) k
-

compiler/vectorise/Vectorise/Type/Env.hs

@@ -30,7 +30,6 @@ import DataCon
 import TyCon
 import Type
 import FamInstEnv
-import OccName
 import Id
 import MkId
 import NameEnv
@@ -248,7 +247,7 @@ vectDataConWorkers orig_tc vect_tc arr_tc
                   liftM (mkLams (tyvars ++ args) . vectorised)
                 $ buildClosures tyvars [] arg_tys res_ty mk_body
 
-          raw_worker <- cloneId mkVectOcc orig_worker (exprType body)
+          raw_worker <- mkVectId orig_worker (exprType body)
           let vect_worker = raw_worker `setIdUnfolding`
                               mkInlineUnfolding (Just arity) body
           defGlobalVar orig_worker vect_worker

compiler/vectorise/Vectorise/Type/PADict.hs

 
 module Vectorise.Type.PADict
-	(buildPADict)
-where
+  ( buildPADict
+  ) where
+
 import Vectorise.Monad
 import Vectorise.Builtins
 import Vectorise.Type.Repr
-import Vectorise.Type.PRepr( buildPAScAndMethods )
+import Vectorise.Type.PRepr ( buildPAScAndMethods )
 import Vectorise.Utils
 
 import BasicTypes
@@ -21,17 +22,17 @@ import Name
 -- import FastString
 -- import Outputable
 
--- debug		= False
--- dtrace s x	= if debug then pprTrace "Vectoris.Type.PADict" s x else x
+-- debug                = False
+-- dtrace s x   = if debug then pprTrace "Vectoris.Type.PADict" s x else x
 
 -- | Build the PA dictionary function for some type and hoist it to top level.
 --   The PA dictionary holds fns that convert values to and from their vectorised representations.
 buildPADict
-	:: TyCon	-- ^ tycon of the type being vectorised.
-	-> TyCon	-- ^ tycon of the type used for the vectorised representation.
-	-> TyCon	-- ^ PRepr instance tycon
-	-> SumRepr	-- ^ representation used for the type being vectorised.
-	-> VM Var	-- ^ name of the top-level dictionary function.
+  :: TyCon  -- ^ tycon of the type being vectorised.
+  -> TyCon  -- ^ tycon of the type used for the vectorised representation.
+  -> TyCon  -- ^ PRepr instance tycon
+  -> SumRepr  -- ^ representation used for the type being vectorised.
+  -> VM Var -- ^ name of the top-level dictionary function.
 
 -- Recall the definition:
 --    class class PR (PRepr a) => PA a where
@@ -51,9 +52,9 @@ buildPADict
 
 buildPADict vect_tc prepr_tc arr_tc repr
  = polyAbstract tvs $ \args ->    -- The args are the dictionaries we lambda
-   		      	    	  -- abstract over; and they are put in the
-				  -- envt, so when we need a (PA a) we can 
-				  -- find it in the envt
+                                  -- abstract over; and they are put in the
+                                  -- envt, so when we need a (PA a) we can 
+                                  -- find it in the envt
    do -- Get ids for each of the methods in the dictionary, including superclass
       method_ids <- mapM (method args) buildPAScAndMethods
 
@@ -67,7 +68,7 @@ buildPADict vect_tc prepr_tc arr_tc repr
       -- Build the type of the dictionary function.
       pa_cls <- builtin paClass
       let dfun_ty = mkForAllTys tvs
-		  $ mkFunTys (map varType args)
+                  $ mkFunTys (map varType args)
                              (PredTy $ ClassP pa_cls [inst_ty])
 
       -- Set the unfolding for the inliner.
@@ -85,7 +86,8 @@ buildPADict vect_tc prepr_tc arr_tc repr
     arg_tys   = mkTyVarTys tvs
     inst_ty   = mkTyConApp vect_tc arg_tys
 
-    dfun_name = mkPADFunOcc (getOccName vect_tc)
+    vect_tc_name = getName vect_tc
+    dfun_name    = mkLocalisedOccName mkPADFunOcc vect_tc_name
 
     method args (name, build)
       = localV

compiler/vectorise/Vectorise/Type/PData.hs

 
 module Vectorise.Type.PData
-	(buildPDataTyCon)
-where
+  (buildPDataTyCon