[project @ 2001-10-30 19:02:26 by rrt]

[ghc-hetmet.git] / ghc / compiler / hsSyn / HsCore.lhs

diff --git a/ghc/compiler/hsSyn/HsCore.lhs b/ghc/compiler/hsSyn/HsCore.lhs
index 83dbd8b..7843943 100644 (file)
--- a/ghc/compiler/hsSyn/HsCore.lhs
+++ b/ghc/compiler/hsSyn/HsCore.lhs
@@ -33,13 +33,13 @@ import HsTypes              ( HsType, pprParendHsType, pprHsTyVarBndr, toHsType,
 -- others:
 import Id              ( idArity, idType, isDataConId_maybe, isFCallId_maybe )
 import Var             ( varType, isId )
-import IdInfo          ( InlinePragInfo, pprInlinePragInfo, ppStrictnessInfo )
+import IdInfo          ( InlinePragInfo )
 import Name            ( Name, NamedThing(..), getName, toRdrName )
 import RdrName         ( RdrName, rdrNameOcc )
 import OccName         ( isTvOcc )
 import CoreSyn
 import CostCentre      ( pprCostCentreCore )
-import Demand          ( StrictnessInfo )
+import NewDemand       ( StrictSig, pprIfaceStrictSig )
 import Literal         ( Literal, maybeLitLit )
 import ForeignCall     ( ForeignCall )
 import DataCon         ( dataConTyCon, dataConSourceArity )
@@ -48,7 +48,7 @@ import Type           ( Kind, eqKind )
 import BasicTypes      ( Arity )
 import FiniteMap       ( lookupFM )
 import CostCentre
-import Util            ( eqListBy )
+import Util            ( eqListBy, lengthIs )
 import Outputable
 \end{code}
 
@@ -159,7 +159,7 @@ toUfApp (Var v) as
                -> UfTuple (mk_hs_tup_con tc dc) tup_args
          where
            val_args  = dropWhile isTypeArg as
-           saturated = length val_args == idArity v
+           saturated = val_args `lengthIs` idArity v
            tup_args  = map toUfExpr val_args
            tc        = dataConTyCon dc
        ;
@@ -379,21 +379,19 @@ pprHsIdInfo info = ptext SLIT("{-##") <+> hsep (map ppr_hs_info info) <+> ptext
 
 data HsIdInfo name
   = HsArity            Arity
-  | HsStrictness       StrictnessInfo
+  | HsStrictness       StrictSig
   | HsUnfold           InlinePragInfo (UfExpr name)
   | HsNoCafRefs
-  | HsCprInfo
   | HsWorker           name Arity      -- Worker, if any see IdInfo.WorkerInfo
                                        -- for why we want arity here.
   deriving( Eq )
 -- NB: Specialisations and rules come in separately and are
 -- only later attached to the Id.  Partial reason: some are orphans.
 
-ppr_hs_info (HsUnfold prag unf) = ptext SLIT("__U") <> pprInlinePragInfo prag <+> parens (pprUfExpr noParens unf)
+ppr_hs_info (HsUnfold prag unf) = ptext SLIT("__U") <> ppr prag <+> parens (pprUfExpr noParens unf)
 ppr_hs_info (HsArity arity)     = ptext SLIT("__A") <+> int arity
-ppr_hs_info (HsStrictness str)  = ptext SLIT("__S") <+> ppStrictnessInfo str
+ppr_hs_info (HsStrictness str)  = ptext SLIT("__S") <+> pprIfaceStrictSig str
 ppr_hs_info HsNoCafRefs                = ptext SLIT("__C")
-ppr_hs_info HsCprInfo          = ptext SLIT("__M")
 ppr_hs_info (HsWorker w a)     = ptext SLIT("__P") <+> ppr w <+> int a
 \end{code}