Merge remote-tracking branch 'origin/master' into type-nats

9 files changed, 93 insertions, 96 deletions

diff --git a/compiler/vectorise/Vectorise/Generic/PADict.hs b/compiler/vectorise/Vectorise/Generic/PADict.hs
index 0af5fe0776..d73bea17ee 100644
--- a/compiler/vectorise/Vectorise/Generic/PADict.hs
+++ b/compiler/vectorise/Vectorise/Generic/PADict.hs
@@ -44,13 +44,14 @@ import Name
 --
 buildPADict
         :: TyCon        -- ^ tycon of the type being vectorised.
-        -> TyCon        -- ^ tycon of the type used for the vectorised representation.
+        -> CoAxiom      -- ^ Coercion between the type and 
+                        --     its vectorised representation.
         -> TyCon        -- ^ PData  instance tycon
         -> TyCon        -- ^ PDatas instance tycon
         -> SumRepr      -- ^ representation used for the type being vectorised.
         -> VM Var       -- ^ name of the top-level dictionary function.
 
-buildPADict vect_tc prepr_tc pdata_tc pdatas_tc repr
+buildPADict vect_tc prepr_ax pdata_tc pdatas_tc repr
  = polyAbstract tvs $ \args ->    -- The args are the dictionaries we lambda
                                   -- abstract over; and they are put in the
                                   -- envt, so when we need a (PA a) we can 
@@ -94,7 +95,7 @@ buildPADict vect_tc prepr_tc pdata_tc pdatas_tc repr
 
     method args dfun_name (name, build)
      = localV
-     $ do  expr     <- build vect_tc prepr_tc pdata_tc pdatas_tc repr
+     $ do  expr     <- build vect_tc prepr_ax pdata_tc pdatas_tc repr
            let body = mkLams (tvs ++ args) expr
            raw_var  <- newExportedVar (method_name dfun_name name) (exprType body)
            let var  = raw_var
diff --git a/compiler/vectorise/Vectorise/Generic/PAMethods.hs b/compiler/vectorise/Vectorise/Generic/PAMethods.hs
index 85e33367d7..ce2d947519 100644
--- a/compiler/vectorise/Vectorise/Generic/PAMethods.hs
+++ b/compiler/vectorise/Vectorise/Generic/PAMethods.hs
@@ -15,10 +15,10 @@ import Vectorise.Builtins
 import Vectorise.Generic.Description
 import CoreSyn
 import CoreUtils
+import FamInstEnv
 import MkCore            ( mkWildCase )
 import TyCon
 import Type
-import BuildTyCl
 import OccName
 import Coercion
 import MkId
@@ -29,26 +29,15 @@ import Control.Monad
 import Outputable
 
 
-buildPReprTyCon :: TyCon -> TyCon -> SumRepr -> VM TyCon
+buildPReprTyCon :: TyCon -> TyCon -> SumRepr -> VM FamInst
 buildPReprTyCon orig_tc vect_tc repr
  = do name      <- mkLocalisedName mkPReprTyConOcc (tyConName orig_tc)
       rhs_ty    <- sumReprType repr
       prepr_tc  <- builtin preprTyCon
-      liftDs    $  buildSynTyCon name
-                             tyvars
-                             (SynonymTyCon rhs_ty)
-                             (typeKind rhs_ty)
-                             NoParentTyCon
-                             (Just $ mk_fam_inst prepr_tc vect_tc)
+      return $ mkSynFamInst name tyvars prepr_tc instTys rhs_ty
   where
     tyvars = tyConTyVars vect_tc
-
-
-mk_fam_inst :: TyCon -> TyCon -> (TyCon, [Type])
-mk_fam_inst fam_tc arg_tc
-  = (fam_tc, [mkTyConApp arg_tc . mkTyVarTys $ tyConTyVars arg_tc])
-
-
+    instTys = [mkTyConApp vect_tc . mkTyVarTys $ tyConTyVars vect_tc]
 
 -- buildPAScAndMethods --------------------------------------------------------
 
@@ -69,7 +58,7 @@ mk_fam_inst fam_tc arg_tc
 --
 type PAInstanceBuilder
         =  TyCon        -- ^ Vectorised TyCon 
-        -> TyCon        -- ^ Representation TyCon
+        -> CoAxiom      -- ^ Coercion to the representation TyCon
         -> TyCon        -- ^ 'PData'  TyCon
         -> TyCon        -- ^ 'PDatas' TyCon
         -> SumRepr      -- ^ Description of generic representation.
@@ -88,8 +77,8 @@ buildPAScAndMethods
 
 
 buildPRDict :: PAInstanceBuilder
-buildPRDict vect_tc prepr_tc _ _ _
-  = prDictOfPReprInstTyCon inst_ty prepr_tc arg_tys
+buildPRDict vect_tc prepr_ax _ _ _
+  = prDictOfPReprInstTyCon inst_ty prepr_ax arg_tys
   where
     arg_tys = mkTyVarTys (tyConTyVars vect_tc)
     inst_ty = mkTyConApp vect_tc arg_tys
@@ -98,7 +87,7 @@ buildPRDict vect_tc prepr_tc _ _ _
 -- buildToPRepr ---------------------------------------------------------------
 -- | Build the 'toRepr' method of the PA class.
 buildToPRepr :: PAInstanceBuilder
-buildToPRepr vect_tc repr_tc _ _ repr
+buildToPRepr vect_tc repr_ax _ _ repr
  = do let arg_ty = mkTyConApp vect_tc ty_args
 
       -- Get the representation type of the argument.
@@ -114,7 +103,7 @@ buildToPRepr vect_tc repr_tc _ _ repr
   where
     ty_args        = mkTyVarTys (tyConTyVars vect_tc)
 
-    wrap_repr_inst = wrapFamInstBody repr_tc ty_args
+    wrap_repr_inst = wrapTypeFamInstBody repr_ax ty_args
 
     -- CoreExp to convert the given argument to the generic representation.
     -- We start by doing a case branch on the possible data constructors.
@@ -172,12 +161,12 @@ buildToPRepr vect_tc repr_tc _ _ repr
 -- |Build the 'fromPRepr' method of the PA class.
 --
 buildFromPRepr :: PAInstanceBuilder
-buildFromPRepr vect_tc repr_tc _ _ repr
+buildFromPRepr vect_tc repr_ax _ _ repr
   = do
       arg_ty <- mkPReprType res_ty
       arg <- newLocalVar (fsLit "x") arg_ty
 
-      result <- from_sum (unwrapFamInstScrut repr_tc ty_args (Var arg))
+      result <- from_sum (unwrapTypeFamInstScrut repr_ax ty_args (Var arg))
                          repr
       return $ Lam arg result
   where
@@ -225,14 +214,13 @@ buildFromPRepr vect_tc repr_tc _ _ repr
 -- |Build the 'toArrRepr' method of the PA class.
 --
 buildToArrPRepr :: PAInstanceBuilder
-buildToArrPRepr vect_tc prepr_tc pdata_tc _ r
+buildToArrPRepr vect_tc repr_co pdata_tc _ r
  = do arg_ty <- mkPDataType el_ty
       res_ty <- mkPDataType =<< mkPReprType el_ty
       arg    <- newLocalVar (fsLit "xs") arg_ty
 
       pdata_co <- mkBuiltinCo pdataTyCon
-      let Just repr_co = tyConFamilyCoercion_maybe prepr_tc
-          co           = mkAppCo pdata_co
+      let co           = mkAppCo pdata_co
                        . mkSymCo
                        $ mkAxInstCo repr_co ty_args
 
@@ -291,13 +279,12 @@ buildToArrPRepr vect_tc prepr_tc pdata_tc _ r
 -- |Build the 'fromArrPRepr' method for the PA class.
 --
 buildFromArrPRepr :: PAInstanceBuilder
-buildFromArrPRepr vect_tc prepr_tc pdata_tc _ r
+buildFromArrPRepr vect_tc repr_co pdata_tc _ r
  = do arg_ty <- mkPDataType =<< mkPReprType el_ty
       res_ty <- mkPDataType el_ty
       arg    <- newLocalVar (fsLit "xs") arg_ty
 
       pdata_co <- mkBuiltinCo pdataTyCon
-      let Just repr_co = tyConFamilyCoercion_maybe prepr_tc
       let co           = mkAppCo pdata_co
                        $ mkAxInstCo repr_co var_tys
 
@@ -367,7 +354,7 @@ buildFromArrPRepr vect_tc prepr_tc pdata_tc _ r
 -- | Build the 'toArrPReprs' instance for the PA class.
 --   This converts a PData of elements into the generic representation.
 buildToArrPReprs :: PAInstanceBuilder
-buildToArrPReprs vect_tc prepr_tc _ pdatas_tc r
+buildToArrPReprs vect_tc repr_co _ pdatas_tc r
  = do
     -- The argument type of the instance.
     --  eg: 'PDatas (Tree a b)'
@@ -383,7 +370,6 @@ buildToArrPReprs vect_tc prepr_tc _ pdatas_tc r
 
     -- Coersion to case between the (PRepr a) type and its instance.
     pdatas_co <- mkBuiltinCo pdatasTyCon
-    let Just repr_co = tyConFamilyCoercion_maybe prepr_tc
     let co           = mkAppCo pdatas_co
                      . mkSymCo
                      $ mkAxInstCo repr_co ty_args
@@ -457,7 +443,7 @@ buildToArrPReprs vect_tc prepr_tc _ pdatas_tc r
 
 -- buildFromArrPReprs ---------------------------------------------------------
 buildFromArrPReprs :: PAInstanceBuilder
-buildFromArrPReprs vect_tc prepr_tc _ pdatas_tc r
+buildFromArrPReprs vect_tc repr_co _ pdatas_tc r
  = do   
     -- The argument type of the instance.
     --  eg: 'PDatas (PRepr (Tree a b))'
@@ -471,9 +457,8 @@ buildFromArrPReprs vect_tc prepr_tc _ pdatas_tc r
     -- eg: (xss :: PDatas (PRepr (Tree a b)))
     varg        <- newLocalVar (fsLit "xss") arg_ty
         
-    -- Build the coersion between PRepr and the instance type
+    -- Build the coercion between PRepr and the instance type
     pdatas_co <- mkBuiltinCo pdatasTyCon
-    let Just repr_co = tyConFamilyCoercion_maybe prepr_tc
     let co           = mkAppCo pdatas_co
                      $ mkAxInstCo repr_co var_tys
 
diff --git a/compiler/vectorise/Vectorise/Generic/PData.hs b/compiler/vectorise/Vectorise/Generic/PData.hs
index 3587452951..1026e95029 100644
--- a/compiler/vectorise/Vectorise/Generic/PData.hs
+++ b/compiler/vectorise/Vectorise/Generic/PData.hs
@@ -18,6 +18,7 @@ import BuildTyCl
 import DataCon
 import TyCon
 import Type
+import FamInstEnv
 import Name
 import Util
 import MonadUtils
@@ -26,27 +27,36 @@ import Control.Monad
 
 -- buildPDataTyCon ------------------------------------------------------------
 -- | Build the PData instance tycon for a given type constructor.
-buildPDataTyCon :: TyCon -> TyCon -> SumRepr -> VM TyCon
+buildPDataTyCon :: TyCon -> TyCon -> SumRepr -> VM FamInst
 buildPDataTyCon orig_tc vect_tc repr 
- = fixV $ \repr_tc ->
- do name' <- mkLocalisedName mkPDataTyConOcc orig_name
-    rhs   <- buildPDataTyConRhs orig_name vect_tc repr_tc repr
-    pdata <- builtin pdataTyCon
+ = fixV $ \fam_inst ->
+   do let repr_tc = dataFamInstRepTyCon fam_inst
+      name' <- mkLocalisedName mkPDataTyConOcc orig_name
+      rhs   <- buildPDataTyConRhs orig_name vect_tc repr_tc repr
+      pdata <- builtin pdataTyCon
+      buildDataFamInst name' pdata vect_tc rhs
+ where
+    orig_name = tyConName orig_tc
 
-    liftDs $ buildAlgTyCon name'
+buildDataFamInst :: Name -> TyCon -> TyCon -> AlgTyConRhs -> VM FamInst
+buildDataFamInst name' fam_tc vect_tc rhs
+ = do { axiom_name <- mkDerivedName mkInstTyCoOcc name'
+
+      ; let fam_inst = mkDataFamInst axiom_name tyvars fam_tc pat_tys rep_tc
+            ax       = famInstAxiom fam_inst
+            pat_tys  = [mkTyConApp vect_tc (mkTyVarTys tyvars)]
+            rep_tc   = buildAlgTyCon name'
                            tyvars
                            []          -- no stupid theta
                            rhs
                            rec_flag    -- FIXME: is this ok?
                            False       -- not GADT syntax
-                           NoParentTyCon
-                           (Just $ mk_fam_inst pdata vect_tc)
+                           (FamInstTyCon ax fam_tc pat_tys)
+      ; return fam_inst }
  where
-    orig_name = tyConName orig_tc
     tyvars    = tyConTyVars vect_tc
     rec_flag  = boolToRecFlag (isRecursiveTyCon vect_tc)
 
-
 buildPDataTyConRhs :: Name -> TyCon -> TyCon -> SumRepr -> VM AlgTyConRhs
 buildPDataTyConRhs orig_name vect_tc repr_tc repr
  = do data_con <- buildPDataDataCon orig_name vect_tc repr_tc repr
@@ -74,26 +84,16 @@ buildPDataDataCon orig_name vect_tc repr_tc repr
 
 -- buildPDatasTyCon -----------------------------------------------------------
 -- | Build the PDatas instance tycon for a given type constructor.
-buildPDatasTyCon :: TyCon -> TyCon -> SumRepr -> VM TyCon
+buildPDatasTyCon :: TyCon -> TyCon -> SumRepr -> VM FamInst
 buildPDatasTyCon orig_tc vect_tc repr 
- = fixV $ \repr_tc ->
- do name'       <- mkLocalisedName mkPDatasTyConOcc orig_name
-    rhs         <- buildPDatasTyConRhs orig_name vect_tc repr_tc repr
-    pdatas      <- builtin pdatasTyCon
-
-    liftDs $ buildAlgTyCon name'
-                           tyvars
-                           []          -- no stupid theta
-                           rhs
-                           rec_flag    -- FIXME: is this ok?
-                           False       -- not GADT syntax
-                           NoParentTyCon
-                           (Just $ mk_fam_inst pdatas vect_tc)
+ = fixV $ \fam_inst ->
+   do let repr_tc = dataFamInstRepTyCon fam_inst
+      name'       <- mkLocalisedName mkPDatasTyConOcc orig_name
+      rhs         <- buildPDatasTyConRhs orig_name vect_tc repr_tc repr
+      pdatas     <- builtin pdatasTyCon
+      buildDataFamInst name' pdatas vect_tc rhs
  where
-    orig_name = tyConName   orig_tc
-    tyvars    = tyConTyVars vect_tc
-    rec_flag  = boolToRecFlag (isRecursiveTyCon vect_tc)
-
+    orig_name = tyConName orig_tc
 
 buildPDatasTyConRhs :: Name -> TyCon -> TyCon -> SumRepr -> VM AlgTyConRhs
 buildPDatasTyConRhs orig_name vect_tc repr_tc repr
@@ -145,7 +145,8 @@ mkSumTys repr_selX_ty mkTc repr
 
     comp_ty r = mkTc (compOrigType r)
 
-
+{-
 mk_fam_inst :: TyCon -> TyCon -> (TyCon, [Type])
 mk_fam_inst fam_tc arg_tc
   = (fam_tc, [mkTyConApp arg_tc . mkTyVarTys $ tyConTyVars arg_tc])
+-}
\ No newline at end of file
diff --git a/compiler/vectorise/Vectorise/Monad/InstEnv.hs b/compiler/vectorise/Vectorise/Monad/InstEnv.hs
index c36f179229..971fd8ff1f 100644
--- a/compiler/vectorise/Vectorise/Monad/InstEnv.hs
+++ b/compiler/vectorise/Vectorise/Monad/InstEnv.hs
@@ -57,7 +57,8 @@ lookupFamInst tycon tys
   = ASSERT( isFamilyTyCon tycon )
     do { instEnv <- readGEnv global_fam_inst_env
        ; case lookupFamInstEnv instEnv tycon tys of
-           [(fam_inst, rep_tys)] -> return (famInstTyCon fam_inst, rep_tys)
+           [(fam_inst, rep_tys)] -> return ( dataFamInstRepTyCon fam_inst
+                                           , rep_tys)
            _other                -> 
              cantVectorise "VectMonad.lookupFamInst: not found: " 
                            (ppr $ mkTyConApp tycon tys)
diff --git a/compiler/vectorise/Vectorise/Monad/Naming.hs b/compiler/vectorise/Vectorise/Monad/Naming.hs
index ecf0e81306..30b8a0e1e4 100644
--- a/compiler/vectorise/Vectorise/Monad/Naming.hs
+++ b/compiler/vectorise/Vectorise/Monad/Naming.hs
@@ -2,6 +2,7 @@
 
 module Vectorise.Monad.Naming
   ( mkLocalisedName
+  , mkDerivedName
   , mkVectId
   , cloneVar
   , newExportedVar
@@ -35,16 +36,25 @@ import Control.Monad
 -- always an internal system name.
 --
 mkLocalisedName :: (Maybe String -> OccName -> OccName) -> Name -> VM Name
-mkLocalisedName mk_occ name = 
-  do { mod <- liftDs getModuleDs
-     ; u   <- liftDs newUnique
-     ; let occ_name = mkLocalisedOccName mod mk_occ name
-
-           new_name | isExternalName name = mkExternalName u mod occ_name (nameSrcSpan name)
-                    | otherwise           = mkSystemName   u     occ_name
-
-     ; return new_name
-     }
+mkLocalisedName mk_occ name
+  = do { mod <- liftDs getModuleDs
+       ; u   <- liftDs newUnique
+       ; let occ_name = mkLocalisedOccName mod mk_occ name
+
+             new_name | isExternalName name = mkExternalName u mod occ_name (nameSrcSpan name)
+                      | otherwise           = mkSystemName   u     occ_name
+
+       ; return new_name }
+
+mkDerivedName :: (OccName -> OccName) -> Name -> VM Name
+-- Similar to mkLocalisedName, but assumes the
+-- incoming name is from this module.  
+-- Works on External names only
+mkDerivedName mk_occ name 
+  = do { u   <- liftDs newUnique
+       ; return (mkExternalName u (nameModule name)  
+                                  (mk_occ (nameOccName name))
+                                  (nameSrcSpan name)) }
 
 -- |Produce the vectorised variant of an `Id` with the given vectorised type, while taking care that
 -- vectorised dfun ids must be dfuns again.
diff --git a/compiler/vectorise/Vectorise/Type/Env.hs b/compiler/vectorise/Vectorise/Type/Env.hs
index 5d2213ac26..a6f77bb9db 100644
--- a/compiler/vectorise/Vectorise/Type/Env.hs
+++ b/compiler/vectorise/Vectorise/Type/Env.hs
@@ -229,12 +229,15 @@ vectTypeEnv tycons vectTypeDecls vectClassDecls
            -- Build 'PRepr' and 'PData' instance type constructors and family instances for all
            -- type constructors with vectorised representations.
        ; reprs      <- mapM tyConRepr vect_tcs
-       ; repr_tcs   <- zipWith3M buildPReprTyCon  orig_tcs vect_tcs reprs
-       ; pdata_tcs  <- zipWith3M buildPDataTyCon  orig_tcs vect_tcs reprs
-       ; pdatas_tcs <- zipWith3M buildPDatasTyCon orig_tcs vect_tcs reprs
-
-       ; let inst_tcs  = repr_tcs ++ pdata_tcs ++ pdatas_tcs
-             fam_insts = map mkLocalFamInst inst_tcs
+       ; repr_fis   <- zipWith3M buildPReprTyCon  orig_tcs vect_tcs reprs
+       ; pdata_fis  <- zipWith3M buildPDataTyCon  orig_tcs vect_tcs reprs
+       ; pdatas_fis <- zipWith3M buildPDatasTyCon orig_tcs vect_tcs reprs
+
+       ; let fam_insts  = repr_fis ++ pdata_fis ++ pdatas_fis
+             repr_axs   = map famInstAxiom repr_fis
+             pdata_tcs  = famInstsRepTyCons pdata_fis
+             pdatas_tcs = famInstsRepTyCons pdatas_fis
+             
        ; updGEnv $ extendFamEnv fam_insts
 
            -- Generate workers for the vectorised data constructors, dfuns for the 'PA' instances of
@@ -262,7 +265,7 @@ vectTypeEnv tycons vectTypeDecls vectClassDecls
               ; dfuns <- sequence $
                            zipWith4 buildTyConPADict
                                     vect_tcs
-                                    repr_tcs
+                                    repr_axs
                                     pdata_tcs
                                     pdatas_tcs
 
@@ -272,7 +275,8 @@ vectTypeEnv tycons vectTypeDecls vectClassDecls
 
            -- Return the vectorised variants of type constructors as well as the generated instance
            -- type constructors, family instances, and dfun bindings.
-       ; return (new_tcs ++ inst_tcs ++ syn_tcs, fam_insts, binds)
+       ; return ( new_tcs ++ pdata_tcs ++ pdatas_tcs ++ syn_tcs
+                , fam_insts, binds)
        }
   where
     fst3 (a, _, _) = a
@@ -319,9 +323,9 @@ vectTypeEnv tycons vectTypeDecls vectClassDecls
 
 -- Helpers --------------------------------------------------------------------
 
-buildTyConPADict :: TyCon -> TyCon -> TyCon -> TyCon -> VM Var
-buildTyConPADict vect_tc prepr_tc pdata_tc pdatas_tc
- = tyConRepr vect_tc >>= buildPADict vect_tc prepr_tc pdata_tc pdatas_tc
+buildTyConPADict :: TyCon -> CoAxiom -> TyCon -> TyCon -> VM Var
+buildTyConPADict vect_tc prepr_ax pdata_tc pdatas_tc
+ = tyConRepr vect_tc >>= buildPADict vect_tc prepr_ax pdata_tc pdatas_tc
 
 -- Produce a custom-made worker for the data constructors of a vectorised data type.  This includes
 -- all data constructors that may be used in vetcorised code — i.e., all data constructors of data
diff --git a/compiler/vectorise/Vectorise/Type/TyConDecl.hs b/compiler/vectorise/Vectorise/Type/TyConDecl.hs
index 88ff686452..9b830446c8 100644
--- a/compiler/vectorise/Vectorise/Type/TyConDecl.hs
+++ b/compiler/vectorise/Vectorise/Type/TyConDecl.hs
@@ -93,7 +93,7 @@ vectTyConDecl tycon name'
              gadt_flag = isGadtSyntaxTyCon tycon
 
            -- build the vectorised type constructor
-       ; liftDs $ buildAlgTyCon 
+       ; return $ buildAlgTyCon 
                     name'                   -- new name
                     (tyConTyVars tycon)     -- keep original type vars
                     []                      -- no stupid theta
@@ -101,7 +101,6 @@ vectTyConDecl tycon name'
                     rec_flag                -- whether recursive
                     gadt_flag               -- whether in GADT syntax
                     NoParentTyCon           
-                    Nothing                 -- not a family instance
        }
 
   -- some other crazy thing that we don't handle
diff --git a/compiler/vectorise/Vectorise/Utils/Base.hs b/compiler/vectorise/Vectorise/Utils/Base.hs
index 0c111f49c7..2b47ddfb9b 100644
--- a/compiler/vectorise/Vectorise/Utils/Base.hs
+++ b/compiler/vectorise/Vectorise/Utils/Base.hs
@@ -36,7 +36,6 @@ import DataCon
 import MkId
 import FastString
 
-
 -- Simple Types ---------------------------------------------------------------
 
 voidType :: VM Type
diff --git a/compiler/vectorise/Vectorise/Utils/PADict.hs b/compiler/vectorise/Vectorise/Utils/PADict.hs
index 164ebae229..dfc08bcf58 100644
--- a/compiler/vectorise/Vectorise/Utils/PADict.hs
+++ b/compiler/vectorise/Vectorise/Utils/PADict.hs
@@ -113,20 +113,17 @@ paMethod method _ ty
 --
 -- Note that @ty@ is only used for error messages
 --
-prDictOfPReprInstTyCon :: Type -> TyCon -> [Type] -> VM CoreExpr
-prDictOfPReprInstTyCon ty prepr_tc prepr_args
-  | Just rhs <- coreView (mkTyConApp prepr_tc prepr_args)
+prDictOfPReprInstTyCon :: Type -> CoAxiom -> [Type] -> VM CoreExpr
+prDictOfPReprInstTyCon _ty prepr_ax prepr_args
   = do
+      let rhs = mkAxInstRHS prepr_ax prepr_args
       dict <- prDictOfReprType' rhs
       pr_co <- mkBuiltinCo prTyCon
-      let Just arg_co = tyConFamilyCoercion_maybe prepr_tc
       let co = mkAppCo pr_co
              $ mkSymCo
-             $ mkAxInstCo arg_co prepr_args
+             $ mkAxInstCo prepr_ax prepr_args
       return $ mkCast dict co
 
-  | otherwise = cantVectorise "Invalid PRepr type instance" (ppr ty)
-
 -- |Get the PR dictionary for a type. The argument must be a representation
 -- type.
 --