TysWiredIn is now warning-free
[ghc-hetmet.git] / compiler / iface / BuildTyCl.lhs
index e951c63..fbf6dfd 100644 (file)
@@ -4,11 +4,11 @@
 %
 
 \begin{code}
-{-# OPTIONS_GHC -w #-}
+{-# 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/WorkingConventions#Warnings
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
 -- for details
 
 module BuildTyCl (
@@ -146,10 +146,9 @@ mkNewTyConRhs tycon_name tycon con
        ; return (NewTyCon { data_con    = con, 
                             nt_rhs      = rhs_ty,
                             nt_etad_rhs = (etad_tvs, etad_rhs),
-                            nt_co       = cocon_maybe, 
+                            nt_co       = cocon_maybe } ) }
                              -- Coreview looks through newtypes with a Nothing
                              -- for nt_co, or uses explicit coercions otherwise
-                            nt_rep = mkNewTyConRep tycon rhs_ty }) }
   where
         -- If all_coercions is True then we use coercions for all newtypes
         -- otherwise we use coercions for recursive newtypes and look through
@@ -180,42 +179,6 @@ mkNewTyConRhs tycon_name tycon con
     eta_reduce tvs ty = (reverse tvs, ty)
                                
 
-mkNewTyConRep :: TyCon         -- The original type constructor
-             -> Type           -- The arg type of its constructor
-             -> Type           -- Chosen representation type
--- The "representation type" is guaranteed not to be another newtype
--- at the outermost level; but it might have newtypes in type arguments
-
--- Find the representation type for this newtype TyCon
--- Remember that the representation type is the *ultimate* representation
--- type, looking through other newtypes.
--- 
--- splitTyConApp_maybe no longer looks through newtypes, so we must
--- deal explicitly with this case
--- 
--- The trick is to to deal correctly with recursive newtypes
--- such as     newtype T = MkT T
-
-mkNewTyConRep tc rhs_ty
-  | null (tyConDataCons tc) = unitTy
-       -- External Core programs can have newtypes with no data constructors
-  | otherwise              = go [tc] rhs_ty
-  where
-       -- Invariant: tcs have been seen before
-    go tcs rep_ty 
-       = case splitTyConApp_maybe rep_ty of
-           Just (tc, tys)
-               | tc `elem` tcs -> unitTy       -- Recursive loop
-               | isNewTyCon tc -> 
-                    if isRecursiveTyCon tc then
-                       go (tc:tcs) (substTyWith tvs tys rhs_ty)
-                    else
-                        substTyWith tvs tys rhs_ty
-               where
-                 (tvs, rhs_ty) = newTyConRhs tc
-
-           other -> rep_ty 
-
 ------------------------------------------------------
 buildDataCon :: Name -> Bool
            -> [StrictnessMark] 
@@ -247,7 +210,7 @@ buildDataCon src_name declared_infix arg_stricts field_lbls
                                     stupid_ctxt dc_ids
                dc_ids = mkDataConIds wrap_name work_name data_con
 
-       ; returnM data_con }
+       ; return data_con }
 
 
 -- The stupid context for a data constructor should be limited to
@@ -279,14 +242,17 @@ mkTyConSelIds tycon rhs
 
 ------------------------------------------------------
 \begin{code}
-buildClass :: Name -> [TyVar] -> ThetaType
+buildClass :: Bool                     -- True <=> do not include unfoldings 
+                                       --          on dict selectors
+                                       -- Used when importing a class without -O
+          -> Name -> [TyVar] -> ThetaType
           -> [FunDep TyVar]            -- Functional dependencies
           -> [TyThing]                 -- Associated types
           -> [(Name, DefMeth, Type)]   -- Method info
           -> RecFlag                   -- Info for type constructor
           -> TcRnIf m n Class
 
-buildClass class_name tvs sc_theta fds ats sig_stuff tc_isrec
+buildClass no_unf class_name tvs sc_theta fds ats sig_stuff tc_isrec
   = do { traceIf (text "buildClass")
        ; tycon_name <- newImplicitBinder class_name mkClassTyConOcc
        ; datacon_name <- newImplicitBinder class_name mkClassDataConOcc
@@ -298,7 +264,7 @@ buildClass class_name tvs sc_theta fds ats sig_stuff tc_isrec
 
          let { rec_tycon  = classTyCon rec_clas
              ; op_tys     = [ty | (_,_,ty) <- sig_stuff]
-             ; op_items   = [ (mkDictSelId op_name rec_clas, dm_info)
+             ; op_items   = [ (mkDictSelId no_unf op_name rec_clas, dm_info)
                             | (op_name, dm_info, _) <- sig_stuff ] }
                        -- Build the selector id and default method id
 
@@ -320,7 +286,7 @@ buildClass class_name tvs sc_theta fds ats sig_stuff tc_isrec
              --      D_sc1, D_sc2
              -- (We used to call them D_C, but now we can have two different
              --  superclasses both called C!)
-        ; let sc_sel_ids = [mkDictSelId sc_name rec_clas | sc_name <- sc_sel_names]
+        ; let sc_sel_ids = [mkDictSelId no_unf sc_name rec_clas | sc_name <- sc_sel_names]
 
                -- Use a newtype if the class constructor has exactly one field:
                -- i.e. exactly one operation or superclass taken together