X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fvectorise%2FVectUtils.hs;h=3bf97fa7ffbe2f2cad7e29c38b90926c44c09cd7;hb=3f6a74eafcabc1f8d496937a33ec92e7b416f989;hp=fd399e062bfea03f60c92b8feb2664d67259ca2c;hpb=f2f5b1ef03aac4d67cbf29d8c3be0137cdad2082;p=ghc-hetmet.git

diff --git a/compiler/vectorise/VectUtils.hs b/compiler/vectorise/VectUtils.hs
index fd399e0..3bf97fa 100644
--- a/compiler/vectorise/VectUtils.hs
+++ b/compiler/vectorise/VectUtils.hs
@@ -57,8 +57,8 @@ collectAnnTypeBinders expr = go [] expr
 collectAnnValBinders :: AnnExpr Var ann -> ([Var], AnnExpr Var ann)
 collectAnnValBinders expr = go [] expr
   where
-    go bs (_, AnnLam b e) | isId b = go (b:bs) e
-    go bs e                        = (reverse bs, e)
+    go bs (_, AnnLam b e) | isIdVar b = go (b:bs) e
+    go bs e                           = (reverse bs, e)
 
 isAnnTypeArg :: AnnExpr b ann -> Bool
 isAnnTypeArg (_, AnnType _) = True
@@ -124,9 +124,10 @@ mkPArrayType :: Type -> VM Type
 mkPArrayType ty
   | Just tycon <- splitPrimTyCon ty
   = do
-      arr <- traceMaybeV "mkPArrayType" (ppr tycon)
-           $ lookupPrimPArray tycon
-      return $ mkTyConApp arr []
+      r <- lookupPrimPArray tycon
+      case r of
+        Just arr -> return $ mkTyConApp arr []
+        Nothing  -> cantVectorise "Primitive tycon not vectorised" (ppr tycon)
 mkPArrayType ty = mkBuiltinTyConApp parrayTyCon [ty]
 
 mkBuiltinCo :: (Builtins -> TyCon) -> VM Coercion
@@ -153,7 +154,9 @@ mkVScrut (ve, le)
 
 prDFunOfTyCon :: TyCon -> VM CoreExpr
 prDFunOfTyCon tycon
-  = liftM Var (traceMaybeV "prDictOfTyCon" (ppr tycon) (lookupTyConPR tycon))
+  = liftM Var
+  . maybeCantVectoriseM "No PR dictionary for tycon" (ppr tycon)
+  $ lookupTyConPR tycon
 
 paDictArgType :: TyVar -> VM (Maybe Type)
 paDictArgType tv = go (TyVarTy tv) (tyVarKind tv)
@@ -189,9 +192,11 @@ paDictOfTyApp (TyVarTy tv) ty_args
       paDFunApply dfun ty_args
 paDictOfTyApp (TyConApp tc _) ty_args
   = do
-      dfun <- traceMaybeV "paDictOfTyApp" (ppr tc) (lookupTyConPA tc)
+      dfun <- maybeCantVectoriseM "No PA dictionary for tycon" (ppr tc)
+            $ lookupTyConPA tc
       paDFunApply (Var dfun) ty_args
-paDictOfTyApp ty _ = pprPanic "paDictOfTyApp" (ppr ty)
+paDictOfTyApp ty _
+  = cantVectorise "Can't construct PA dictionary for type" (ppr ty)
 
 paDFunType :: TyCon -> VM Type
 paDFunType tc
@@ -221,10 +226,9 @@ pa_pack      = (packPAVar,      "packPA")
 paMethod :: PAMethod -> Type -> VM CoreExpr
 paMethod (_method, name) ty
   | Just tycon <- splitPrimTyCon ty
-  = do
-      fn <- traceMaybeV "paMethod" (ppr tycon <+> text name)
-          $ lookupPrimMethod tycon name
-      return (Var fn)
+  = liftM Var
+  . maybeCantVectoriseM "No PA method" (text name <+> text "for" <+> ppr tycon)
+  $ lookupPrimMethod tycon name
 
 paMethod (method, _name) ty
   = do