Improve import and export of vectorisation information

17 files changed, 165 insertions, 211 deletions

diff --git a/compiler/deSugar/DsMonad.lhs b/compiler/deSugar/DsMonad.lhs
index 1dd347be98..06d677f886 100644
--- a/compiler/deSugar/DsMonad.lhs
+++ b/compiler/deSugar/DsMonad.lhs
@@ -154,7 +154,7 @@ data DsMetaVal
    | Splice (HsExpr Id)	-- These bindings are introduced by
 			-- the PendingSplices on a HsBracketOut
 
-initDs  :: HscEnv
+initDs :: HscEnv
 	-> Module -> GlobalRdrEnv -> TypeEnv
 	-> DsM a
 	-> IO (Messages, Maybe a)
diff --git a/compiler/hsSyn/HsDecls.lhs b/compiler/hsSyn/HsDecls.lhs
index c1b06809d7..e17d421fe5 100644
--- a/compiler/hsSyn/HsDecls.lhs
+++ b/compiler/hsSyn/HsDecls.lhs
@@ -61,6 +61,7 @@ import HsTypes
 import HsDoc
 import TyCon
 import NameSet
+import Name
 import {- Kind parts of -} Type
 import BasicTypes
 import ForeignCall
@@ -1048,11 +1049,11 @@ data VectDecl name
       (Maybe Type)              -- 'Nothing' => SCALAR declaration
   deriving (Data, Typeable)
 
-lvectDeclName :: Outputable name => LVectDecl name -> name
-lvectDeclName (L _ (HsVect        (L _ name) _)) = name
-lvectDeclName (L _ (HsNoVect      (L _ name)))   = name
-lvectDeclName (L _ (HsVectTypeIn  (L _ name) _)) = name
-lvectDeclName (L _ (HsVectTypeOut name _))       = pprPanic "HsDecls.HsVectTypeOut" (ppr name)
+lvectDeclName :: NamedThing name => LVectDecl name -> Name
+lvectDeclName (L _ (HsVect        (L _ name) _)) = getName name
+lvectDeclName (L _ (HsNoVect      (L _ name)))   = getName name
+lvectDeclName (L _ (HsVectTypeIn  (L _ name) _)) = getName name
+lvectDeclName (L _ (HsVectTypeOut tycon _))      = getName tycon
 
 instance OutputableBndr name => Outputable (VectDecl name) where
   ppr (HsVect v Nothing)
diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs
index fef97119b4..b9e72a6c1f 100644
--- a/compiler/iface/LoadIface.lhs
+++ b/compiler/iface/LoadIface.lhs
@@ -668,19 +668,18 @@ pprModIface iface
 	, vcat (map pprUsage (mi_usages iface))
 	, vcat (map pprIfaceAnnotation (mi_anns iface))
 	, pprFixities (mi_fixities iface)
-	, vcat (map pprIfaceDecl (mi_decls iface))
-	, vcat (map ppr (mi_insts iface))
-	, vcat (map ppr (mi_fam_insts iface))
-	, vcat (map ppr (mi_rules iface))
+        , vcat (map pprIfaceDecl (mi_decls 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)
-        , pprVectInfo (mi_vect_info iface)
-	, ppr (mi_warns iface)
-	, pprTrustInfo (mi_trust iface)
-	, pprTrustPkg (mi_trust_pkg iface)
- 	]
+        , ppr (mi_warns iface)
+        , pprTrustInfo (mi_trust iface)
+        , pprTrustPkg (mi_trust_pkg iface)
+        ]
   where
     pp_boot | mi_boot iface = ptext (sLit "[boot]")
-	    | otherwise     = empty
+            | otherwise     = empty
 \end{code}
 
 When printing export lists, we print like this:
diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index befee32e3e..d32b6d1cc8 100644
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -548,12 +548,13 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
    --   - export list
    --   - orphans
    --   - deprecations
-   --   - XXX vect info?
+   --   - vect info
    mod_hash <- computeFingerprint putNameLiterally
                       (map fst sorted_decls,
                        export_hash,
                        orphan_hash,
-                       mi_warns iface0)
+                       mi_warns iface0,
+                       mi_vect_info iface0)
 
    -- The interface hash depends on:
    --    - the ABI hash, plus
diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs
index 8cfe3017e2..335e3cb54a 100644
--- a/compiler/iface/TcIface.lhs
+++ b/compiler/iface/TcIface.lhs
@@ -705,57 +705,72 @@ tcIfaceVectInfo mod typeEnv (IfaceVectInfo
                              , ifaceVectInfoScalarVars   = scalarVars
                              , ifaceVectInfoScalarTyCons = scalarTyCons
                              })
