Fix newtype wrapper for 'PData[s] (Wrap a)' and fix VECTORISE type and instance pragmas

* Correct usage of new type wrappers from MkId
* 'VECTORISE [SCALAR] type T = S' didn't work correctly across module boundaries
* Clean up 'VECTORISE SCALAR instance'

1 files changed, 9 insertions, 4 deletions

diff --git a/compiler/deSugar/Desugar.lhs b/compiler/deSugar/Desugar.lhs
index e88b57e835..d0713bcf99 100644
--- a/compiler/deSugar/Desugar.lhs
+++ b/compiler/deSugar/Desugar.lhs
@@ -23,6 +23,7 @@ import TcRnTypes
 import MkIface
 import Id
 import Name
+import Type
 import InstEnv
 import Class
 import Avail
@@ -415,15 +416,19 @@ dsVect (L loc (HsVect (L _ v) rhs))
 dsVect (L _loc (HsNoVect (L _ v)))
   = return $ NoVect v
 dsVect (L _loc (HsVectTypeOut isScalar tycon rhs_tycon))
-  = return $ VectType isScalar tycon rhs_tycon
+  = return $ VectType isScalar tycon' rhs_tycon
+  where
+    tycon' | Just ty <- coreView $ mkTyConTy tycon
+           , (tycon', []) <- splitTyConApp ty      = tycon'
+           | otherwise                             = tycon
 dsVect vd@(L _ (HsVectTypeIn _ _ _))
   = pprPanic "Desugar.dsVect: unexpected 'HsVectTypeIn'" (ppr vd)
 dsVect (L _loc (HsVectClassOut cls))
   = return $ VectClass (classTyCon cls)
 dsVect vc@(L _ (HsVectClassIn _))
   = pprPanic "Desugar.dsVect: unexpected 'HsVectClassIn'" (ppr vc)
-dsVect (L _loc (HsVectInstOut isScalar inst))
-  = return $ VectInst isScalar (instanceDFunId inst)
-dsVect vi@(L _ (HsVectInstIn _ _))
+dsVect (L _loc (HsVectInstOut inst))
+  = return $ VectInst (instanceDFunId inst)
+dsVect vi@(L _ (HsVectInstIn _))
   = pprPanic "Desugar.dsVect: unexpected 'HsVectInstIn'" (ppr vi)
 \end{code}