[commit: ghc] master: Special case 'patError' in the vectoriser (bd1aaa4)

[Manuel Chakravarty]

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/bd1aaa4299e7ac1334961f3478ca99ecbd0cd525

>---------------------------------------------------------------

commit bd1aaa4299e7ac1334961f3478ca99ecbd0cd525
Author: Manuel M T Chakravarty <chak at cse.unsw.edu.au>
Date:   Sun Jun 19 11:45:31 2011 +1000

    Special case 'patError' in the vectoriser

>---------------------------------------------------------------

 compiler/vectorise/Vectorise/Exp.hs |   14 +++++++++++++-
 1 files changed, 13 insertions(+), 1 deletions(-)

diff --git a/compiler/vectorise/Vectorise/Exp.hs b/compiler/vectorise/Vectorise/Exp.hs
index 4676e18..9827190 100644
--- a/compiler/vectorise/Vectorise/Exp.hs
+++ b/compiler/vectorise/Vectorise/Exp.hs
@@ -62,7 +62,8 @@ vectPolyExpr loop_breaker recFns expr
     (tvs, mono) = collectAnnTypeBinders expr
 
 
--- | Vectorise an expression.
+-- |Vectorise an expression.
+--
 vectExpr :: CoreExprWithFVs -> VM VExpr
 vectExpr (_, AnnType ty)
   = liftM vType (vectType ty)
@@ -76,6 +77,17 @@ vectExpr (_, AnnLit lit)
 vectExpr (_, AnnNote note expr)
   = liftM (vNote note) (vectExpr expr)
 
+-- SPECIAL CASE: Vectorise/lift 'patError @ ty err' by only vectorising/lifting the type 'ty';
+--   its only purpose is to abort the program, but we need to adjust the type to keep CoreLint
+--   happy.
+vectExpr (_, AnnApp (_, AnnApp (_, AnnVar v) (_, AnnType ty)) err)
+  | v == pAT_ERROR_ID
+  = do { (vty, lty) <- vectAndLiftType ty
+       ; return (mkCoreApps (Var v) [Type vty, err'], mkCoreApps (Var v) [Type lty, err'])
+       }
+  where
+    err' = deAnnotate err
+
 vectExpr e@(_, AnnApp _ arg)
   | isAnnTypeArg arg
   = vectTyAppExpr fn tys