-  = do { vVars     <- mapM vectVarMapping vars
-       ; tyConRes1 <- mapM vectTyConMapping      tycons
-       ; tyConRes2 <- mapM vectTyConReuseMapping tyconsReuse
+  = do { let scalarTyConsSet = mkNameSet scalarTyCons
+       ; vVars     <- mapM vectVarMapping                          vars
+       ; tyConRes1 <- mapM vectTyConMapping                        tycons
+       ; tyConRes2 <- mapM (vectTyConReuseMapping scalarTyConsSet) tyconsReuse
        ; let (vTyCons, vDataCons, vPAs, vIsos) = unzip4 (tyConRes1 ++ tyConRes2)
        ; return $ VectInfo 
-                  { vectInfoVar          = mkVarEnv     vVars
-                  , vectInfoTyCon        = mkNameEnv    vTyCons
-                  , vectInfoDataCon      = mkNameEnv    (concat vDataCons)
-                  , vectInfoPADFun       = mkNameEnv    vPAs
-                  , vectInfoIso          = mkNameEnv    vIsos
+                  { vectInfoVar          = mkVarEnv  vVars
+                  , vectInfoTyCon        = mkNameEnv vTyCons
+                  , vectInfoDataCon      = mkNameEnv (concat vDataCons)
+                  , vectInfoPADFun       = mkNameEnv (catMaybes vPAs)
+                  , vectInfoIso          = mkNameEnv (catMaybes vIsos)
                   , vectInfoScalarVars   = mkVarSet  (map lookupVar scalarVars)
-                  , vectInfoScalarTyCons = mkNameSet scalarTyCons
+                  , vectInfoScalarTyCons = scalarTyConsSet
                   }
        }
   where
     vectVarMapping name 
       = do { vName <- lookupOrig mod (mkVectOcc (nameOccName name))
-           ; let { var  = lookupVar name
-                 ; vVar = lookupVar vName
-                 }
+           ; var  <- forkM (text ("vect var")  <+> ppr name)  $
+                     tcIfaceExtId name
+           ; vVar <- forkM (text ("vect vVar") <+> ppr vName) $
+                     tcIfaceExtId vName
            ; 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))
+           -- 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
                  ; vTycon   = lookupTyCon vName
                  ; paTycon  = lookupVar paName
                  ; isoTycon = lookupVar isoName
                  }
            ; vDataCons <- mapM vectDataConMapping (tyConDataCons tycon)
-           ; return ((name, (tycon, vTycon)),    -- (T, T_v)
-                     vDataCons,                  -- list of (Ci, Ci_v)
-                     (vName, (vTycon, paTycon)), -- (T_v, paT)
-                     (name, (tycon, isoTycon)))  -- (T, isoT)
+           ; return ( (name, (tycon, vTycon))          -- (T, T_v)
+                    , vDataCons                        -- list of (Ci, Ci_v)
+                    , Just (vName, (vTycon, paTycon))  -- (T_v, paT)
+                    , Just (name, (tycon, isoTycon))   -- (T, isoT)
+                    )
            }
