import VectCore
import VectMonad
-import DsUtils
+import MkCore
import CoreSyn
import CoreUtils
import Coercion
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
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
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)
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
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
return (vbody', lbody'))
where
(vs,ls) = unzip vvs
- tys = map idType vs
+ tys = map varType vs
mkVectEnv :: [Type] -> [Var] -> (Type, CoreExpr, CoreExpr -> CoreExpr -> CoreExpr)
mkVectEnv [] [] = (unitTy, Var unitDataConId, \_ body -> body)