[project @ 2002-04-05 23:24:25 by sof]

Friday afternoon pet peeve removal: define (Util.notNull :: [a] -> Bool) and use it

33 files changed, 90 insertions, 76 deletions

diff --git a/ghc/compiler/basicTypes/DataCon.lhs b/ghc/compiler/basicTypes/DataCon.lhs
index 73e4845959..175427ac83 100644
--- a/ghc/compiler/basicTypes/DataCon.lhs
+++ b/ghc/compiler/basicTypes/DataCon.lhs
@@ -42,7 +42,7 @@ import Unique		( Unique, Uniquable(..) )
 import CmdLineOpts	( opt_UnboxStrictFields )
 import Maybe
 import ListSetOps	( assoc )
-import Util		( zipEqual, zipWithEqual, equalLength )
+import Util		( zipEqual, zipWithEqual, equalLength, notNull )
 \end{code}
 
 
@@ -417,7 +417,7 @@ isUnboxedTupleCon :: DataCon -> Bool
 isUnboxedTupleCon (MkData {dcTyCon = tc}) = isUnboxedTupleTyCon tc
 
 isExistentialDataCon :: DataCon -> Bool
-isExistentialDataCon (MkData {dcExTyVars = tvs}) = not (null tvs)
+isExistentialDataCon (MkData {dcExTyVars = tvs}) = notNull tvs
 \end{code}
 
 
diff --git a/ghc/compiler/codeGen/CgCon.lhs b/ghc/compiler/codeGen/CgCon.lhs
index b07e524841..3d732636d3 100644
--- a/ghc/compiler/codeGen/CgCon.lhs
+++ b/ghc/compiler/codeGen/CgCon.lhs
@@ -257,7 +257,7 @@ bindUnboxedTupleComponents args
 
     bindArgsToRegs reg_args arg_regs 		`thenC`
     mapCs bindNewToStack stk_offsets 		`thenC`
-    returnFC (arg_regs,tags, not (null stk_offsets))
+    returnFC (arg_regs,tags, notNull stk_offsets)
 \end{code}
 
 %************************************************************************
diff --git a/ghc/compiler/compMan/CompManager.lhs b/ghc/compiler/compMan/CompManager.lhs
index 1e5fdd69e2..b3f6baf974 100644
--- a/ghc/compiler/compMan/CompManager.lhs
+++ b/ghc/compiler/compMan/CompManager.lhs
@@ -933,7 +933,7 @@ findPartiallyCompletedCycles modsDone theGraph
                                    done `elem` names_in_this_cycle])
                  chewed_rest = chew rest
              in 
-             if   not (null mods_in_this_cycle) 
+             if   notNull mods_in_this_cycle
                   && length mods_in_this_cycle < length names_in_this_cycle
              then mods_in_this_cycle ++ chewed_rest
              else chewed_rest
diff --git a/ghc/compiler/coreSyn/CoreLint.lhs b/ghc/compiler/coreSyn/CoreLint.lhs
index 433d3438a2..768cead775 100644
--- a/ghc/compiler/coreSyn/CoreLint.lhs
+++ b/ghc/compiler/coreSyn/CoreLint.lhs
@@ -539,7 +539,7 @@ addErrL msg loc scope errs warns = (Nothing, addErr errs msg loc, warns)
 addErr :: Bag ErrMsg -> Message -> [LintLocInfo] -> Bag ErrMsg
 -- errors or warnings, actually... they're the same type.
 addErr errs_so_far msg locs
-  = ASSERT( not (null locs) )
+  = ASSERT( notNull locs )
     errs_so_far `snocBag` mk_msg msg
   where
    (loc, cxt1) = dumpLoc (head locs)
diff --git a/ghc/compiler/coreSyn/CoreUnfold.lhs b/ghc/compiler/coreSyn/CoreUnfold.lhs
index 195ac4852f..a357f12e58 100644
--- a/ghc/compiler/coreSyn/CoreUnfold.lhs
+++ b/ghc/compiler/coreSyn/CoreUnfold.lhs
@@ -56,6 +56,7 @@ import PrelNames	( hasKey, buildIdKey, augmentIdKey )
 import Bag
 import FastTypes
 import Outputable
