[project @ 2001-10-25 02:13:10 by sof]

[ghc-hetmet.git] / ghc / compiler / specialise / SpecConstr.lhs

diff --git a/ghc/compiler/specialise/SpecConstr.lhs b/ghc/compiler/specialise/SpecConstr.lhs
index 7f2246a..824b1e5 100644 (file)
--- a/ghc/compiler/specialise/SpecConstr.lhs
+++ b/ghc/compiler/specialise/SpecConstr.lhs
@@ -16,7 +16,7 @@ import CoreUtils      ( exprType, eqExpr )
 import CoreFVs                 ( exprsFreeVars )
 import DataCon         ( dataConRepArity )
 import Type            ( tyConAppArgs )
-import PprCore         ( pprCoreRules, pprCoreRule )
+import PprCore         ( pprCoreRules )
 import Id              ( Id, idName, idType, idSpecialisation,
                          isDataConId_maybe,
                          mkUserLocal, mkSysLocal )
@@ -28,14 +28,14 @@ import Rules                ( addIdSpecialisations )
 import OccName         ( mkSpecOcc )
 import ErrUtils                ( dumpIfSet_dyn )
 import CmdLineOpts     ( DynFlags, DynFlag(..) )
+import BasicTypes      ( Activation(..) )
 import Outputable
 
 import Maybes          ( orElse )
-import Util            ( mapAccumL )
+import Util            ( mapAccumL, lengthAtLeast )
 import List            ( nubBy, partition )
 import UniqSupply
 import Outputable
-import UniqFM          ( ufmToList )
 \end{code}
 
 -----------------------------------------------------
@@ -432,7 +432,7 @@ specialise env fn bndrs body (SCU {calls=calls, occs=occs})
        good_calls :: [[CoreArg]]
        good_calls = [ pats
                     | (con_env, call_args) <- all_calls,
-                      length call_args >= n_bndrs,         -- App is saturated
+                      call_args `lengthAtLeast` n_bndrs,           -- App is saturated
                       let call = (bndrs `zip` call_args),
                       any (good_arg con_env occs) call,    -- At least one arg is a constr app
                       let (_, pats) = argsToPats con_env us call_args
@@ -506,7 +506,7 @@ spec_one env fn rhs (pats, n)
        rule_name = _PK_ ("SC:" ++ showSDoc (ppr fn <> int n))
        spec_rhs  = mkLams bndrs (mkApps rhs pats)
        spec_id   = mkUserLocal spec_occ spec_uniq (exprType spec_rhs) fn_loc
-       rule      = Rule rule_name bndrs pats (mkVarApps (Var spec_id) bndrs)
+       rule      = Rule rule_name AlwaysActive bndrs pats (mkVarApps (Var spec_id) bndrs)
     in
     returnUs (rule, (spec_id, spec_rhs))
 \end{code}
@@ -565,7 +565,7 @@ is_con_app_maybe env (Lit lit)
 is_con_app_maybe env expr
   = case collectArgs expr of
        (Var fun, args) | Just con <- isDataConId_maybe fun,
-                         length args >= dataConRepArity con
+                         args `lengthAtLeast` dataConRepArity con
                -- Might be > because the arity excludes type args
                        -> Just (DataAlt con,args)