#define UASSERT2(e,msg)
#endif
-#if __STDC__
-#define CAT2(a,b)a##b
-#else
-#define CAT2(a,b)a/**/b
-#endif
-
-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 202
-# define failWith fail
-# define MkIOError(h,errt,msg) (IOError (Just h) errt msg)
-# define minInt (minBound::Int)
-# define maxInt (maxBound::Int)
-#else
-# define MkIOError(h,errt,msg) (errt msg)
-#endif
-
#if __GLASGOW_HASKELL__ >= 23
-- This #ifndef lets us switch off the "import FastString"
# define _TAIL_ FastString.tailFS
# define _LENGTH_ FastString.lengthFS
# define _PK_ FastString.mkFastString
-# define _PK_INT_ FastString.mkFastStringInt
# define _UNPK_ FastString.unpackFS
# define _UNPK_INT_ FastString.unpackIntFS
# define _APPEND_ `FastString.appendFS`
-# define _CONCAT_ FastString.concatFS
#else
# error I think that FastString is now always used. If not, fix this.
# define FAST_STRING String
# define _UNPK_ (\x->x)
# define _SUBSTR_ substr{-from Utils-}
# define _APPEND_ ++
-# define _CONCAT_ concat
-#endif
-
-#if __HASKELL1__ > 4
-# define FMAP fmap
-# define ISALPHANUM isAlphaNum
-# define IOERROR ioError
-# define PSEQ seq
-# define SAPPLY $!
-#else
-# define FMAP map
-# define ISALPHANUM isAlphanum
-# define IOERROR fail
-# define PSEQ (\x y -> y)
-# define SAPPLY $
#endif
#endif
\begin{code}
setWorkerInfo info wk = wk `seq` info { workerInfo = wk }
-setSpecInfo info sp = PSEQ sp (info { specInfo = sp })
+setSpecInfo info sp = sp `seq` info { specInfo = sp }
setTyGenInfo info tg = tg `seq` info { tyGenInfo = tg }
setInlinePragInfo info pr = pr `seq` info { inlinePragInfo = pr }
setOccInfo info oc = oc `seq` info { occInfo = oc }
#include "HsVersions.h"
-import Char ( isDigit, isUpper, isLower, ISALPHANUM, ord, chr, digitToInt )
+import Char ( isDigit, isUpper, isLower, isAlphaNum, ord, chr, digitToInt )
import Util ( thenCmp )
import Unique ( Unique )
import FiniteMap ( FiniteMap, emptyFM, lookupFM, addToFM, elemFM )
-- in names we'd have to encode them. But we do put
-- spaces in ccall "occurrences", and we don't want to
-- reject them here
- ok ch = ISALPHANUM ch
+ ok ch = isAlphaNum ch
alreadyEncodedFS :: FAST_STRING -> Bool
alreadyEncodedFS fs = alreadyEncoded (_UNPK_ fs)
maybeImm (StIndex rep (StCLbl l) (StInt off))
= Just (ImmIndex l (fromInteger off * sizeOf rep))
maybeImm (StInt i)
- | i >= toInteger minInt && i <= toInteger maxInt
+ | i >= toInteger (minBound::Int) && i <= toInteger (maxBound::Int)
= Just (ImmInt (fromInteger i))
| otherwise
= Just (ImmInteger i)
failTc down env = give_up
give_up :: IO a
-give_up = IOERROR (userError "Typecheck failed")
+give_up = ioError (userError "Typecheck failed")
failWithTc :: Message -> TcM a -- Add an error message and fail
failWithTc err_msg = failWithTcM (emptyTidyEnv, err_msg)
Just tv' -> TyVarTy tv'
go (TyConApp tycon tys) = let args = map go tys
in args `seqList` TyConApp tycon args
- go (NoteTy note ty) = (NoteTy SAPPLY (go_note note)) SAPPLY (go ty)
+ go (NoteTy note ty) = (NoteTy $! (go_note note)) $! (go ty)
go (SourceTy sty) = SourceTy (tidySourceType env sty)
- go (AppTy fun arg) = (AppTy SAPPLY (go fun)) SAPPLY (go arg)
- go (FunTy fun arg) = (FunTy SAPPLY (go fun)) SAPPLY (go arg)
- go (ForAllTy tv ty) = ForAllTy tvp SAPPLY (tidyType envp ty)
+ go (AppTy fun arg) = (AppTy $! (go fun)) $! (go arg)
+ go (FunTy fun arg) = (FunTy $! (go fun)) $! (go arg)
+ go (ForAllTy tv ty) = ForAllTy tvp $! (tidyType envp ty)
where
(envp, tvp) = tidyTyVarBndr env tv
- go (UsageTy u ty) = (UsageTy SAPPLY (go u)) SAPPLY (go ty)
+ go (UsageTy u ty) = (UsageTy $! (go u)) $! (go ty)
- go_note (SynNote ty) = SynNote SAPPLY (go ty)
+ go_note (SynNote ty) = SynNote $! (go ty)
go_note note@(FTVNote ftvs) = note -- No need to tidy the free tyvars
tidyTypes env tys = map (tidyType env) tys
(\ handle ->
do sz <- hFileSize handle
if sz > toInteger (maxBound::Int)
- then IOERROR (userError "slurpFile: file too big")
+ then ioError (userError "slurpFile: file too big")
else do
let sz_i = fromInteger sz
sz_i' = (sz_i * 12) `div` 10 -- add 20% for tabs