Fix Trac #2412: type synonyms and hs-boot recursion

[ghc-hetmet.git] / compiler / iface / BuildTyCl.lhs

diff --git a/compiler/iface/BuildTyCl.lhs b/compiler/iface/BuildTyCl.lhs
index 99f5abe..ef75d7f 100644 (file)
--- a/compiler/iface/BuildTyCl.lhs
+++ b/compiler/iface/BuildTyCl.lhs
@@ -4,13 +4,6 @@
 %
 
 \begin{code}
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
 module BuildTyCl (
        buildSynTyCon, buildAlgTyCon, buildDataCon,
        buildClass,
@@ -21,12 +14,10 @@ module BuildTyCl (
 #include "HsVersions.h"
 
 import IfaceEnv
-import TcRnMonad
 
 import DataCon
 import Var
 import VarSet
-import TysWiredIn
 import BasicTypes
 import Name
 import OccName
@@ -48,22 +39,23 @@ import Data.List
 ------------------------------------------------------
 buildSynTyCon :: Name -> [TyVar] 
               -> SynTyConRhs 
+             -> Kind                   -- Kind of the RHS
              -> Maybe (TyCon, [Type])  -- family instance if applicable
               -> TcRnIf m n TyCon
 
-buildSynTyCon tc_name tvs rhs@(OpenSynTyCon rhs_ki _) _
+buildSynTyCon tc_name tvs rhs@(OpenSynTyCon {}) rhs_kind _
   = let
-      kind = mkArrowKinds (map tyVarKind tvs) rhs_ki
+      kind = mkArrowKinds (map tyVarKind tvs) rhs_kind
     in
     return $ mkSynTyCon tc_name kind tvs rhs NoParentTyCon
     
-buildSynTyCon tc_name tvs rhs@(SynonymTyCon rhs_ty) mb_family
+buildSynTyCon tc_name tvs rhs@(SynonymTyCon {}) rhs_kind mb_family
   = do { -- We need to tie a knot as the coercion of a data instance depends
         -- on the instance representation tycon and vice versa.
        ; tycon <- fixM (\ tycon_rec -> do 
         { parent <- mkParentInfo mb_family tc_name tvs tycon_rec
         ; let { tycon   = mkSynTyCon tc_name kind tvs rhs parent
-              ; kind    = mkArrowKinds (map tyVarKind tvs) (typeKind rhs_ty)
+              ; kind    = mkArrowKinds (map tyVarKind tvs) rhs_kind
               }
          ; return tycon
          })
@@ -218,6 +210,7 @@ buildDataCon src_name declared_infix arg_stricts field_lbls
 -- the type variables mentioned in the arg_tys
 -- ToDo: Or functionally dependent on?  
 --      This whole stupid theta thing is, well, stupid.
+mkDataConStupidTheta :: TyCon -> [Type] -> [TyVar] -> [PredType]
 mkDataConStupidTheta tycon arg_tys univ_tvs
   | null stupid_theta = []     -- The common case
   | otherwise        = filter in_arg_tys stupid_theta