+import Util
 
 #if __GLASGOW_HASKELL__ >= 404
 import GlaExts		( Int# )
@@ -591,7 +592,7 @@ callSiteInline dflags active_inline inline_call occ id arg_infos interesting_con
 			-- If (not in_lam) && one_br then PreInlineUnconditionally
 			-- should have caught it, shouldn't it?  Unless it's a top
 			-- level thing.
-	    not (null arg_infos) || interesting_cont
+	    notNull arg_infos || interesting_cont
 
 	  | otherwise
 	  = case guidance of
diff --git a/ghc/compiler/deSugar/Check.lhs b/ghc/compiler/deSugar/Check.lhs
index 4f134eb1eb..23a818d97d 100644
--- a/ghc/compiler/deSugar/Check.lhs
+++ b/ghc/compiler/deSugar/Check.lhs
@@ -28,7 +28,7 @@ import TyCon            ( tyConDataCons, tupleTyConBoxity, isTupleTyCon )
 import BasicTypes	( Boxity(..) )
 import SrcLoc		( noSrcLoc )
 import UniqSet
-import Util             ( takeList, splitAtList )
+import Util             ( takeList, splitAtList, notNull )
 import Outputable
 
 #include "HsVersions.h"
@@ -287,8 +287,8 @@ same constructor.
 split_by_constructor :: [EquationInfo] -> ([ExhaustivePat],EqnSet)
 
 split_by_constructor qs 
-  | not (null unused_cons) = need_default_case used_cons unused_cons qs 
-  | otherwise              = no_need_default_case used_cons qs 
+  | notNull unused_cons = need_default_case used_cons unused_cons qs 
+  | otherwise           = no_need_default_case used_cons qs 
                        where 
                           used_cons   = get_used_cons qs 
                           unused_cons = get_unused_cons used_cons 
diff --git a/ghc/compiler/deSugar/DsUtils.lhs b/ghc/compiler/deSugar/DsUtils.lhs
index bad4e9288e..b1e950e97c 100644
--- a/ghc/compiler/deSugar/DsUtils.lhs
+++ b/ghc/compiler/deSugar/DsUtils.lhs
@@ -63,7 +63,7 @@ import PrelNames	( unpackCStringName, unpackCStringUtf8Name,
 			  lengthPName, indexPName )
 import Outputable
 import UnicodeUtil      ( stringToUtf8 )
-import Util             ( isSingleton )
+import Util             ( isSingleton, notNull )
 \end{code}
 
 
@@ -581,7 +581,7 @@ mkTupleSelector [var] should_be_the_same_var scrut_var scrut
     scrut
 
 mkTupleSelector vars the_var scrut_var scrut
-  = ASSERT( not (null vars) )
+  = ASSERT( notNull vars )
     Case scrut scrut_var [(DataAlt (tupleCon Boxed (length vars)), vars, Var the_var)]
 \end{code}
 
diff --git a/ghc/compiler/deSugar/Match.lhs b/ghc/compiler/deSugar/Match.lhs
index 1f9fcdadf2..73134d813c 100644
--- a/ghc/compiler/deSugar/Match.lhs
+++ b/ghc/compiler/deSugar/Match.lhs
@@ -29,7 +29,7 @@ import TysWiredIn	( nilDataCon, consDataCon, mkTupleTy, mkListTy,
 import BasicTypes	( Boxity(..) )
 import UniqSet
 import ErrUtils		( addWarnLocHdrLine, dontAddErrLoc )
-import Util             ( lengthExceeds )
+import Util             ( lengthExceeds, notNull )
 import Outputable
 \end{code}
 
@@ -65,7 +65,7 @@ matchExport_really dflags vars qs@((EqnInfo _ ctx _ (MatchResult _ _)) : _)
       match vars qs
   where (pats,indexs) = check qs
         incomplete    = dopt Opt_WarnIncompletePatterns dflags
-			&& (not (null pats))
+			&& (notNull pats)
         shadow        = dopt Opt_WarnOverlappingPatterns dflags
 			&& sizeUniqSet indexs < no_eqns
         no_eqns       = length qs
diff --git a/ghc/compiler/ghci/ByteCodeGen.lhs b/ghc/compiler/ghci/ByteCodeGen.lhs
index 8b0a8a59f1..eeb1580ae6 100644
--- a/ghc/compiler/ghci/ByteCodeGen.lhs
+++ b/ghc/compiler/ghci/ByteCodeGen.lhs
@@ -34,7 +34,7 @@ import TyCon		( TyCon(..), tyConFamilySize, isDataTyCon, tyConDataCons,
 import Class		( Class, classTyCon )
 import Type		( Type, repType, splitFunTys, dropForAlls )
 import Util		( zipEqual, zipWith4Equal, naturalMergeSortLe, nOfThem,
-			  isSingleton, lengthIs )
+			  isSingleton, lengthIs, notNull )
 import DataCon		( dataConRepArity )
 import Var		( isTyVar )
 import VarSet		( VarSet, varSetElems )
@@ -94,7 +94,7 @@ byteCodeGen dflags binds local_tycons local_classes
 			--               ^^
 			-- better be no free vars in these top-level bindings
 
-        when (not (null mallocd))
+        when (notNull mallocd)
              (panic "ByteCodeGen.byteCodeGen: missing final emitBc?")
 
         dumpIfSet_dyn dflags Opt_D_dump_BCOs
@@ -127,7 +127,7 @@ coreExprToBCOs dflags expr
          <- runBc (BcM_State [] 0 []) 
                   (schemeR True fvs (invented_id, annexpr))
 
-      when (not (null mallocd))
+      when (notNull mallocd)
            (panic "ByteCodeGen.coreExprToBCOs: missing final emitBc?")
 
       dumpIfSet_dyn dflags Opt_D_dump_BCOs
@@ -1015,7 +1015,7 @@ atomRep other = pprPanic "atomRep" (ppr (deAnnotate (undefined,other)))
 -- as a consequence.
 implement_tagToId :: [Name] -> BcM BCInstrList
 implement_tagToId names
-   = ASSERT(not (null names))
+   = ASSERT( notNull names )
      getLabelsBc (length names)			`thenBc` \ labels ->
      getLabelBc					`thenBc` \ label_fail ->
      getLabelBc 				`thenBc` \ label_exit ->
@@ -1450,7 +1450,7 @@ emitBc bco st
 
 newbcoBc :: BcM ()
 newbcoBc st
-   | not (null (malloced st)) 
+   | notNull (malloced st)
    = panic "ByteCodeGen.newbcoBc: missed prior emitBc?"
    | otherwise
    = return (st, ())
diff --git a/ghc/compiler/ghci/ByteCodeLink.lhs b/ghc/compiler/ghci/ByteCodeLink.lhs
index ff7557dc00..aa20cc033b 100644
--- a/ghc/compiler/ghci/ByteCodeLink.lhs
+++ b/ghc/compiler/ghci/ByteCodeLink.lhs
@@ -33,6 +33,7 @@ import ByteCodeInstr	( BCInstr(..), ProtoBCO(..) )
 import ByteCodeItbls	( ItblEnv, ItblPtr )
 import FiniteMap
 import Panic            ( GhcException(..) )
+import Util             ( notNull )
 
 import Control.Monad	( when, foldM )
 import Control.Monad.ST	( runST )
@@ -206,7 +207,7 @@ assembleBCO (ProtoBCO nm instrs origin malloced)
          -- 8 Aug 01: Finalisers aren't safe when attached to non-primitive
          -- objects, since they might get run too early.  Disable this until
          -- we figure out what to do.
-         -- when (not (null malloced)) (addFinalizer ul_bco (mapM_ zonk malloced))
+         -- when (notNull malloced) (addFinalizer ul_bco (mapM_ zonk malloced))
 
          return ul_bco
      where
diff --git a/ghc/compiler/ghci/InteractiveUI.hs b/ghc/compiler/ghci/InteractiveUI.hs
index 99f98dcfd8..8f69c0606e 100644
--- a/ghc/compiler/ghci/InteractiveUI.hs
+++ b/ghc/compiler/ghci/InteractiveUI.hs
@@ -1,6 +1,6 @@
 {-# OPTIONS -#include "Linker.h" -#include "SchedAPI.h" #-}
 -----------------------------------------------------------------------------
--- $Id: InteractiveUI.hs,v 1.117 2002/04/02 10:18:07 simonmar Exp $
+-- $Id: InteractiveUI.hs,v 1.118 2002/04/05 23:24:28 sof Exp $
 --
 -- GHC Interactive User Interface
 --
@@ -234,7 +234,7 @@ runGHCi paths dflags = do
   		  Right hdl -> fileLoop hdl False
 
   -- perform a :load for files given on the GHCi command line
-  when (not (null paths)) $
+  when (notNull paths) $
      ghciHandle showException $
 	loadModule (unwords paths)
 
@@ -810,7 +810,7 @@ setOptions wds =
         leftovers <- processArgs dynamic_flags leftovers []
 	saveDynFlags
 
-        if (not (null leftovers))
+        if (notNull leftovers)
 		then throwDyn (CmdLineError ("unrecognised flags: " ++ 
 						unwords leftovers))
 		else return ()
@@ -823,14 +823,14 @@ unsetOptions str
 	   (minus_opts, rest1) = partition isMinus opts
 	   (plus_opts, rest2)  = partition isPlus rest1
 
-       if (not (null rest2)) 
+       if (notNull rest2) 
 	  then io (putStrLn ("unknown option: `" ++ head rest2 ++ "'"))
 	  else do
 
        mapM unsetOpt plus_opts
  
        -- can't do GHC flags for now
-       if (not (null minus_opts))
+       if (notNull minus_opts)
 	  then throwDyn (CmdLineError "can't unset GHC command-line flags")
 	  else return ()
 
diff --git a/ghc/compiler/javaGen/JavaGen.lhs b/ghc/compiler/javaGen/JavaGen.lhs
index e46a1c64e7..ae6d19a4ca 100644
--- a/ghc/compiler/javaGen/JavaGen.lhs
+++ b/ghc/compiler/javaGen/JavaGen.lhs
@@ -66,7 +66,7 @@ import Outputable
 
 import Maybe
 import PrimOp
-import Util     ( lengthIs )
+import Util     ( lengthIs, notNull )
 
 #include "HsVersions.h"
 
@@ -267,7 +267,7 @@ javaCase :: (Expr -> Statement) -> CoreExpr -> Id -> [CoreAlt] -> [Statement]
 -- If we've got the wrong one, this is _|_, and the
 -- casting will catch this with an exception.
 
-javaCase r e x [(DataAlt d,bs,rhs)] | not (null bs)
+javaCase r e x [(DataAlt d,bs,rhs)] | notNull bs
   = java_expr PushExpr e ++
     [ var [Final] (javaName x)
 	          (whnf primRep (vmPOP (primRepToType primRep))) ] ++
diff --git a/ghc/compiler/main/DriverFlags.hs b/ghc/compiler/main/DriverFlags.hs
index 713b287e89..6a6a744c2e 100644
--- a/ghc/compiler/main/DriverFlags.hs
+++ b/ghc/compiler/main/DriverFlags.hs
@@ -1,7 +1,7 @@
 {-# OPTIONS -#include "hschooks.h" #-}
 
 -----------------------------------------------------------------------------
--- $Id: DriverFlags.hs,v 1.90 2002/03/29 21:39:37 sof Exp $
+-- $Id: DriverFlags.hs,v 1.91 2002/04/05 23:24:29 sof Exp $
 --
 -- Driver flags
 --
@@ -138,8 +138,8 @@ findArg spec arg
 arg_ok (NoArg _)            rest arg = null rest
 arg_ok (HasArg _)           rest arg = True
 arg_ok (SepArg _)           rest arg = null rest
-arg_ok (Prefix _)	    rest arg = not (null rest)
-arg_ok (PrefixPred p _)     rest arg = not (null rest) && p rest
+arg_ok (Prefix _)	    rest arg = notNull rest
+arg_ok (PrefixPred p _)     rest arg = notNull rest && p rest
 arg_ok (OptPrefix _)	    rest arg = True
 arg_ok (PassFlag _)         rest arg = null rest 
 arg_ok (AnySuffix _)        rest arg = True
diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs
index 7dd690aee3..b979232ae2 100644
--- a/ghc/compiler/main/DriverPipeline.hs
+++ b/ghc/compiler/main/DriverPipeline.hs
@@ -862,7 +862,7 @@ mk_pvm_wrapper_script pvm_executable pvm_executable_base sysMan = unlines $
 -- Complain about non-dynamic flags in OPTIONS pragmas
 
 checkProcessArgsResult flags basename suff
-  = do when (not (null flags)) (throwDyn (ProgramError (
+  = do when (notNull flags) (throwDyn (ProgramError (
            basename ++ "." ++ suff 
            ++ ": static flags are not allowed in {-# OPTIONS #-} pragmas:\n\t" 
            ++ unwords flags)) (ExitFailure 1))
diff --git a/ghc/compiler/main/DriverState.hs b/ghc/compiler/main/DriverState.hs
index b8684fea51..cd4f1fbed3 100644
--- a/ghc/compiler/main/DriverState.hs
+++ b/ghc/compiler/main/DriverState.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: DriverState.hs,v 1.75 2002/04/05 16:43:56 sof Exp $
+-- $Id: DriverState.hs,v 1.76 2002/04/05 23:24:29 sof Exp $
 --
 -- Settings for the driver
 --
@@ -54,7 +54,7 @@ setMode :: GhcMode -> String -> IO ()
 setMode m flag = do
   old_mode <- readIORef v_GhcMode
   old_flag <- readIORef v_GhcModeFlag
-  when (not (null (old_flag))) $
+  when (notNull (old_flag)) $
       throwDyn (UsageError 
           ("cannot use `" ++ old_flag ++ "' with `" ++ flag ++ "'"))
   writeIORef v_GhcMode m
@@ -389,7 +389,7 @@ addToDirList :: IORef [String] -> String -> IO ()
 addToDirList ref path
   = do paths           <- readIORef ref
        shiny_new_ones  <- splitUp path
-       writeIORef ref (paths ++ filter (not.null) shiny_new_ones)
+       writeIORef ref (paths ++ filter notNull shiny_new_ones)
 		-- empty paths are ignored: there might be a trailing
 		-- ':' in the initial list, for example.  Empty paths can
 		-- cause confusion when they are translated into -I options
@@ -488,23 +488,23 @@ addPackage package
 getPackageImportPath   :: IO [String]
 getPackageImportPath = do
   ps <- getPackageInfo
-  return (nub (filter (not.null) (concatMap import_dirs ps)))
+  return (nub (filter notNull (concatMap import_dirs ps)))
 
 getPackageIncludePath   :: IO [String]
 getPackageIncludePath = do
   ps <- getPackageInfo
-  return (nub (filter (not.null) (concatMap include_dirs ps)))
+  return (nub (filter notNull (concatMap include_dirs ps)))
 
 	-- includes are in reverse dependency order (i.e. rts first)
 getPackageCIncludes   :: IO [String]
 getPackageCIncludes = do
   ps <- getPackageInfo
-  return (reverse (nub (filter (not.null) (concatMap c_includes ps))))
+  return (reverse (nub (filter notNull (concatMap c_includes ps))))
 
 getPackageLibraryPath  :: IO [String]
 getPackageLibraryPath = do
   ps <- getPackageInfo
-  return (nub (filter (not.null) (concatMap library_dirs ps)))
+  return (nub (filter notNull (concatMap library_dirs ps)))
 
 getPackageLibraries    :: IO [String]
 getPackageLibraries = do
diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs
index 5d463a6d8c..03ab8a596e 100644
--- a/ghc/compiler/main/Main.hs
+++ b/ghc/compiler/main/Main.hs
@@ -1,7 +1,7 @@
 {-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-}
 
 -----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.103 2002/04/05 16:43:56 sof Exp $
+-- $Id: Main.hs,v 1.104 2002/04/05 23:24:29 sof Exp $
 --
 -- GHC Driver program
 --
@@ -165,7 +165,7 @@ main =
       do putStr "warning: -O conflicts with --interactive; -O turned off.\n"
          writeIORef v_OptLevel 0
    orig_ways <- readIORef v_Ways
-   when (not (null orig_ways) && mode == DoInteractive) $
+   when (notNull orig_ways && mode == DoInteractive) $
       do throwDyn (UsageError 
                    "--interactive can't be used with -prof, -ticky, -unreg or -smp.")
 
@@ -338,7 +338,7 @@ checkOptions :: [String] -> IO ()
 checkOptions srcs = do
      -- complain about any unknown flags
    let unknown_opts = [ f | f@('-':_) <- srcs ]
-   when (not (null unknown_opts)) (unknownFlagsErr unknown_opts)
+   when (notNull unknown_opts) (unknownFlagsErr unknown_opts)
      -- verify that output files point somewhere sensible.
    verifyOutputFiles
      -- and anything else that it might be worth checking for
diff --git a/ghc/compiler/main/SysTools.lhs b/ghc/compiler/main/SysTools.lhs
index f5af8c31d1..a108c9e106 100644
--- a/ghc/compiler/main/SysTools.lhs
+++ b/ghc/compiler/main/SysTools.lhs
@@ -65,7 +65,7 @@ import DriverUtil
 import Config
 import Outputable
 import Panic		( progName, GhcException(..) )
-import Util		( global, dropList )
+import Util		( global, dropList, notNull )
 import CmdLineOpts	( dynFlag, verbosity )
 
 import Exception	( throwDyn )
@@ -475,7 +475,7 @@ findTopDir minusbs
        }
   where
     -- get_proto returns a Unix-format path (relying on getExecDir to do so too)
-    get_proto | not (null minusbs)
+    get_proto | notNull minusbs
 	      = return (unDosifyPath (drop 2 (last minusbs)))	-- 2 for "-B"
 	      | otherwise	   
 	      = do { maybe_exec_dir <- getExecDir -- Get directory of executable
diff --git a/ghc/compiler/nativeGen/StixPrim.lhs b/ghc/compiler/nativeGen/StixPrim.lhs
index e186c398c1..0610bedcc5 100644
--- a/ghc/compiler/nativeGen/StixPrim.lhs
+++ b/ghc/compiler/nativeGen/StixPrim.lhs
@@ -28,6 +28,7 @@ import CLabel		( mkIntlikeClosureLabel, mkCharlikeClosureLabel,
 import ForeignCall	( ForeignCall(..), CCallSpec(..), CCallTarget(..),
 			  CCallConv(..), playSafe, playThreadSafe )
 import Outputable
+import Util             ( notNull )
 import FastTypes
 
 #include "NCG.h"
@@ -93,7 +94,7 @@ foreignCallCode lhs call@(CCall (CCallSpec ctarget cconv safety)) rhs
     (cargs, stix_target)
         = case ctarget of
              StaticTarget nm -> (rhs, Left nm)
-             DynamicTarget |  not (null rhs) -- an assertion
+             DynamicTarget |  notNull rhs -- an assertion
                            -> (tail rhs, Right (amodeToStix (head rhs)))
              CasmTarget _
                 -> ncgPrimopMoan "Native code generator can't handle foreign call" 
diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs
index 24fe3d9333..1eefbc3925 100644
--- a/ghc/compiler/rename/RnNames.lhs
+++ b/ghc/compiler/rename/RnNames.lhs
@@ -40,7 +40,7 @@ import NameSet		( elemNameSet, emptyNameSet )
 import Outputable
 import Maybes		( maybeToBool, catMaybes )
 import ListSetOps	( removeDups )
-import Util		( sortLt )
+import Util		( sortLt, notNull )
 import List		( partition )
 \end{code}
 
@@ -113,7 +113,7 @@ getGlobalNames this_mod (HsModule _ _ _ imports decls _ mod_loc)
 				  mod_loc]
     
     explicit_prelude_import
-      = not (null [ () | (ImportDecl mod _ _ _ _ _) <- imports, mod == pRELUDE_Name ])
+      = notNull [ () | (ImportDecl mod _ _ _ _ _) <- imports, mod == pRELUDE_Name ]
 \end{code}
 	
 \begin{code}
diff --git a/ghc/compiler/simplCore/FloatOut.lhs b/ghc/compiler/simplCore/FloatOut.lhs
index 5e8282e0dc..bb3a5deab2 100644
--- a/ghc/compiler/simplCore/FloatOut.lhs
+++ b/ghc/compiler/simplCore/FloatOut.lhs
@@ -22,6 +22,7 @@ import SetLevels	( setLevels, Level(..), ltMajLvl, ltLvl, isTopLvl )
 import UniqSupply       ( UniqSupply )
 import List		( partition )
 import Outputable
+import Util             ( notNull )
 \end{code}
 
 	-----------------
@@ -150,7 +151,7 @@ floatTopBind bind@(NonRec _ _)
 
 floatTopBind bind@(Rec _)
   = case (floatBind bind) of { (fs, floats, Rec pairs') ->
-    WARN( not (null floats), ppr bind $$ ppr floats )
+    WARN( notNull floats, ppr bind $$ ppr floats )
     (fs, [Rec (floatsToBindPairs floats ++ pairs')]) }
 \end{code}
 
diff --git a/ghc/compiler/simplCore/LiberateCase.lhs b/ghc/compiler/simplCore/LiberateCase.lhs
index a5f62f6cb8..466dfad4ce 100644
--- a/ghc/compiler/simplCore/LiberateCase.lhs
+++ b/ghc/compiler/simplCore/LiberateCase.lhs
@@ -15,6 +15,7 @@ import CoreUnfold	( couldBeSmallEnoughToInline )
 import Var		( Id )
 import VarEnv
 import Outputable
+import Util             ( notNull )
 \end{code}
 
 This module walks over @Core@, and looks for @case@ on free variables.
@@ -236,7 +237,7 @@ Ids
 libCaseId :: LibCaseEnv -> Id -> CoreExpr
 libCaseId env v
   | Just the_bind <- lookupRecId env v	-- It's a use of a recursive thing
-  , not (null free_scruts)		-- with free vars scrutinised in RHS
+  , notNull free_scruts 		-- with free vars scrutinised in RHS
   = Let the_bind (Var v)
 
   | otherwise
diff --git a/ghc/compiler/simplCore/Simplify.lhs b/ghc/compiler/simplCore/Simplify.lhs
index f5af0d1693..2e7ce3d8fe 100644
--- a/ghc/compiler/simplCore/Simplify.lhs
+++ b/ghc/compiler/simplCore/Simplify.lhs
@@ -60,6 +60,7 @@ import BasicTypes	( TopLevelFlag(..), isTopLevel,
 import OrdList
 import Maybe		( Maybe )
 import Outputable
+import Util             ( notNull )
 \end{code}
 
 
@@ -922,8 +923,8 @@ completeCall env var occ_info cont
     let
 	arg_infos = [ interestingArg arg | arg <- args, isValArg arg]
 
-	interesting_cont = interestingCallContext (not (null args)) 
-						  (not (null arg_infos))
+	interesting_cont = interestingCallContext (notNull args)
+						  (notNull arg_infos)
 						  call_cont
 
     	active_inline = activeInline env var occ_info
diff --git a/ghc/compiler/specialise/SpecConstr.lhs b/ghc/compiler/specialise/SpecConstr.lhs
index 9ff7d16ff5..c79ec11767 100644
--- a/ghc/compiler/specialise/SpecConstr.lhs
+++ b/ghc/compiler/specialise/SpecConstr.lhs
@@ -33,7 +33,7 @@ import BasicTypes	( Activation(..) )
 import Outputable
 
 import Maybes		( orElse )
-import Util		( mapAccumL, lengthAtLeast )
+import Util		( mapAccumL, lengthAtLeast, notNull )
 import List		( nubBy, partition )
 import UniqSupply
 import Outputable
@@ -374,7 +374,7 @@ scExpr env e@(App _ _)
 ----------------------
 scBind :: ScEnv -> CoreBind -> UniqSM (ScEnv, ScUsage, CoreBind)
 scBind env (Rec [(fn,rhs)])
-  | not (null val_bndrs)
+  | notNull val_bndrs
   = scExpr env_fn_body body		`thenUs` \ (usg, body') ->
     let
 	SCU { calls = calls, occs = occs } = usg
diff --git a/ghc/compiler/specialise/Specialise.lhs b/ghc/compiler/specialise/Specialise.lhs
index 59c52d101a..16d3748f3a 100644
--- a/ghc/compiler/specialise/Specialise.lhs
+++ b/ghc/compiler/specialise/Specialise.lhs
@@ -41,7 +41,7 @@ import BasicTypes	( Activation( AlwaysActive ) )
 import Bag
 import List		( partition )
 import Util		( zipEqual, zipWithEqual, cmpList, lengthIs,
-			  equalLength, lengthAtLeast )
+			  equalLength, lengthAtLeast, notNull )
 import Outputable
 
 
@@ -786,7 +786,7 @@ specDefn subst calls (fn, rhs)
 	-- The first case is the interesting one
   |  rhs_tyvars `lengthIs` n_tyvars 	-- Rhs of fn's defn has right number of big lambdas
   && rhs_bndrs  `lengthAtLeast` n_dicts	-- and enough dict args
-  && not (null calls_for_me)		-- And there are some calls to specialise
+  && notNull calls_for_me		-- And there are some calls to specialise
   && not (isDataConWrapId fn)		-- And it's not a data con wrapper, which have
 					-- stupid overloading that simply discard the dictionary
 
diff --git a/ghc/compiler/stranal/WorkWrap.lhs b/ghc/compiler/stranal/WorkWrap.lhs
index ab2b19e54c..b12d05b4b1 100644
--- a/ghc/compiler/stranal/WorkWrap.lhs
+++ b/ghc/compiler/stranal/WorkWrap.lhs
@@ -29,7 +29,7 @@ import VarEnv		( isEmptyVarEnv )
 import Maybes		( orElse )
 import CmdLineOpts
 import WwLib
-import Util		( lengthIs )
+import Util		( lengthIs, notNull )
 import Outputable
 \end{code}
 
@@ -235,7 +235,7 @@ tryWW is_rec fn_id rhs
 	   | otherwise	       = fn_id `setIdNewStrictness` 
 				   StrictSig (mkTopDmdType wrap_dmds res_info)
 
-    is_fun    = not (null wrap_dmds)
+    is_fun    = notNull wrap_dmds
     is_thunk  = not is_fun && not (exprIsValue rhs)
 
 ---------------------
diff --git a/ghc/compiler/stranal/WwLib.lhs b/ghc/compiler/stranal/WwLib.lhs
index 7a14c323c1..4e716c1fc8 100644
--- a/ghc/compiler/stranal/WwLib.lhs
+++ b/ghc/compiler/stranal/WwLib.lhs
@@ -26,7 +26,7 @@ import Literal		( Literal(MachStr) )
 import BasicTypes	( Boxity(..) )
 import Var              ( Var, isId )
 import UniqSupply	( returnUs, thenUs, getUniquesUs, UniqSM )
-import Util		( zipWithEqual )
+import Util		( zipWithEqual, notNull )
 import Outputable
 import List		( zipWith4 )
 \end{code}
@@ -241,7 +241,7 @@ mkWWargs fun_ty demands one_shots
 	      work_fn_args . Note (Coerce rep_ty fun_ty),
 	      res_ty)
 
-  | not (null demands)
+  | notNull demands
   = getUniquesUs 		`thenUs` \ wrap_uniqs ->
     let
       (tyvars, tau)      = splitForAllTys fun_ty
@@ -258,7 +258,7 @@ mkWWargs fun_ty demands one_shots
       val_args	= zipWith4 mk_wrap_arg wrap_uniqs arg_tys demands one_shots
       wrap_args = tyvars ++ val_args
     in
-{-     ASSERT( not (null tyvars) || not (null arg_tys) ) -}
+{-     ASSERT( notNull tyvars || notNull arg_tys ) -}
     if (null tyvars) && (null arg_tys) then
 	pprTrace "mkWWargs" (ppr fun_ty $$ ppr demands) 
 		returnUs ([], id, id, fun_ty)
diff --git a/ghc/compiler/typecheck/TcDeriv.lhs b/ghc/compiler/typecheck/TcDeriv.lhs
index 6108d158f3..12a6ef16a0 100644
--- a/ghc/compiler/typecheck/TcDeriv.lhs
+++ b/ghc/compiler/typecheck/TcDeriv.lhs
@@ -51,7 +51,7 @@ import TcType		( TcType, ThetaType, mkTyVarTys, mkTyConApp, getClassPredTys_mayb
 import Var		( TyVar, tyVarKind )
 import VarSet		( mkVarSet, subVarSet )
 import PrelNames
-import Util		( zipWithEqual, sortLt )
+import Util		( zipWithEqual, sortLt, notNull )
 import ListSetOps	( removeDups,  assoc )
 import Outputable
 import Maybe		( isJust )
@@ -441,7 +441,7 @@ makeDerivEqns tycl_decls
     ------------------------------------------------------------------
     chk_out :: Class -> TyCon -> [TcType] -> Maybe FastString
     chk_out clas tycon tys
-	| not (null tys)						= Just non_std_why
+	| notNull tys						        = Just non_std_why
 	| not (getUnique clas `elem` derivableClassKeys)		= Just non_std_why
 	| clas `hasKey` enumClassKey    && not is_enumeration 	        = Just nullary_why
 	| clas `hasKey` boundedClassKey && not is_enumeration_or_single = Just single_nullary_why
diff --git a/ghc/compiler/typecheck/TcExpr.lhs b/ghc/compiler/typecheck/TcExpr.lhs
index a31eeb4f56..fd3826633b 100644
--- a/ghc/compiler/typecheck/TcExpr.lhs
+++ b/ghc/compiler/typecheck/TcExpr.lhs
@@ -373,7 +373,7 @@ tcMonoExpr expr@(RecordCon con_name rbinds) res_ty
     let
 	bad_fields = badFields rbinds data_con
     in
-    if not (null bad_fields) then
+    if notNull bad_fields then
 	mapNF_Tc (addErrTc . badFieldCon con_name) bad_fields	`thenNF_Tc_`
 	failTc	-- Fail now, because tcRecordBinds will crash on a bad field
     else
@@ -388,7 +388,7 @@ tcMonoExpr expr@(RecordCon con_name rbinds) res_ty
 	(mapNF_Tc (addErrTc . missingStrictFieldCon con_name) missing_s_fields `thenNF_Tc_`
 	 returnNF_Tc ())  `thenNF_Tc_`
     doptsTc Opt_WarnMissingFields `thenNF_Tc` \ warn ->
-    checkTcM (not (warn && not (null missing_fields)))
+    checkTcM (not (warn && notNull missing_fields))
 	(mapNF_Tc ((warnTc True) . missingFieldCon con_name) missing_fields `thenNF_Tc_`
 	 returnNF_Tc ())  `thenNF_Tc_`
 
@@ -425,7 +425,7 @@ tcMonoExpr expr@(RecordUpd record_expr rbinds) res_ty
 
 	-- STEP 0
 	-- Check that the field names are really field names
-    ASSERT( not (null rbinds) )
+    ASSERT( notNull rbinds )
     let 
 	field_names = [field_name | (field_name, _, _) <- rbinds]
     in
@@ -820,7 +820,7 @@ tcExpr_id expr         = newHoleTyVarTy			`thenNF_Tc` \ id_ty ->
 --
 tcDoStmts PArrComp stmts src_loc res_ty
   =
-    ASSERT( not (null stmts) )
+    ASSERT( notNull stmts )
     tcAddSrcLoc src_loc	$
 
     unifyPArrTy res_ty			      `thenTc` \elt_ty              ->
@@ -836,7 +836,7 @@ tcDoStmts PArrComp stmts src_loc res_ty
 tcDoStmts do_or_lc stmts src_loc res_ty
   =	-- get the Monad and MonadZero classes
 	-- create type consisting of a fresh monad tyvar
-    ASSERT( not (null stmts) )
+    ASSERT( notNull stmts )
     tcAddSrcLoc src_loc	$
 
 	-- If it's a comprehension we're dealing with, 
diff --git a/ghc/compiler/typecheck/TcMType.lhs b/ghc/compiler/typecheck/TcMType.lhs
index 15d415003a..9fbeb46206 100644
--- a/ghc/compiler/typecheck/TcMType.lhs
+++ b/ghc/compiler/typecheck/TcMType.lhs
@@ -90,7 +90,7 @@ import BasicTypes	( Boxity(Boxed) )
 import CmdLineOpts	( dopt, DynFlag(..) )
 import Unique		( Uniquable(..) )
 import SrcLoc		( noSrcLoc )
-import Util		( nOfThem, isSingleton, equalLength )
+import Util		( nOfThem, isSingleton, equalLength, notNull )
 import ListSetOps	( equivClasses, removeDups )
 import Outputable
 \end{code}
@@ -658,7 +658,7 @@ checkTypeCtxt ctxt ty
 	-- This shows up in the complaint about
 	--	case C a where
 	--	  op :: Eq a => a -> a
-ppr_ty ty | null forall_tvs && not (null theta) = pprTheta theta <+> ptext SLIT("=>") <+> ppr tau
+ppr_ty ty | null forall_tvs && notNull theta = pprTheta theta <+> ptext SLIT("=>") <+> ppr tau
           | otherwise	 		     = ppr ty
           where
 	    (forall_tvs, theta, tau) = tcSplitSigmaTy ty
@@ -882,7 +882,7 @@ check_valid_theta ctxt []
   = returnTc ()
 check_valid_theta ctxt theta
   = getDOptsTc					`thenNF_Tc` \ dflags ->
-    warnTc (not (null dups)) (dupPredWarn dups)	`thenNF_Tc_`
+    warnTc (notNull dups) (dupPredWarn dups)	`thenNF_Tc_`
     mapTc_ (check_source_ty dflags ctxt) theta
   where
     (_,dups) = removeDups tcCmpPred theta
@@ -1021,7 +1021,7 @@ checkValidClass cls
     doptsTc Opt_GlasgowExts				`thenTc` \ gla_exts ->
 
     	-- Check that the class is unary, unless GlaExs
-    checkTc (not (null tyvars))		(nullaryClassErr cls)	`thenTc_`
+    checkTc (notNull tyvars)	(nullaryClassErr cls)	`thenTc_`
     checkTc (gla_exts || unary) (classArityErr cls)	`thenTc_`
 
    	-- Check the super-classes
diff --git a/ghc/compiler/typecheck/TcUnify.lhs b/ghc/compiler/typecheck/TcUnify.lhs
index 9a574b3565..ee7f84d4fb 100644
--- a/ghc/compiler/typecheck/TcUnify.lhs
+++ b/ghc/compiler/typecheck/TcUnify.lhs
@@ -61,7 +61,7 @@ import VarEnv
 import Name		( isSystemName, getSrcLoc )
 import ErrUtils		( Message )
 import BasicTypes	( Boxity, Arity, isBoxed )
-import Util		( equalLength )
+import Util		( equalLength, notNull )
 import Maybe		( isNothing )
 import Outputable
 \end{code}
@@ -1186,7 +1186,7 @@ find_thing ignore_it tidy_env (ATyVar tv)
 -----------------------
 escape_msg sig_tv tv globs
   = mk_msg sig_tv <+> ptext SLIT("escapes") $$
-    if not (null globs) then
+    if notNull globs then
 	vcat [pp_it <+> ptext SLIT("is mentioned in the environment:"), 
 	      nest 2 (vcat globs)]
      else
diff --git a/ghc/compiler/types/Class.lhs b/ghc/compiler/types/Class.lhs
index 6181d4fc80..6aced85121 100644
--- a/ghc/compiler/types/Class.lhs
+++ b/ghc/compiler/types/Class.lhs
@@ -24,6 +24,7 @@ import Name		( NamedThing(..), Name )
 import BasicTypes	( Arity )
 import Unique		( Unique, Uniquable(..) )
 import Outputable
+import Util             ( notNull )
 \end{code}
 
 %************************************************************************
@@ -116,7 +117,7 @@ classExtraBigSig (Class {classTyVars = tyvars, classFunDeps = fundeps,
   = (tyvars, fundeps, sc_theta, sc_sels, op_stuff)
 
 classHasFDs :: Class -> Bool
-classHasFDs (Class {classFunDeps = fundeps}) = not (null fundeps)
+classHasFDs (Class {classFunDeps = fundeps}) = notNull fundeps
 \end{code}
 
 
diff --git a/ghc/compiler/types/InstEnv.lhs b/ghc/compiler/types/InstEnv.lhs
index 4f36597c58..a6ee42e5cb 100644
--- a/ghc/compiler/types/InstEnv.lhs
+++ b/ghc/compiler/types/InstEnv.lhs
@@ -34,6 +34,7 @@ import UniqFM		( UniqFM, lookupWithDefaultUFM, addToUFM, emptyUFM, eltsUFM )
 import Id		( idType )
 import ErrUtils		( Message )
 import CmdLineOpts
+import Util             ( notNull )
 \end{code}
 
 
@@ -326,7 +327,7 @@ addToInstEnv :: DynFlags
 addToInstEnv dflags (inst_env, errs) dfun_id
 	-- Check first that the new instance doesn't 
 	-- conflict with another.  See notes below about fundeps.
-  | not (null bad_fundeps)
+  | notNull bad_fundeps
   = (inst_env, fundep_err : errs)		-- Bad fundeps; report the first only
 
   | otherwise
@@ -426,7 +427,7 @@ badFunDeps :: ClsInstEnv -> Class
 badFunDeps cls_inst_env clas ins_tv_set ins_tys 
   = [ dfun_id | fd <- fds,
 	       (tvs, tys, dfun_id) <- cls_inst_env,
-	       not (null (checkClsFD (tvs `unionVarSet` ins_tv_set) fd clas_tvs tys ins_tys))
+	       notNull (checkClsFD (tvs `unionVarSet` ins_tv_set) fd clas_tvs tys ins_tys)
     ]
   where
     (clas_tvs, fds) = classTvsFds clas
diff --git a/ghc/compiler/utils/Util.lhs b/ghc/compiler/utils/Util.lhs
index 93e759bf88..c3833df964 100644
--- a/ghc/compiler/utils/Util.lhs
+++ b/ghc/compiler/utils/Util.lhs
@@ -20,6 +20,8 @@ module Util (
 	nOfThem, 
 	lengthExceeds, lengthIs, lengthAtLeast, listLengthCmp, atLength,
 	isSingleton, only,
+	notNull,
+
 	snocView,
 	isIn, isn'tIn,
 
@@ -258,10 +260,10 @@ atLength atLenPred atEndPred ls n
 -- special cases.
 lengthExceeds :: [a] -> Int -> Bool
 -- (lengthExceeds xs n) = (length xs > n)
-lengthExceeds = atLength (not.null) (const False)
+lengthExceeds = atLength notNull (const False)
 
 lengthAtLeast :: [a] -> Int -> Bool
-lengthAtLeast = atLength (not.null) (== 0)
+lengthAtLeast = atLength notNull (== 0)
 
 lengthIs :: [a] -> Int -> Bool
 lengthIs = atLength null (==0)
@@ -281,6 +283,10 @@ isSingleton :: [a] -> Bool
 isSingleton [x] = True
 isSingleton  _  = False
 
+notNull :: [a] -> Bool
+notNull [] = False
+notNull _  = True
+
 only :: [a] -> a
 #ifdef DEBUG
 only [a] = a