-    vectTyConReuseMapping name 
-      = do { paName  <- lookupOrig mod (mkPADFunOcc    (nameOccName name))
-           ; isoName <- lookupOrig mod (mkVectIsoOcc   (nameOccName name))
-           ; let { tycon      = lookupTyCon name
-                 ; paTycon    = lookupVar paName
+    vectTyConReuseMapping scalarNames name 
+      = do { paName  <- lookupOrig mod (mkPADFunOcc  (nameOccName name))
+           ; isoName <- lookupOrig mod (mkVectIsoOcc (nameOccName name))
+           ; tycon <- forkM (text ("vect reuse tycon") <+> ppr name) $
+                      tcIfaceTyCon (IfaceTc name) -- somewhat naughty for wired in tycons, but ok
+           ; if name `elemNameSet` scalarNames
+             then do
+           { return ( (name, (tycon, tycon))      -- scalar type constructors expose no data...
+                    , []                          -- ...constructors and have no PA and ISO vars...
+                    , Nothing                     -- ...see "Note [Pragmas to vectorise tycons]" in..
+                    , Nothing                     -- ...'Vectorise.Type.Env'
+                    )
+           } else do 
+           { let { paTycon    = lookupVar paName
                  ; isoTycon   = lookupVar isoName
                  ; vDataCons  = [ (dataConName dc, (dc, dc)) 
                                 | dc <- tyConDataCons tycon]
                  }
-           ; return ((name, (tycon, tycon)),     -- (T, T)
-                     vDataCons,                  -- list of (Ci, Ci)
-                     (name, (tycon, paTycon)),   -- (T, paT)
-                     (name, (tycon, isoTycon)))  -- (T, isoT)
-           }
+           ; return ( (name, (tycon, tycon))          -- (T, T)
+                    , vDataCons                       -- list of (Ci, Ci)
+                    , Just (name, (tycon, paTycon))   -- (T, paT)
+                    , Just (name, (tycon, isoTycon))  -- (T, isoT)
+                    )
+           }}
     vectDataConMapping datacon
       = do { let name = dataConName datacon
            ; vName <- lookupOrig mod (mkVectDataConOcc (nameOccName name))
@@ -766,21 +781,21 @@ tcIfaceVectInfo mod typeEnv (IfaceVectInfo
     lookupVar name = case lookupTypeEnv typeEnv name of
                        Just (AnId var) -> var
                        Just _         -> 
-                         panic "TcIface.tcIfaceVectInfo: not an id"
+                         pprPanic "TcIface.tcIfaceVectInfo: not an id" (ppr name)
                        Nothing        ->
-                         panic "TcIface.tcIfaceVectInfo: unknown name"
+                         pprPanic "TcIface.tcIfaceVectInfo: unknown name of id" (ppr name)
     lookupTyCon name = case lookupTypeEnv typeEnv name of
                          Just (ATyCon tc) -> tc
                          Just _         -> 
-                           panic "TcIface.tcIfaceVectInfo: not a tycon"
+                           pprPanic "TcIface.tcIfaceVectInfo: not a tycon" (ppr name)
                          Nothing        ->
-                           panic "TcIface.tcIfaceVectInfo: unknown name"
+                           pprPanic "TcIface.tcIfaceVectInfo: unknown name of tycon" (ppr name)
     lookupDataCon name = case lookupTypeEnv typeEnv name of
                            Just (ADataCon dc) -> dc
                            Just _         -> 
-                             panic "TcIface.tcIfaceVectInfo: not a datacon"
+                             pprPanic "TcIface.tcIfaceVectInfo: not a datacon" (ppr name)
                            Nothing        ->
-                             panic "TcIface.tcIfaceVectInfo: unknown name"
+                             pprPanic "TcIface.tcIfaceVectInfo: unknown name of datacon" (ppr name)
 \end{code}
 
 %************************************************************************
diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index 8cec31f174..1e7f32b381 100644
--- a/compiler/main/HscTypes.lhs
+++ b/compiler/main/HscTypes.lhs
@@ -1816,6 +1816,10 @@ on just the OccName easily in a Core pass.
 \begin{code}
 -- |Vectorisation information for 'ModGuts', 'ModDetails' and 'ExternalPackageState'; see also
 -- documentation at 'Vectorise.Env.GlobalEnv'.
+--
+-- NB: The following tables may also include 'Var's, 'TyCon's and 'DataCon's from imported modules,
+--     which have been subsequently vectorised in the current module.
+--
 data VectInfo      
   = VectInfo
     { vectInfoVar          :: VarEnv  (Var    , Var  )    -- ^ @(f, f_v)@ keyed on @f@
diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs
index 8369180de7..e278f6a2c8 100644
--- a/compiler/main/TidyPgm.lhs
+++ b/compiler/main/TidyPgm.lhs
@@ -331,20 +331,20 @@ tidyProgram hsc_env  (ModGuts { mg_module = mod, mg_exports = exports,
 		-- we want Global, IdInfo-rich (or not) DFunId in the
 		-- tidy_insts
 
-	      ; tidy_rules = tidyRules tidy_env ext_rules
-		-- You might worry that the tidy_env contains IdInfo-rich stuff
-		-- and indeed it does, but if omit_prags is on, ext_rules is
-		-- empty
+              ; tidy_rules = tidyRules tidy_env ext_rules
+                -- You might worry that the tidy_env contains IdInfo-rich stuff
+                -- and indeed it does, but if omit_prags is on, ext_rules is
+                -- empty
 
               ; tidy_vect_info = tidyVectInfo tidy_env vect_info
 
-	      -- See Note [Injecting implicit bindings]
-    	      ; all_tidy_binds = implicit_binds ++ tidy_binds
+              -- See Note [Injecting implicit bindings]
+              ; all_tidy_binds = implicit_binds ++ tidy_binds
 
-	      ; alg_tycons = filter isAlgTyCon (typeEnvTyCons type_env)
-	      }
+              ; alg_tycons = filter isAlgTyCon (typeEnvTyCons type_env)
+              }
 
-   	; endPass dflags CoreTidy all_tidy_binds tidy_rules
+        ; endPass dflags CoreTidy all_tidy_binds tidy_rules
 
 	  -- If the endPass didn't print the rules, but ddump-rules is on, print now
 	; dumpIfSet (dopt Opt_D_dump_rules dflags 
diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs
index 599b5334a1..6f5e667787 100644
--- a/compiler/typecheck/TcBinds.lhs
+++ b/compiler/typecheck/TcBinds.lhs
@@ -686,7 +686,7 @@ tcVect (HsNoVect name)
 tcVect (HsVectTypeIn lname@(L _ name) ty)
   = addErrCtxt (vectCtxt lname) $
     do { tycon <- tcLookupTyCon name
-       ; checkTc (tyConArity tycon /= 0) scalarTyConMustBeNullary
+       ; checkTc (tyConArity tycon == 0) scalarTyConMustBeNullary
 
        ; ty' <- fmapMaybeM dsHsType ty
        ; return $ HsVectTypeOut tycon ty'
diff --git a/compiler/vectorise/Vectorise/Builtins.hs b/compiler/vectorise/Vectorise/Builtins.hs
index 46da134fba..6f5ffcf5f3 100644
--- a/compiler/vectorise/Vectorise/Builtins.hs
+++ b/compiler/vectorise/Vectorise/Builtins.hs
@@ -25,7 +25,6 @@ module Vectorise.Builtins (
   -- * Initialisation
   initBuiltins, initBuiltinVars, initBuiltinTyCons, initBuiltinDataCons,
   initBuiltinPAs, initBuiltinPRs,
-  initBuiltinBoxedTyCons,
   
   -- * Lookup
   primMethod,
diff --git a/compiler/vectorise/Vectorise/Builtins/Initialise.hs b/compiler/vectorise/Vectorise/Builtins/Initialise.hs
index 9c21eef6f9..025bcc7da2 100644
--- a/compiler/vectorise/Vectorise/Builtins/Initialise.hs
+++ b/compiler/vectorise/Vectorise/Builtins/Initialise.hs
@@ -3,15 +3,13 @@
 module Vectorise.Builtins.Initialise (
   -- * Initialisation
   initBuiltins, initBuiltinVars, initBuiltinTyCons, initBuiltinDataCons,
-  initBuiltinPAs, initBuiltinPRs,
-  initBuiltinBoxedTyCons
+  initBuiltinPAs, initBuiltinPRs
 ) where
 
 import Vectorise.Builtins.Base
 import Vectorise.Builtins.Modules
 
 import BasicTypes
-import PrelNames
 import TysPrim
 import DsMonad
 import IfaceEnv
@@ -254,9 +252,7 @@ initBuiltinTyCons bi
 
   where 
     defaultTyCons :: DsM [TyCon]
-    defaultTyCons
-       = do word8 <- dsLookupTyCon word8TyConName
-            return [intTyCon, boolTyCon, floatTyCon, doubleTyCon, word8]
+    defaultTyCons = return [boolTyCon]
 
 -- |Get a list of names to `DataCon`s in the mock prelude.
 --
@@ -284,18 +280,8 @@ initBuiltinPRs (Builtins { dphModules = mods }) insts
 initBuiltinDicts :: (InstEnv, InstEnv) -> Class -> [(Name, Var)]
 initBuiltinDicts insts cls = map find $ classInstances insts cls
   where
-    find i | [Just tc] <- instanceRoughTcs i  = (tc, instanceDFunId i)
-           | otherwise        = pprPanic "Invalid DPH instance" (ppr i)
-
--- |Get a list of boxed `TyCons` in the mock prelude. This is Int only.
---
-initBuiltinBoxedTyCons :: Builtins -> DsM [(Name, TyCon)]
-initBuiltinBoxedTyCons 
-  = return . builtinBoxedTyCons
-  where 
-    builtinBoxedTyCons :: Builtins -> [(Name, TyCon)]
-    builtinBoxedTyCons _ 
-      = [(tyConName intPrimTyCon, intTyCon)]
+    find i | [Just tc] <- instanceRoughTcs i = (tc, instanceDFunId i)
+           | otherwise                       = pprPanic "Invalid DPH instance" (ppr i)
 
 
 -- Auxilliary look up functions ----------------
diff --git a/compiler/vectorise/Vectorise/Env.hs b/compiler/vectorise/Vectorise/Env.hs
index 3fbfb924d5..a13c02140a 100644
--- a/compiler/vectorise/Vectorise/Env.hs
+++ b/compiler/vectorise/Vectorise/Env.hs
@@ -1,4 +1,3 @@
-
 module Vectorise.Env (
   Scope(..),
 
@@ -16,7 +15,6 @@ module Vectorise.Env (
   extendDataConsEnv,
   extendPAFunsEnv,
   setPRFunsEnv,
-  setBoxedTyConsEnv,
   modVectInfo
 ) where
 
@@ -116,9 +114,6 @@ data GlobalEnv
         , global_pr_funs              :: NameEnv Var
           -- ^Mapping from TyCons to their PR dfuns.
 
-        , global_boxed_tycons         :: NameEnv TyCon
-          -- ^Mapping from unboxed TyCons to their boxed versions.
-
         , global_inst_env             :: (InstEnv, InstEnv)
           -- ^External package inst-env & home-package inst-env for class instances.
 
@@ -144,7 +139,6 @@ initGlobalEnv info vectDecls instEnvs famInstEnvs
   , global_datacons             = mapNameEnv snd $ vectInfoDataCon info
   , global_pa_funs              = mapNameEnv snd $ vectInfoPADFun info
   , global_pr_funs              = emptyNameEnv
-  , global_boxed_tycons         = emptyNameEnv
   , global_inst_env             = instEnvs
   , global_fam_inst_env         = famInstEnvs
   , global_bindings             = []
@@ -202,29 +196,29 @@ setPRFunsEnv :: [(Name, Var)] -> GlobalEnv -> GlobalEnv
 setPRFunsEnv ps genv
   = genv { global_pr_funs = mkNameEnv ps }
 
--- |Set the list of boxed type constructor in an environment.
---
-setBoxedTyConsEnv :: [(Name, TyCon)] -> GlobalEnv -> GlobalEnv
-setBoxedTyConsEnv ps genv
-  = genv { global_boxed_tycons = mkNameEnv ps }
-
 -- |Compute vectorisation information that goes into 'ModGuts' (and is stored in interface files).
 -- The incoming 'vectInfo' is that from the 'HscEnv' and 'EPS'.  The outgoing one contains only the
--- definitions for the currently compiled module.
+-- definitions for the currently compiled module; this includes variables, type constructors, and
+-- data constructors referenced in VECTORISE pragmas.
 --
-modVectInfo :: GlobalEnv -> TypeEnv -> VectInfo -> VectInfo
-modVectInfo env tyenv info
+modVectInfo :: GlobalEnv -> TypeEnv -> [CoreVect]-> VectInfo -> VectInfo
+modVectInfo env tyenv vectDecls info
   = info 
     { vectInfoVar          = global_exported_vars env
-    , vectInfoTyCon        = mk_env typeEnvTyCons   global_tycons
-    , vectInfoDataCon      = mk_env typeEnvDataCons global_datacons
-    , vectInfoPADFun       = mk_env typeEnvTyCons   global_pa_funs
+    , vectInfoTyCon        = mk_env tyCons   (global_tycons   env)
+    , vectInfoDataCon      = mk_env dataCons (global_datacons env)
+    , vectInfoPADFun       = mk_env tyCons   (global_pa_funs  env)
     , vectInfoScalarVars   = global_scalar_vars   env `minusVarSet`  vectInfoScalarVars   info
     , vectInfoScalarTyCons = global_scalar_tycons env `minusNameSet` vectInfoScalarTyCons info
     }
   where
-    mk_env from_tyenv from_env 
-      = mkNameEnv [(name, (from,to))
-                  | from     <- from_tyenv tyenv
-                  , let name =  getName from
-                  , Just to  <- [lookupNameEnv (from_env env) name]]
+    vectTypeTyCons = [tycon | VectType tycon _ <- vectDecls]
+    tyCons         = typeEnvTyCons   tyenv ++ vectTypeTyCons
+    dataCons       = typeEnvDataCons tyenv ++ concatMap tyConDataCons vectTypeTyCons
+    
+    -- Produce an entry for every declaration that is mentioned in the domain of the 'inspectedEnv'
+    mk_env decls inspectedEnv
+      = mkNameEnv [(name, (decl, to))
+                  | decl     <- decls
+                  , let name = getName decl
+                  , Just to  <- [lookupNameEnv inspectedEnv name]]
diff --git a/compiler/vectorise/Vectorise/Monad.hs b/compiler/vectorise/Vectorise/Monad.hs
index e690077192..3514698440 100644
--- a/compiler/vectorise/Vectorise/Monad.hs
+++ b/compiler/vectorise/Vectorise/Monad.hs
@@ -45,7 +45,7 @@ import FastString
 import Control.Monad
 import VarSet
 
--- | Run a vectorisation computation.
+-- |Run a vectorisation computation.
 --
 initV :: HscEnv
       -> ModGuts
@@ -69,7 +69,6 @@ initV hsc_env guts info thing_inside
            ; builtin_vars    <- initBuiltinVars builtins
            ; builtin_tycons  <- initBuiltinTyCons builtins
            ; let builtin_datacons = initBuiltinDataCons builtins
-           ; builtin_boxed   <- initBuiltinBoxedTyCons builtins
 
                -- set up class and type family envrionments
            ; eps <- liftIO $ hscEPS hsc_env
@@ -85,7 +84,6 @@ initV hsc_env guts info thing_inside
                         . extendDataConsEnv   builtin_datacons
                         . extendPAFunsEnv     builtin_pas
                         . setPRFunsEnv        builtin_prs
-                        . setBoxedTyConsEnv   builtin_boxed
                         $ initGlobalEnv info (mg_vect_decls guts) instEnvs famInstEnvs
  
                -- perform vectorisation
@@ -95,7 +93,7 @@ initV hsc_env guts info thing_inside
                No           -> return Nothing
            } }
 
-    new_info genv = modVectInfo genv (mg_types guts) info
+    new_info genv = modVectInfo genv (mg_types guts) (mg_vect_decls guts) info
 
     selectBackendErr = sLit "To use -fvectorise select a DPH backend with -fdph-par or -fdph-seq"
 
diff --git a/compiler/vectorise/Vectorise/Monad/Global.hs b/compiler/vectorise/Vectorise/Monad/Global.hs
index 96448fb26a..0624e35803 100644
--- a/compiler/vectorise/Vectorise/Monad/Global.hs
+++ b/compiler/vectorise/Vectorise/Monad/Global.hs
@@ -15,7 +15,7 @@ module Vectorise.Monad.Global (
   globalScalarVars, isGlobalScalar, globalScalarTyCons,
   
   -- * TyCons
-  lookupTyCon, lookupBoxedTyCon,
+  lookupTyCon,
   defTyCon, globalVectTyCons,
   
   -- * Datacons
@@ -119,13 +119,6 @@ lookupTyCon tc
   | otherwise 
   = readGEnv $ \env -> lookupNameEnv (global_tycons env) (tyConName tc)
 
--- |Lookup the vectorised version of a boxed `TyCon` from the global environment.
---
-lookupBoxedTyCon :: TyCon -> VM (Maybe TyCon)
-lookupBoxedTyCon tc 
-  = readGEnv $ \env -> lookupNameEnv (global_boxed_tycons env)
-                                     (tyConName tc)
-
 -- |Add a mapping between plain and vectorised `TyCon`s to the global environment.
 --
 defTyCon :: TyCon -> TyCon -> VM ()
diff --git a/compiler/vectorise/Vectorise/Type/Env.hs b/compiler/vectorise/Vectorise/Type/Env.hs
index fcc6300022..d6e50809c7 100644
--- a/compiler/vectorise/Vectorise/Type/Env.hs
+++ b/compiler/vectorise/Vectorise/Type/Env.hs
@@ -53,7 +53,7 @@ import Data.List
 -- (1) Data type constructor 'T' that may be used in vectorised code, where 'T' represents itself,
 --     but the representation of 'T' is opaque in vectorised code.  
 --
---     An example is the treatment of Int'.  'Int's can be used in vectorised code and remain
+--     An example is the treatment of 'Int'.  'Int's can be used in vectorised code and remain
 --     unchanged by vectorisation.  However, the representation of 'Int' by the 'I#' data
 --     constructor wrapping an 'Int#' is not exposed in vectorised code.  Instead, computations
 --     involving the representation need to be confined to scalar code.
@@ -64,7 +64,8 @@ import Data.List
 --     Type constructors declared with {-# VECTORISE SCALAR type T #-} are treated in this manner.
 --     (The vectoriser never treats a type constructor automatically in this manner.)
 --
--- (2) Data type constructor 'T' that together with its constructors 'Cn' may be used in vectorised
+-- (2) [NOT FULLY IMPLEMENTED YET]
+--     Data type constructor 'T' that together with its constructors 'Cn' may be used in vectorised
 --     code, where 'T' and the 'Cn' represent themselves in vectorised code.
 --
 --     An example is the treatment of 'Bool'.  'Bool' together with 'False' and 'True' may appear in
@@ -122,6 +123,10 @@ vectTypeEnv env vectTypeDecls
              
              keep_and_scalar_tcs    = keep_tcs ++ localScalarTyCons
 
+       ; traceVt " declared SCALAR: " $ ppr localScalarTyCons
+       ; traceVt " reuse          : " $ ppr keep_tcs
+       ; traceVt " convert        : " $ ppr conv_tcs
+
            -- Of those type constructors that we don't need to vectorise, we use the original
            -- representation in both unvectorised and vectorised code.  For those declared VECTORISE
            -- SCALAR, we ignore their represention — see "Note [Pragmas to vectorise tycons]".
diff --git a/compiler/vectorise/Vectorise/Type/TyConDecl.hs b/compiler/vectorise/Vectorise/Type/TyConDecl.hs
index cbfea455b6..7a9d89189f 100644
--- a/compiler/vectorise/Vectorise/Type/TyConDecl.hs
+++ b/compiler/vectorise/Vectorise/Type/TyConDecl.hs
@@ -1,6 +1,7 @@
-module Vectorise.Type.TyConDecl
-	(vectTyConDecls)
-where
+module Vectorise.Type.TyConDecl (
+  vectTyConDecls
+) where
+
 import Vectorise.Type.Type
 import Vectorise.Monad
 import BuildTyCl
@@ -16,14 +17,14 @@ import Util
 import Control.Monad
 
 
--- | Vectorise some (possibly recursively defined) type constructors.
+-- |Vectorise some (possibly recursively defined) type constructors.
+--
 vectTyConDecls :: [TyCon] -> VM [TyCon]
 vectTyConDecls tcs = fixV $ \tcs' ->
   do
     mapM_ (uncurry defTyCon) (zipLazy tcs tcs')
     mapM vectTyConDecl tcs
 
-
 -- | Vectorise a single type construcrtor.
 vectTyConDecl :: TyCon -> VM TyCon
 vectTyConDecl tycon
diff --git a/compiler/vectorise/Vectorise/Type/Type.hs b/compiler/vectorise/Vectorise/Type/Type.hs
index 0753c9b4bd..2a3dc534e4 100644
--- a/compiler/vectorise/Vectorise/Type/Type.hs
+++ b/compiler/vectorise/Vectorise/Type/Type.hs
@@ -1,9 +1,11 @@
+-- Apply the vectorisation transformation to types. This is the \mathcal{L}_t scheme in HtM.
+
+module Vectorise.Type.Type (
+  vectTyCon,
+  vectAndLiftType,
+  vectType
+) where
 
-module Vectorise.Type.Type
-	( vectTyCon
-	, vectAndLiftType
-	, vectType)
-where
 import Vectorise.Utils
 import Vectorise.Monad
 import Vectorise.Builtins
@@ -15,8 +17,8 @@ import Control.Monad
 import Data.List
 import Data.Maybe
 
-
 -- | Vectorise a type constructor.
+--
 vectTyCon :: TyCon -> VM TyCon
 vectTyCon tc
   | isFunTyCon tc        = builtin closureTyCon
@@ -24,10 +26,10 @@ vectTyCon tc
   | isUnLiftedTyCon tc   = return tc
   | otherwise            
   = maybeCantVectoriseM "Tycon not vectorised: " (ppr tc)
-	$ lookupTyCon tc
+  $ lookupTyCon tc
 
-
--- | Produce the vectorised and lifted versions of a type.
+-- |Produce the vectorised and lifted versions of a type.
+--
 vectAndLiftType :: Type -> VM (Type, Type)
 vectAndLiftType ty | Just ty' <- coreView ty = vectAndLiftType ty'
 vectAndLiftType ty
@@ -41,18 +43,17 @@ vectAndLiftType ty
   where
     (tyvars, mono_ty) = splitForAllTys ty
 
-
--- | Vectorise a type.
+-- |Vectorise a type.
+--
 vectType :: Type -> VM Type
 vectType ty
-	| Just ty'	<- coreView ty
-	= vectType ty'
-	
-vectType (TyVarTy tv) 		= return $ TyVarTy tv
-vectType (AppTy ty1 ty2) 	= liftM2 AppTy    (vectType ty1) (vectType ty2)
-vectType (TyConApp tc tys) 	= liftM2 TyConApp (vectTyCon tc) (mapM vectType tys)
-vectType (FunTy ty1 ty2)   	= liftM2 TyConApp (builtin closureTyCon)
-                                             	  (mapM vectAndBoxType [ty1,ty2])
+  | Just ty'  <- coreView ty
+  = vectType ty'
+  
+vectType (TyVarTy tv)      = return $ TyVarTy tv
+vectType (AppTy ty1 ty2)   = liftM2 AppTy    (vectType ty1) (vectType ty2)
+vectType (TyConApp tc tys) = liftM2 TyConApp (vectTyCon tc) (mapM vectType tys)
+vectType (FunTy ty1 ty2)   = liftM2 TyConApp (builtin closureTyCon) (mapM vectType [ty1,ty2])
 
 -- For each quantified var we need to add a PA dictionary out the front of the type.
 -- So          forall a. C  a => a -> a   
@@ -82,28 +83,7 @@ vectType ty@(ForAllTy _ _)
 
 vectType ty = cantVectorise "Can't vectorise type" (ppr ty)
 
-
--- | Add quantified vars and dictionary parameters to the front of a type.
+-- |Add quantified vars and dictionary parameters to the front of a type.
+--
 abstractType :: [TyVar] -> [Type] -> Type -> Type
 abstractType tyvars dicts = mkForAllTys tyvars . mkFunTys dicts
-
-
--- | Create the boxed version of a vectorised type.
-vectAndBoxType :: Type -> VM Type
-vectAndBoxType ty = vectType ty >>= boxType
-
-
--- | Create the boxed version of a type.
-boxType :: Type -> VM Type
-boxType ty
-  | Just (tycon, []) <- splitTyConApp_maybe ty
-  , isUnLiftedTyCon tycon
-  = do
-      r <- lookupBoxedTyCon tycon
-      case r of
-        Just tycon' -> return $ mkTyConApp tycon' []
-        Nothing     -> return ty
-
-  | otherwise	= return ty
-
-
diff --git a/compiler/vectorise/Vectorise/Utils.hs b/compiler/vectorise/Vectorise/Utils.hs
index c7020ea1ae..8dd0af743f 100644
--- a/compiler/vectorise/Vectorise/Utils.hs
+++ b/compiler/vectorise/Vectorise/Utils.hs
@@ -1,4 +1,3 @@
-
 module Vectorise.Utils (
   module Vectorise.Utils.Base,
   module Vectorise.Utils.Closure,
@@ -21,8 +20,8 @@ module Vectorise.Utils (
 
   -- * Naming
   newLocalVar
-) 
-where
+) where
+
 import Vectorise.Utils.Base
 import Vectorise.Utils.Closure
 import Vectorise.Utils.Hoisting
@@ -37,6 +36,7 @@ import Control.Monad
 
 
 -- Annotated Exprs ------------------------------------------------------------
+
 collectAnnTypeArgs :: AnnExpr b ann -> (AnnExpr b ann, [Type])
 collectAnnTypeArgs expr = go expr []
   where
@@ -69,58 +69,52 @@ isAnnTypeArg _              = False
 --   in dph-common/D.A.P.Lifted/PArray.hs
 --
 
--- | An empty array of the given type.
+-- |An empty array of the given type.
+--
 emptyPD :: Type -> VM CoreExpr
 emptyPD = paMethod emptyPDVar "emptyPD"
 
-
--- | Produce an array containing copies of a given element.
-replicatePD
-	:: CoreExpr	-- ^ Number of copies in the resulting array.
-	-> CoreExpr	-- ^ Value to replicate.
-	-> VM CoreExpr
-
+-- |Produce an array containing copies of a given element.
+--
+replicatePD :: CoreExpr -- ^ Number of copies in the resulting array.
+            -> CoreExpr -- ^ Value to replicate.
+            -> VM CoreExpr
 replicatePD len x 
-	= liftM (`mkApps` [len,x])
+  = liftM (`mkApps` [len,x])
         $ paMethod replicatePDVar "replicatePD" (exprType x)
 
-
 -- | Select some elements from an array that correspond to a particular tag value
 ---  and pack them into a new array.
 --   eg  packByTagPD Int# [:23, 42, 95, 50, 27, 49:]  3 [:1, 2, 1, 2, 3, 2:] 2 
 --          ==> [:42, 50, 49:]
 --
-packByTagPD 
-	:: Type		-- ^ Element type.
-	-> CoreExpr	-- ^ Source array.
-	-> CoreExpr	-- ^ Length of resulting array.
-	-> CoreExpr	-- ^ Tag values of elements in source array.
-	-> CoreExpr	-- ^ The tag value for the elements to select.
-	-> VM CoreExpr
-
+packByTagPD :: Type   -- ^ Element type.
+            -> CoreExpr -- ^ Source array.
+            -> CoreExpr -- ^ Length of resulting array.
+            -> CoreExpr -- ^ Tag values of elements in source array.
+            -> CoreExpr -- ^ The tag value for the elements to select.
+            -> VM CoreExpr
 packByTagPD ty xs len tags t
   = liftM (`mkApps` [xs, len, tags, t])
           (paMethod packByTagPDVar "packByTagPD" ty)
 
-
 -- | Combine some arrays based on a selector.
 --     The selector says which source array to choose for each element of the
 --     resulting array.
-combinePD 
-	:: Type		-- ^ Element type
-	-> CoreExpr	-- ^ Length of resulting array
-	-> CoreExpr	-- ^ Selector.
-	-> [CoreExpr]	-- ^ Arrays to combine.
-	-> VM CoreExpr
-
+--
+combinePD :: Type   -- ^ Element type
+          -> CoreExpr -- ^ Length of resulting array
+          -> CoreExpr -- ^ Selector.
+          -> [CoreExpr] -- ^ Arrays to combine.
+          -> VM CoreExpr
 combinePD ty len sel xs
   = liftM (`mkApps` (len : sel : xs))
           (paMethod (combinePDVar n) ("combine" ++ show n ++ "PD") ty)
   where
     n = length xs
 
-
--- | Like `replicatePD` but use the lifting context in the vectoriser state.
+-- |Like `replicatePD` but use the lifting context in the vectoriser state.
+--
 liftPD :: CoreExpr -> VM CoreExpr
 liftPD x
   = do
@@ -129,6 +123,7 @@ liftPD x
 
 
 -- Scalars --------------------------------------------------------------------
+
 zipScalars :: [Type] -> Type -> VM CoreExpr
 zipScalars arg_tys res_ty
   = do
@@ -139,7 +134,6 @@ zipScalars arg_tys res_ty
     where
       ty_args = arg_tys ++ [res_ty]
 
-
 scalarClosure :: [Type] -> Type -> CoreExpr -> CoreExpr -> VM CoreExpr
 scalarClosure arg_tys res_ty scalar_fun array_fun
   = do
@@ -147,19 +141,3 @@ scalarClosure arg_tys res_ty scalar_fun array_fun
       pas <- mapM paDictOfType (init arg_tys)
       return $ Var ctr `mkTyApps` (arg_tys ++ [res_ty])
                        `mkApps`   (pas ++ [scalar_fun, array_fun])
-
-
-
-{-
-boxExpr :: Type -> VExpr -> VM VExpr
-boxExpr ty (vexpr, lexpr)
-  | Just (tycon, []) <- splitTyConApp_maybe ty
-  , isUnLiftedTyCon tycon
-  = do
-      r <- lookupBoxedTyCon tycon
-      case r of
-        Just tycon' -> let [dc] = tyConDataCons tycon'
-                       in
-                       return (mkConApp dc [vexpr], lexpr)
-        Nothing     -> return (vexpr, lexpr)
--}