Commit d254a44b authored by sof's avatar sof
Browse files

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

Friday afternoon pet peeve removal: define (Util.notNull :: [a] -> Bool) and use it
parent ef3da13b
......@@ -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}
......
......@@ -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}
%************************************************************************
......
......@@ -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
......
......@@ -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)
......
......@@ -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
......
......@@ -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
......
......@@ -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}
......
......@@ -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
......
......@@ -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, ())
......
......@@ -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
......
{-# 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 ()
......
......@@ -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))) ] ++
......
{-# 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
......
......@@ -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))
......
-----------------------------------------------------------------------------
-- $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
......
{-# 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
......
......@@ -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
......
......@@ -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"
......
......@@ -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}
......
......@@ -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}
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment