Remove support for CTYPE pragmas on type synonyms

It's not clear whether it's desirable or not, and it turns out that
the way we use coercions in GHC means we tend to lose information
about type synonyms.

13 files changed, 29 insertions, 45 deletions

diff --git a/compiler/hsSyn/Convert.lhs b/compiler/hsSyn/Convert.lhs
index 0d7c960289..068a9eeec2 100644
--- a/compiler/hsSyn/Convert.lhs
+++ b/compiler/hsSyn/Convert.lhs
@@ -161,7 +161,7 @@ cvtDec (PragmaD prag)
 cvtDec (TySynD tc tvs rhs)
   = do	{ (_, tc', tvs') <- cvt_tycl_hdr [] tc tvs
 	; rhs' <- cvtType rhs
-	; returnL $ TyClD (TySynonym tc' Nothing tvs' Nothing rhs') }
+	; returnL $ TyClD (TySynonym tc' tvs' Nothing rhs') }
 
 cvtDec (DataD ctxt tc tvs constrs derivs)
   = do	{ (ctxt', tc', tvs') <- cvt_tycl_hdr ctxt tc tvs
@@ -235,7 +235,7 @@ cvtDec (TySynInstD tc tys rhs)
   = do	{ (_, tc', tvs', tys') <- cvt_tyinst_hdr [] tc tys
 	; rhs' <- cvtType rhs
 	; returnL $ InstD $ FamInstDecl $ 
-                    TySynonym tc' Nothing tvs' tys' rhs' }
+                    TySynonym tc' tvs' tys' rhs' }
 
 ----------------
 cvt_ci_decs :: MsgDoc -> [TH.Dec]
diff --git a/compiler/hsSyn/HsDecls.lhs b/compiler/hsSyn/HsDecls.lhs
index 142d53f378..4d8c01d196 100644
--- a/compiler/hsSyn/HsDecls.lhs
+++ b/compiler/hsSyn/HsDecls.lhs
@@ -497,7 +497,6 @@ data TyClDecl name
     }
 
   | TySynonym { tcdLName  :: Located name,              -- ^ type constructor
-                tcdCType  :: Maybe CType,
                 tcdTyVars :: [LHsTyVarBndr name],       -- ^ type variables
                 tcdTyPats :: Maybe [LHsType name],      -- ^ Type patterns
                   -- See Note [tcdTyVars and tcdTyPats] 
diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
index 1533bf1fec..13f949658a 100644
--- a/compiler/iface/BinIface.hs
+++ b/compiler/iface/BinIface.hs
@@ -1381,13 +1381,12 @@ instance Binary IfaceDecl where
         put_ bh a7
         put_ bh a8
 
-    put_ bh (IfaceSyn a1 a2 a3 a4 a5) = do
+    put_ bh (IfaceSyn a1 a2 a3 a4) = do
         putByte bh 3
         put_ bh (occNameFS a1)
         put_ bh a2
         put_ bh a3
         put_ bh a4
-        put_ bh a5
 
     put_ bh (IfaceClass a1 a2 a3 a4 a5 a6 a7) = do
         putByte bh 4
@@ -1430,9 +1429,8 @@ instance Binary IfaceDecl where
                     a2 <- get bh
                     a3 <- get bh
                     a4 <- get bh
-                    a5 <- get bh
                     occ <- return $! mkOccNameFS tcName a1
-                    return (IfaceSyn occ a2 a3 a4 a5)
+                    return (IfaceSyn occ a2 a3 a4)
             4 -> do a1 <- get bh
                     a2 <- get bh
                     a3 <- get bh
diff --git a/compiler/iface/BuildTyCl.lhs b/compiler/iface/BuildTyCl.lhs
index 8e6f43adc7..4a93a2bbe4 100644
--- a/compiler/iface/BuildTyCl.lhs
+++ b/compiler/iface/BuildTyCl.lhs
@@ -46,13 +46,12 @@ import Outputable
 \begin{code}
 ------------------------------------------------------
 buildSynTyCon :: Name -> [TyVar] 
-              -> Maybe CType
               -> SynTyConRhs
               -> Kind                   -- ^ Kind of the RHS
               -> TyConParent
               -> TcRnIf m n TyCon
-buildSynTyCon tc_name tvs cType rhs rhs_kind parent 
-  = return (mkSynTyCon tc_name kind tvs cType rhs parent)
+buildSynTyCon tc_name tvs rhs rhs_kind parent 
+  = return (mkSynTyCon tc_name kind tvs rhs parent)
   where kind = mkPiKinds tvs rhs_kind
 
 ------------------------------------------------------
diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs
index 62b8234a96..44703d20a1 100644
--- a/compiler/iface/IfaceSyn.lhs
+++ b/compiler/iface/IfaceSyn.lhs
@@ -80,7 +80,6 @@ data IfaceDecl
     }
 
   | IfaceSyn  { ifName    :: OccName,           -- Type constructor
-                ifCType   :: Maybe CType,       -- C type for CAPI FFI
                 ifTyVars  :: [IfaceTvBndr],     -- Type variables
                 ifSynKind :: IfaceKind,         -- Kind of the *rhs* (not of the tycon)
                 ifSynRhs  :: Maybe IfaceType    -- Just rhs for an ordinary synonyn
@@ -455,11 +454,11 @@ pprIfaceDecl (IfaceId {ifName = var, ifType = ty,
 pprIfaceDecl (IfaceForeign {ifName = tycon})
   = hsep [ptext (sLit "foreign import type dotnet"), ppr tycon]
 
-pprIfaceDecl (IfaceSyn {ifName = tycon, ifCType = cType,
+pprIfaceDecl (IfaceSyn {ifName = tycon,
                         ifTyVars = tyvars,
                         ifSynRhs = Just mono_ty})
   = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] tycon tyvars)
-       4 (vcat [pprCType cType, equals <+> ppr mono_ty])
+       4 (vcat [equals <+> ppr mono_ty])
 
 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
                         ifSynRhs = Nothing, ifSynKind = kind })
diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index 9290a68ad9..32cb5824d7 100644
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -1432,7 +1432,6 @@ tyThingToIfaceDecl (ATyCon tycon)
 
   | isSynTyCon tycon
   = IfaceSyn {  ifName    = getOccName tycon,
-                ifCType   = tyConCType tycon,
                 ifTyVars  = toIfaceTvBndrs tyvars,
                 ifSynRhs  = syn_rhs,
                 ifSynKind = syn_ki }
diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs
index 231481be70..74902dddce 100644
--- a/compiler/iface/TcIface.lhs
+++ b/compiler/iface/TcIface.lhs
@@ -463,7 +463,6 @@ tc_iface_decl parent _ (IfaceData {ifName = occ_name,
            ; return (FamInstTyCon ax fam_tc (substTys subst fam_tys)) }
 
 tc_iface_decl parent _ (IfaceSyn {ifName = occ_name, ifTyVars = tv_bndrs, 
-                                  ifCType = cType,
                                   ifSynRhs = mb_rhs_ty,
                                   ifSynKind = kind })
    = bindIfaceTyVars_AT tv_bndrs $ \ tyvars -> do
@@ -471,7 +470,7 @@ tc_iface_decl parent _ (IfaceSyn {ifName = occ_name, ifTyVars = tv_bndrs,
      ; rhs_kind <- tcIfaceType kind     -- Note [Synonym kind loop]
      ; rhs      <- forkM (mk_doc tc_name) $ 
                    tc_syn_rhs mb_rhs_ty
-     ; tycon    <- buildSynTyCon tc_name tyvars cType rhs rhs_kind parent
+     ; tycon    <- buildSynTyCon tc_name tyvars rhs rhs_kind parent
      ; return (ATyCon tycon) }
    where
      mk_doc n = ptext (sLit "Type syonym") <+> ppr n
diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index 62fdeddf28..ff98b748c9 100644
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -609,7 +609,7 @@ cl_decl :: { LTyClDecl RdrName }
 --
 ty_decl :: { LTyClDecl RdrName }
            -- ordinary type synonyms
-        : 'type' capi_ctype type '=' ctypedoc
+        : 'type' type '=' ctypedoc
                 -- Note ctype, not sigtype, on the right of '='
                 -- We allow an explicit for-all but we don't insert one
                 -- in   type Foo a = (b,b)
@@ -617,7 +617,7 @@ ty_decl :: { LTyClDecl RdrName }
                 --
                 -- Note the use of type for the head; this allows
                 -- infix type constructors to be declared 
-                {% mkTySynonym (comb2 $1 $5) False $2 $3 $5 }
+                {% mkTySynonym (comb2 $1 $4) False $2 $4 }
 
            -- type family declarations
         | 'type' 'family' type opt_kind_sig 
@@ -651,10 +651,10 @@ inst_decl :: { LInstDecl RdrName }
                    in L (comb3 $1 $2 $3) (ClsInstDecl $2 binds sigs ats) }
 
            -- type instance declarations
-        | 'type' 'instance' capi_ctype type '=' ctype
+        | 'type' 'instance' type '=' ctype
                 -- Note the use of type for the head; this allows
                 -- infix type constructors and type patterns
-                {% do { L loc d <- mkTySynonym (comb2 $1 $6) True $3 $4 $6
+                {% do { L loc d <- mkTySynonym (comb2 $1 $5) True $3 $5
                       ; return (L loc (FamInstDecl d)) } }
 
           -- data/newtype instance declaration
@@ -682,19 +682,16 @@ inst_decl :: { LInstDecl RdrName }
 --
 at_decl_cls :: { LTyClDecl RdrName }
            -- type family declarations
-        : 'type' capi_ctype type opt_kind_sig
+        : 'type' type opt_kind_sig
                 -- Note the use of type for the head; this allows
                 -- infix type constructors to be declared.
-                -- Note that we ignore the capi_ctype for now, but
-                -- we need it in the grammar or we get loads of
-                -- extra shift/reduce conflicts and parsing goes wrong.
-                {% mkTyFamily (comb3 $1 $3 $4) TypeFamily $3 (unLoc $4) }
+                {% mkTyFamily (comb3 $1 $2 $3) TypeFamily $2 (unLoc $3) }
 
            -- default type instance
-        | 'type' capi_ctype type '=' ctype
+        | 'type' type '=' ctype
                 -- Note the use of type for the head; this allows
                 -- infix type constructors and type patterns
-                {% mkTySynonym (comb2 $1 $5) True $2 $3 $5 }
+                {% mkTySynonym (comb2 $1 $4) True $2 $4 }
 
           -- data/newtype family declaration
         | 'data' type opt_kind_sig
@@ -704,10 +701,10 @@ at_decl_cls :: { LTyClDecl RdrName }
 --
 at_decl_inst :: { LTyClDecl RdrName }
            -- type instance declarations
-        : 'type' capi_ctype type '=' ctype
+        : 'type' type '=' ctype
                 -- Note the use of type for the head; this allows
                 -- infix type constructors and type patterns
-                {% mkTySynonym (comb2 $1 $5) True $2 $3 $5 }
+                {% mkTySynonym (comb2 $1 $4) True $2 $4 }
 
         -- data/newtype instance declaration
         | data_or_newtype capi_ctype tycl_hdr constrs deriving
diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs
index 890c3794d1..c20ce1ac17 100644
--- a/compiler/parser/RdrHsSyn.lhs
+++ b/compiler/parser/RdrHsSyn.lhs
@@ -212,14 +212,13 @@ mkTyData loc new_or_data is_family cType (L _ (mcxt, tycl_hdr)) ksig data_cons m
 
 mkTySynonym :: SrcSpan
             -> Bool             -- True <=> type family instances
-            -> Maybe CType
             -> LHsType RdrName  -- LHS
             -> LHsType RdrName  -- RHS
             -> P (LTyClDecl RdrName)
-mkTySynonym loc is_family cType lhs rhs
+mkTySynonym loc is_family lhs rhs
   = do { (tc, tparams) <- checkTyClHdr lhs
        ; (tyvars, typats) <- checkTParams is_family lhs tparams
-       ; return (L loc (TySynonym tc cType tyvars typats rhs)) }
+       ; return (L loc (TySynonym tc tyvars typats rhs)) }
 
 mkTyFamily :: SrcSpan
            -> FamilyFlavour
diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs
index 0ebda54885..e747b85719 100644
--- a/compiler/rename/RnSource.lhs
+++ b/compiler/rename/RnSource.lhs
@@ -851,7 +851,7 @@ rnTyClDecl mb_cls tydecl@TyData {tcdND = new_or_data, tcdCType = cType,
 			     ; return (Just ds', extractHsTyNames_s ds') }
 
 -- "type" and "type instance" declarations
-rnTyClDecl mb_cls tydecl@(TySynonym { tcdTyVars = tyvars, tcdCType = cType,
+rnTyClDecl mb_cls tydecl@(TySynonym { tcdTyVars = tyvars,
                           tcdLName = name,
 		  	              tcdTyPats = typats, tcdSynRhs = ty})
   = bindQTvs syn_doc mb_cls tyvars $ \ tyvars' -> do
@@ -859,7 +859,7 @@ rnTyClDecl mb_cls tydecl@(TySynonym { tcdTyVars = tyvars, tcdCType = cType,
       name' <- lookupTcdName mb_cls tydecl
     ; (typats',fvs1) <- rnTyPats syn_doc name' typats
     ; (ty', fvs2)    <- rnHsTypeFVs syn_doc ty
-    ; return (TySynonym { tcdLName = name', tcdCType = cType
+    ; return (TySynonym { tcdLName = name'
                 , tcdTyVars = tyvars'
     			, tcdTyPats = typats', tcdSynRhs = ty'}
              , extractHsTyVarBndrNames_s tyvars' (fvs1 `plusFV` fvs2)) }
diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs
index 7829d1bb4c..d02f0a8b94 100644
--- a/compiler/typecheck/TcTyClsDecls.lhs
+++ b/compiler/typecheck/TcTyClsDecls.lhs
@@ -560,7 +560,7 @@ tcTyClDecl1 parent _calc_isrec
   = tcTyClTyVars tc_name tvs $ \ tvs' kind -> do
   { traceTc "type family:" (ppr tc_name)
   ; checkFamFlag tc_name
-  ; tycon <- buildSynTyCon tc_name tvs' Nothing SynFamilyTyCon kind parent
+  ; tycon <- buildSynTyCon tc_name tvs' SynFamilyTyCon kind parent
   ; return [ATyCon tycon] }
 
   -- "data family" declaration
@@ -577,11 +577,11 @@ tcTyClDecl1 parent _calc_isrec
 
   -- "type" synonym declaration
 tcTyClDecl1 _parent _calc_isrec
-            (TySynonym {tcdLName = L _ tc_name, tcdCType = cType, tcdTyVars = tvs, tcdSynRhs = rhs_ty})
+            (TySynonym {tcdLName = L _ tc_name, tcdTyVars = tvs, tcdSynRhs = rhs_ty})
   = ASSERT( isNoParent _parent )
     tcTyClTyVars tc_name tvs $ \ tvs' kind -> do
     { rhs_ty' <- tcCheckHsType rhs_ty kind
-    ; tycon <- buildSynTyCon tc_name tvs' cType (SynonymTyCon rhs_ty')
+    ; tycon <- buildSynTyCon tc_name tvs' (SynonymTyCon rhs_ty')
                  kind NoParentTyCon
     ; return [ATyCon tycon] }
 
diff --git a/compiler/types/TyCon.lhs b/compiler/types/TyCon.lhs
index 18504d16cc..05430920ce 100644
--- a/compiler/types/TyCon.lhs
+++ b/compiler/types/TyCon.lhs
@@ -360,9 +360,6 @@ data TyCon
         tyConArity   :: Arity,
 
         tyConTyVars  :: [TyVar],        -- Bound tyvars
-        tyConCType   :: Maybe CType,    -- The C type that should be used
-                                        -- for this type when using the FFI
-                                        -- and CAPI
 
         synTcRhs     :: SynTyConRhs,    -- ^ Contains information about the
                                         -- expansion of the synonym
@@ -934,15 +931,14 @@ mkPrimTyCon' name kind arity rep is_unlifted
     }
 
 -- | Create a type synonym 'TyCon'
-mkSynTyCon :: Name -> Kind -> [TyVar] -> Maybe CType -> SynTyConRhs -> TyConParent -> TyCon
-mkSynTyCon name kind tyvars cType rhs parent
+mkSynTyCon :: Name -> Kind -> [TyVar] -> SynTyConRhs -> TyConParent -> TyCon
+mkSynTyCon name kind tyvars rhs parent
   = SynTyCon {
         tyConName = name,
         tyConUnique = nameUnique name,
         tc_kind = kind,
         tyConArity = length tyvars,
         tyConTyVars = tyvars,
-        tyConCType = cType,
         synTcRhs = rhs,
         synTcParent = parent
     }
@@ -1232,7 +1228,6 @@ isImplicitTyCon tycon
 
 tyConCType_maybe :: TyCon -> Maybe CType
 tyConCType_maybe tc@(AlgTyCon {}) = tyConCType tc
-tyConCType_maybe tc@(SynTyCon {}) = tyConCType tc
 tyConCType_maybe _ = Nothing
 \end{code}
 
diff --git a/compiler/vectorise/Vectorise/Type/Env.hs b/compiler/vectorise/Vectorise/Type/Env.hs
index dd4b923ca0..0051d072a4 100644
--- a/compiler/vectorise/Vectorise/Type/Env.hs
+++ b/compiler/vectorise/Vectorise/Type/Env.hs
@@ -326,7 +326,7 @@ vectTypeEnv tycons vectTypeDecls vectClassDecls
         origName  = tyConName origTyCon
         vectName  = tyConName vectTyCon
 
-        mkSyn canonName ty = mkSynTyCon canonName (typeKind ty) [] Nothing (SynonymTyCon ty) NoParentTyCon
+        mkSyn canonName ty = mkSynTyCon canonName (typeKind ty) [] (SynonymTyCon ty) NoParentTyCon
         
         defDataCons
           | isAbstract = return ()