[project @ 2001-07-20 15:22:21 by simonpj]

-----------------------
	Get rid of ArityAtLeast
	-----------------------

Now that we have CgInfo, with the exact code-generator arity
for the value, we don't need the distinction between ArityAtLeast
and ArityExactly in the ArityInfo field of an IdInfo.

This commit makes

	type ArityInfo = Maybe Arity

and propagates this change consistently through the compiler.

diff --git a/ghc/compiler/basicTypes/Id.lhs b/ghc/compiler/basicTypes/Id.lhs
index 34f769d..448ed01 100644 (file)
--- a/ghc/compiler/basicTypes/Id.lhs
+++ b/ghc/compiler/basicTypes/Id.lhs
@@ -307,7 +307,7 @@ idArityInfo id = arityInfo (idInfo id)
 idArity :: Id -> Arity
 idArity id = arityLowerBound (idArityInfo id)
 
-setIdArityInfo :: Id -> ArityInfo -> Id
+setIdArityInfo :: Id -> Arity -> Id
 setIdArityInfo id arity = modifyIdInfo (`setArityInfo` arity) id
 
        ---------------------------------

diff --git a/ghc/compiler/basicTypes/IdInfo.lhs b/ghc/compiler/basicTypes/IdInfo.lhs
index 7e030fd..27919e5 100644 (file)
--- a/ghc/compiler/basicTypes/IdInfo.lhs
+++ b/ghc/compiler/basicTypes/IdInfo.lhs
@@ -20,7 +20,7 @@ module IdInfo (
 
        -- Arity
        ArityInfo(..),
-       exactArity, atLeastArity, unknownArity, hasArity,
+       exactArity, unknownArity, hasArity,
        arityInfo, setArityInfo, ppArityInfo, arityLowerBound,
 
        -- New demand and strictness info
@@ -289,7 +289,7 @@ setUnfoldingInfo  info uf
   = info { unfoldingInfo = uf }
 
 setDemandInfo    info dd = info { demandInfo = dd }
-setArityInfo     info ar = info { arityInfo = ar  }
+setArityInfo     info ar = info { arityInfo = Just ar  }
 setCgInfo         info cg = info { cgInfo = cg }
 setCprInfo        info cp = info { cprInfo = cp }
 setLBVarInfo      info lb = info { lbvarInfo = lb }
@@ -304,7 +304,7 @@ vanillaIdInfo :: IdInfo
 vanillaIdInfo 
   = IdInfo {
            cgInfo              = noCgInfo,
-           arityInfo           = UnknownArity,
+           arityInfo           = unknownArity,
            demandInfo          = wwLazy,
            specInfo            = emptyCoreRules,
             tyGenInfo          = noTyGenInfo,
@@ -338,42 +338,31 @@ of their arities; so it should not be asking...    (but other things
 besides the code-generator need arity info!)
 
 \begin{code}
-data ArityInfo
-  = UnknownArity       -- No idea
+type ArityInfo = Maybe Arity
+       -- A partial application of this Id to up to n-1 value arguments
+       -- does essentially no work.  That is not necessarily the
+       -- same as saying that it has n leading lambdas, because coerces
+       -- may get in the way.
 
-  | ArityExactly Arity -- Arity is exactly this.  We use this when importing a
-                       -- function; it's already been compiled and we know its
-                       -- arity for sure.
-
-  | ArityAtLeast Arity -- A partial application of this Id to up to n-1 value arguments
-                       -- does essentially no work.  That is not necessarily the
-                       -- same as saying that it has n leading lambdas, because coerces
-                       -- may get in the way.
-
-                       -- functions in the module being compiled.  Their arity
-                       -- might increase later in the compilation process, if
-                       -- an extra lambda floats up to the binding site.
-  deriving( Eq )
+       -- The arity might increase later in the compilation process, if
+       -- an extra lambda floats up to the binding site.
 
 seqArity :: ArityInfo -> ()
 seqArity a = arityLowerBound a `seq` ()
 
-exactArity   = ArityExactly
-atLeastArity = ArityAtLeast
-unknownArity = UnknownArity
+exactArity   = Just
+unknownArity = Nothing
 
 arityLowerBound :: ArityInfo -> Arity
-arityLowerBound UnknownArity     = 0
-arityLowerBound (ArityAtLeast n) = n
-arityLowerBound (ArityExactly n) = n
+arityLowerBound Nothing  = 0
+arityLowerBound (Just n) = n
 
 hasArity :: ArityInfo -> Bool
-hasArity UnknownArity = False
-hasArity other       = True
+hasArity Nothing = False
+hasArity other   = True
 
-ppArityInfo UnknownArity        = empty
-ppArityInfo (ArityExactly arity) = hsep [ptext SLIT("ArityExactly"), int arity]
-ppArityInfo (ArityAtLeast arity) = hsep [ptext SLIT("ArityAtLeast"), int arity]
+ppArityInfo Nothing     = empty
+ppArityInfo (Just arity) = hsep [ptext SLIT("Arity"), int arity]
 \end{code}
 
 %************************************************************************

diff --git a/ghc/compiler/basicTypes/MkId.lhs b/ghc/compiler/basicTypes/MkId.lhs
index 27e7e6e..69dec38 100644 (file)
--- a/ghc/compiler/basicTypes/MkId.lhs
+++ b/ghc/compiler/basicTypes/MkId.lhs
@@ -144,7 +144,7 @@ mkDataConId work_name data_con
     id = mkGlobalId (DataConId data_con) work_name (dataConRepType data_con) info
     info = noCafNoTyGenIdInfo
           `setCgArity`         arity
-          `setArityInfo`       exactArity arity
+          `setArityInfo`       arity
           `setCprInfo`         cpr_info
           `setStrictnessInfo`  strict_info
           `setNewStrictnessInfo`       mkNewStrictnessInfo id arity strict_info cpr_info
@@ -224,7 +224,7 @@ mkDataConWrapId data_con
                -- wrapper constructor isn't inlined
           `setCgArity`         arity
                -- The NoCaf-ness is set by noCafNoTyGenIdInfo
-          `setArityInfo`       exactArity arity
+          `setArityInfo`       arity
                -- It's important to specify the arity, so that partial
                -- applications are treated as values
           `setNewStrictnessInfo`       mkNewStrictnessInfo wrap_id arity noStrictnessInfo cpr_info
@@ -414,7 +414,7 @@ mkRecordSelId tycon field_label unpack_id unpackUtf8_id
     arity = 1 + n_dict_tys + n_field_dict_tys
     info = noCafNoTyGenIdInfo
           `setCgInfo`          (CgInfo arity caf_info)
-          `setArityInfo`       exactArity arity
+          `setArityInfo`       arity
           `setUnfoldingInfo`   unfolding       
        -- ToDo: consider adding further IdInfo
 
@@ -553,7 +553,7 @@ mkDictSelId name clas
 
     info      = noCafNoTyGenIdInfo
                `setCgArity`        1
-               `setArityInfo`      exactArity 1
+               `setArityInfo`      1
                `setUnfoldingInfo`  unfolding
                
        -- We no longer use 'must-inline' on record selectors.  They'll
@@ -605,7 +605,7 @@ mkPrimOpId prim_op
     info = noCafNoTyGenIdInfo
           `setSpecInfo`        rules
           `setCgArity`         arity
-          `setArityInfo`       exactArity arity
+          `setArityInfo`       arity
           `setStrictnessInfo`  strict_info
           `setNewStrictnessInfo`       mkNewStrictnessInfo id arity strict_info NoCPRInfo
 
@@ -638,7 +638,7 @@ mkFCallId uniq fcall ty
 
     info = noCafNoTyGenIdInfo
           `setCgArity`         arity
-          `setArityInfo`       exactArity arity
+          `setArityInfo`       arity
           `setStrictnessInfo`  strict_info
           `setNewStrictnessInfo`       mkNewStrictnessInfo id arity strict_info NoCPRInfo
 

diff --git a/ghc/compiler/simplCore/Simplify.lhs b/ghc/compiler/simplCore/Simplify.lhs
index 638efec..9058d0a 100644 (file)
--- a/ghc/compiler/simplCore/Simplify.lhs
+++ b/ghc/compiler/simplCore/Simplify.lhs
@@ -31,7 +31,7 @@ import Id             ( Id, idType, idInfo, isDataConId, hasNoBinding,
                        )
 import IdInfo          ( OccInfo(..), isDeadOcc, isLoopBreaker,
                          setArityInfo, 
-                         setUnfoldingInfo, atLeastArity,
+                         setUnfoldingInfo, 
                          occInfo
                        )
 import Demand          ( isStrict )
@@ -633,7 +633,7 @@ completeBinding old_bndr new_bndr top_lvl black_listed new_rhs thing_inside
                -- We make new IdInfo for the new binder by starting from the old binder, 
                -- doing appropriate substitutions.
                -- Then we add arity and unfolding info to get the new binder
-       new_bndr_info = idInfo new_bndr `setArityInfo` arity_info
+       new_bndr_info = idInfo new_bndr `setArityInfo` arity
 
                -- Add the unfolding *only* for non-loop-breakers
                -- Making loop breakers not have an unfolding at all 
@@ -657,7 +657,7 @@ completeBinding old_bndr new_bndr top_lvl black_listed new_rhs thing_inside
     loop_breaker      = isLoopBreaker occ_info
     trivial_rhs              = exprIsTrivial new_rhs
     must_keep_binding = black_listed || loop_breaker || isExportedId old_bndr
-    arity_info       = atLeastArity (exprArity new_rhs)
+    arity            = exprArity new_rhs
 \end{code}    
 
 

diff --git a/ghc/compiler/typecheck/TcIfaceSig.lhs b/ghc/compiler/typecheck/TcIfaceSig.lhs
index ad444e5..8b255e4 100644 (file)
--- a/ghc/compiler/typecheck/TcIfaceSig.lhs
+++ b/ghc/compiler/typecheck/TcIfaceSig.lhs
@@ -90,7 +90,7 @@ tcIdInfo unf_env in_scope_vars name ty info_ins
     tcPrag info HsCprInfo       = returnTc (info `setCprInfo`   ReturnsCPR)
 
     tcPrag info (HsArity arity) = 
-       returnTc (info `setArityInfo` (ArityExactly arity)
+       returnTc (info `setArityInfo` arity
                       `setCgArity`   arity)
 
     tcPrag info (HsUnfold inline_prag expr)