Fix Trac #3966: warn about useless UNPACK pragmas

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

diff --git a/compiler/iface/BuildTyCl.lhs b/compiler/iface/BuildTyCl.lhs
index 9213afd..738a5e3 100644 (file)
--- a/compiler/iface/BuildTyCl.lhs
+++ b/compiler/iface/BuildTyCl.lhs
@@ -20,7 +20,6 @@ import Var
 import VarSet
 import BasicTypes
 import Name
-import OccName
 import MkId
 import Class
 import TyCon
@@ -30,8 +29,6 @@ import Coercion
 import TcRnMonad
 import Util            ( count )
 import Outputable
-
-import Data.List
 \end{code}
        
 
@@ -121,7 +118,18 @@ mkOpenDataTyConRhs = OpenTyCon Nothing
 
 mkDataTyConRhs :: [DataCon] -> AlgTyConRhs
 mkDataTyConRhs cons
-  = DataTyCon { data_cons = cons, is_enum = all isNullarySrcDataCon cons }
+  = DataTyCon {
+        data_cons = cons,
+        is_enum = -- We define datatypes with no constructors to not be
+                  -- enumerations; this fixes trac #2578,  Otherwise we
+                  -- end up generating an empty table for
+                  --   <mod>_<type>_closure_tbl
+                  -- which is used by tagToEnum# to map Int# to constructors
+                  -- in an enumeration. The empty table apparently upset
+                  -- the linker.
+                  not (null cons) &&
+                  all isNullarySrcDataCon cons
+    }
 
 mkNewTyConRhs :: Name -> TyCon -> DataCon -> TcRnIf m n AlgTyConRhs
 -- Monadic because it makes a Name for the coercion TyCon
@@ -183,7 +191,7 @@ setAssocFamilyPermutation _clas_tvs other
 
 ------------------------------------------------------
 buildDataCon :: Name -> Bool
-           -> [StrictnessMark] 
+           -> [HsBang] 
            -> [Name]                   -- Field labels
            -> [TyVar] -> [TyVar]       -- Univ and ext 
             -> [(TyVar,Type)]           -- Equality spec
@@ -298,7 +306,7 @@ buildClass no_unf class_name tvs sc_theta fds ats sig_stuff tc_isrec
 
        ; dict_con <- buildDataCon datacon_name
                                   False        -- Not declared infix
-                                  (map (const NotMarkedStrict) args)
+                                  (map (const HsNoBang) args)
                                   [{- No fields -}]
                                   tvs [{- no existentials -}]
                                    [{- No GADT equalities -}] [{- No theta -}]