Added a VECTORISE pragma

- Added a pragma {-# VECTORISE var = exp #-} that prevents
  the vectoriser from vectorising the definition of 'var'.
  Instead it uses the binding '$v_var = exp' to vectorise
  'var'.  The vectoriser checks that the Core type of 'exp'
  matches the vectorised Core type of 'var'.  (It would be
  quite complicated to perform that check in the type checker
  as the vectorisation of a type needs the state of the VM
  monad.)
- Added parts of a related VECTORISE SCALAR pragma
- Documented -ddump-vect
- Added -ddump-vt-trace
- Some clean up

1 files changed, 26 insertions, 9 deletions

diff --git a/compiler/deSugar/DsMonad.lhs b/compiler/deSugar/DsMonad.lhs
index 1238b1a2b5..62e805334e 100644
--- a/compiler/deSugar/DsMonad.lhs
+++ b/compiler/deSugar/DsMonad.lhs
@@ -12,15 +12,16 @@ module DsMonad (
 	foldlM, foldrM, ifDOptM, unsetOptM,
 	Applicative(..),(<$>),
 
-	newLocalName,
-	duplicateLocalDs, newSysLocalDs, newSysLocalsDs, newUniqueId,
-	newFailLocalDs, newPredVarDs,
-	getSrcSpanDs, putSrcSpanDs,
-	getModuleDs,
-	newUnique, 
-	UniqSupply, newUniqueSupply,
-	getDOptsDs, getGhcModeDs, doptDs,
-	dsLookupGlobal, dsLookupGlobalId, dsLookupTyCon, dsLookupDataCon,
+        newLocalName,
+        duplicateLocalDs, newSysLocalDs, newSysLocalsDs, newUniqueId,
+        newFailLocalDs, newPredVarDs,
+        getSrcSpanDs, putSrcSpanDs,
+        getModuleDs,
+        mkPrintUnqualifiedDs,
+        newUnique, 
+        UniqSupply, newUniqueSupply,
+        getDOptsDs, getGhcModeDs, doptDs,
+        dsLookupGlobal, dsLookupGlobalId, dsLookupDPHId, dsLookupTyCon, dsLookupDataCon,
         dsLookupClass,
 
 	DsMetaEnv, DsMetaVal(..), dsLookupMetaEnv, dsExtendMetaEnv,
@@ -282,6 +283,9 @@ failWithDs err
 	; let msg = mkErrMsg loc (ds_unqual env) err
 	; updMutVar (ds_msgs env) (\ (w,e) -> (w, e `snocBag` msg))
 	; failM }
+
+mkPrintUnqualifiedDs :: DsM PrintUnqualified
+mkPrintUnqualifiedDs = ds_unqual <$> getGblEnv
 \end{code}
 
 \begin{code}
@@ -299,6 +303,19 @@ dsLookupGlobalId :: Name -> DsM Id
 dsLookupGlobalId name 
   = tyThingId <$> dsLookupGlobal name
 
+-- Looking up a global DPH 'Id' is like 'dsLookupGlobalId', but the package, in which the looked
+-- up name is located, varies with the active DPH backend.
+--
+dsLookupDPHId :: (PackageId -> Name) -> DsM Id
+dsLookupDPHId nameInPkg
+  = do { dflags <- getDOpts
+       ; case dphPackageMaybe dflags of
+           Just pkg -> tyThingId <$> dsLookupGlobal (nameInPkg pkg)
+           Nothing  -> failWithDs $ ptext err
+       }
+  where
+    err = sLit "To use -XParallelArrays select a DPH backend with -fdph-par or -fdph-seq"
+
 dsLookupTyCon :: Name -> DsM TyCon
 dsLookupTyCon name
   = tyThingTyCon <$> dsLookupGlobal name