Commit 30d55993 authored by simonmar's avatar simonmar
Browse files

[project @ 2000-10-12 13:11:45 by simonmar]

Move FAST_INT and FAST_BOOL into their own module FastTypes, replacing
the macro definitions in HsVersions.h with real definitions.  Change
most of the names in the process.

Now we don't get bogus imports of GlaExts all over the place, and
-fwarn-unused-imports is less noisy.
parent 1c360159
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: AbsCSyn.lhs,v 1.33 2000/08/07 23:37:19 qrczak Exp $
% $Id: AbsCSyn.lhs,v 1.34 2000/10/12 13:11:46 simonmar Exp $
%
\section[AbstractC]{Abstract C: the last stop before machine code}
......@@ -374,9 +374,9 @@ mkCCostCentreStack ccs = CLbl (mkCCS_Label ccs) DataPtrRep
\begin{code}
data RegRelative
= HpRel FAST_INT -- }
| SpRel FAST_INT -- }- offsets in StgWords
| NodeRel FAST_INT -- }
= HpRel FastInt -- }
| SpRel FastInt -- }- offsets in StgWords
| NodeRel FastInt -- }
| CIndex CAddrMode CAddrMode PrimRep -- pointer arithmetic :-)
-- CIndex a b k === (k*)a[b]
......@@ -388,16 +388,16 @@ data ReturnInfo
hpRel :: VirtualHeapOffset -- virtual offset of Hp
-> VirtualHeapOffset -- virtual offset of The Thing
-> RegRelative -- integer offset
hpRel IBOX(hp) IBOX(off) = HpRel (hp _SUB_ off)
hpRel _IBOX(hp) _IBOX(off) = HpRel (hp _SUB_ off)
spRel :: VirtualSpOffset -- virtual offset of Sp
-> VirtualSpOffset -- virtual offset of The Thing
-> RegRelative -- integer offset
spRel sp off = SpRel (case spRelToInt sp off of { IBOX(i) -> i })
spRel sp off = SpRel (case spRelToInt sp off of { _IBOX(i) -> i })
nodeRel :: VirtualHeapOffset
-> RegRelative
nodeRel IBOX(off) = NodeRel off
nodeRel _IBOX(off) = NodeRel off
\end{code}
......@@ -451,13 +451,13 @@ data MagicId
-- Argument and return registers
| VanillaReg -- pointers, unboxed ints and chars
PrimRep
FAST_INT -- its number (1 .. mAX_Vanilla_REG)
FastInt -- its number (1 .. mAX_Vanilla_REG)
| FloatReg -- single-precision floating-point registers
FAST_INT -- its number (1 .. mAX_Float_REG)
FastInt -- its number (1 .. mAX_Float_REG)
| DoubleReg -- double-precision floating-point registers
FAST_INT -- its number (1 .. mAX_Double_REG)
FastInt -- its number (1 .. mAX_Double_REG)
-- STG registers
| Sp -- Stack ptr; points to last occupied stack location.
......@@ -470,14 +470,14 @@ data MagicId
-- no actual register
| LongReg -- long int registers (64-bit, really)
PrimRep -- Int64Rep or Word64Rep
FAST_INT -- its number (1 .. mAX_Long_REG)
FastInt -- its number (1 .. mAX_Long_REG)
| CurrentTSO -- pointer to current thread's TSO
| CurrentNursery -- pointer to allocation area
node = VanillaReg PtrRep ILIT(1) -- A convenient alias for Node
tagreg = VanillaReg WordRep ILIT(2) -- A convenient alias for TagReg
node = VanillaReg PtrRep _ILIT(1) -- A convenient alias for Node
tagreg = VanillaReg WordRep _ILIT(2) -- A convenient alias for TagReg
nodeReg = CReg node
\end{code}
......@@ -486,26 +486,26 @@ We need magical @Eq@ because @VanillaReg@s come in multiple flavors.
\begin{code}
instance Eq MagicId where
reg1 == reg2 = tag reg1 _EQ_ tag reg2
reg1 == reg2 = tag reg1 ==# tag reg2
where
tag BaseReg = (ILIT(0) :: FAST_INT)
tag Sp = ILIT(1)
tag Su = ILIT(2)
tag SpLim = ILIT(3)
tag Hp = ILIT(4)
tag HpLim = ILIT(5)
tag CurCostCentre = ILIT(6)
tag VoidReg = ILIT(7)
tag (VanillaReg _ i) = ILIT(8) _ADD_ i
tag (FloatReg i) = ILIT(8) _ADD_ maxv _ADD_ i
tag (DoubleReg i) = ILIT(8) _ADD_ maxv _ADD_ maxf _ADD_ i
tag (LongReg _ i) = ILIT(8) _ADD_ maxv _ADD_ maxf _ADD_ maxd _ADD_ i
maxv = case mAX_Vanilla_REG of { IBOX(x) -> x }
maxf = case mAX_Float_REG of { IBOX(x) -> x }
maxd = case mAX_Double_REG of { IBOX(x) -> x }
tag BaseReg = (_ILIT(0) :: FastInt)
tag Sp = _ILIT(1)
tag Su = _ILIT(2)
tag SpLim = _ILIT(3)
tag Hp = _ILIT(4)
tag HpLim = _ILIT(5)
tag CurCostCentre = _ILIT(6)
tag VoidReg = _ILIT(7)
tag (VanillaReg _ i) = _ILIT(8) +# i
tag (FloatReg i) = _ILIT(8) +# maxv +# i
tag (DoubleReg i) = _ILIT(8) +# maxv +# maxf +# i
tag (LongReg _ i) = _ILIT(8) +# maxv +# maxf +# maxd +# i
maxv = iUnbox mAX_Vanilla_REG
maxf = iUnbox mAX_Float_REG
maxd = iUnbox mAX_Double_REG
\end{code}
Returns True for any register that {\em potentially} dies across
......
......@@ -441,7 +441,7 @@ sameAmode :: CAddrMode -> CAddrMode -> Bool
-- At the moment we put in just enough to catch the cases we want:
-- the second (destination) argument is always a CVal.
sameAmode (CReg r1) (CReg r2) = r1 == r2
sameAmode (CVal (SpRel r1) _) (CVal (SpRel r2) _) = r1 _EQ_ r2
sameAmode (CVal (SpRel r1) _) (CVal (SpRel r2) _) = r1 ==# r2
sameAmode other1 other2 = False
doSimultaneously1 :: [CVertex] -> FlatM AbstractC
......@@ -520,7 +520,7 @@ other1 `conflictsWith` other2 = False
regConflictsWithRR :: MagicId -> RegRelative -> Bool
regConflictsWithRR (VanillaReg k ILIT(1)) (NodeRel _) = True
regConflictsWithRR (VanillaReg k _ILIT(1)) (NodeRel _) = True
regConflictsWithRR Sp (SpRel _) = True
regConflictsWithRR Hp (HpRel _) = True
......@@ -533,14 +533,14 @@ rrConflictsWithRR :: Int -> Int -- Sizes of two things
rrConflictsWithRR (I# s1) (I# s2) rr1 rr2 = rr rr1 rr2
where
rr (SpRel o1) (SpRel o2)
| s1 _EQ_ ILIT(0) || s2 _EQ_ ILIT(0) = False -- No conflict if either is size zero
| s1 _EQ_ ILIT(1) && s2 _EQ_ ILIT(1) = o1 _EQ_ o2
| otherwise = (o1 _ADD_ s1) _GE_ o2 &&
(o2 _ADD_ s2) _GE_ o1
| s1 ==# _ILIT(0) || s2 ==# _ILIT(0) = False -- No conflict if either is size zero
| s1 ==# _ILIT(1) && s2 ==# _ILIT(1) = o1 ==# o2
| otherwise = (o1 +# s1) >=# o2 &&
(o2 +# s2) >=# o1
rr (NodeRel o1) (NodeRel o2)
| s1 _EQ_ ILIT(0) || s2 _EQ_ ILIT(0) = False -- No conflict if either is size zero
| s1 _EQ_ ILIT(1) && s2 _EQ_ ILIT(1) = o1 _EQ_ o2
| s1 ==# _ILIT(0) || s2 ==# _ILIT(0) = False -- No conflict if either is size zero
| s1 ==# _ILIT(1) && s2 ==# _ILIT(1) = o1 ==# o2
| otherwise = True -- Give up
rr (HpRel _) (HpRel _) = True -- Give up (ToDo)
......
......@@ -1277,7 +1277,7 @@ pprMagicId HpLim = ptext SLIT("HpLim")
pprMagicId CurCostCentre = ptext SLIT("CCCS")
pprMagicId VoidReg = panic "pprMagicId:VoidReg!"
pprVanillaReg :: FAST_INT -> SDoc
pprVanillaReg :: FastInt -> SDoc
pprVanillaReg n = (<>) (char 'R') (int IBOX(n))
pprUnionTag :: PrimRep -> SDoc
......
......@@ -30,9 +30,10 @@ import PprType ( pprParendType )
import CStrings ( pprFSInCStyle )
import Outputable
import FastTypes
import Util ( thenCmp )
import Ratio ( numerator, denominator )
import Ratio ( numerator )
import FastString ( uniqueOfFS )
import Char ( ord, chr )
\end{code}
......@@ -239,20 +240,20 @@ cmpLit (MachFloat a) (MachFloat b) = a `compare` b
cmpLit (MachDouble a) (MachDouble b) = a `compare` b
cmpLit (MachLabel a) (MachLabel b) = a `compare` b
cmpLit (MachLitLit a b) (MachLitLit c d) = (a `compare` c) `thenCmp` (b `compare` d)
cmpLit lit1 lit2 | litTag lit1 _LT_ litTag lit2 = LT
cmpLit lit1 lit2 | litTag lit1 <# litTag lit2 = LT
| otherwise = GT
litTag (MachChar _) = ILIT(1)
litTag (MachStr _) = ILIT(2)
litTag (MachAddr _) = ILIT(3)
litTag (MachInt _) = ILIT(4)
litTag (MachWord _) = ILIT(5)
litTag (MachInt64 _) = ILIT(6)
litTag (MachWord64 _) = ILIT(7)
litTag (MachFloat _) = ILIT(8)
litTag (MachDouble _) = ILIT(9)
litTag (MachLabel _) = ILIT(10)
litTag (MachLitLit _ _) = ILIT(11)
litTag (MachChar _) = _ILIT(1)
litTag (MachStr _) = _ILIT(2)
litTag (MachAddr _) = _ILIT(3)
litTag (MachInt _) = _ILIT(4)
litTag (MachWord _) = _ILIT(5)
litTag (MachInt64 _) = _ILIT(6)
litTag (MachWord64 _) = _ILIT(7)
litTag (MachFloat _) = _ILIT(8)
litTag (MachDouble _) = _ILIT(9)
litTag (MachLabel _) = _ILIT(10)
litTag (MachLitLit _ _) = _ILIT(11)
\end{code}
Printing
......@@ -358,5 +359,5 @@ hashInteger i = 1 + abs (fromInteger (i `rem` 10000))
-- since we use * to combine hash values
hashFS :: FAST_STRING -> Int
hashFS s = IBOX( uniqueOfFS s )
hashFS s = iBox (uniqueOfFS s)
\end{code}
......@@ -14,7 +14,6 @@ module Name (
mkTopName, mkIPName,
mkDerivedName, mkGlobalName, mkKnownKeyGlobal,
mkWiredInIdName, mkWiredInTyConName,
mkUnboundName, isUnboundName,
maybeWiredInIdName, maybeWiredInTyConName,
isWiredInName, hashName,
......@@ -50,21 +49,20 @@ module Name (
#include "HsVersions.h"
import {-# SOURCE #-} Var ( Id, setIdName )
import {-# SOURCE #-} TyCon ( TyCon, setTyConName )
import {-# SOURCE #-} Var ( Id )
import {-# SOURCE #-} TyCon ( TyCon )
import OccName -- All of it
import Module ( Module, moduleName, pprModule, mkVanillaModule, isLocalModule )
import RdrName ( RdrName, mkRdrQual, mkRdrUnqual, rdrNameOcc, rdrNameModule )
import CmdLineOpts ( opt_Static, opt_PprStyle_NoPrags, opt_OmitInterfacePragmas, opt_EnsureSplittableC )
import SrcLoc ( noSrcLoc, mkBuiltinSrcLoc, SrcLoc )
import SrcLoc ( noSrcLoc, SrcLoc )
import Unique ( Unique, Uniquable(..), u2i, hasKey, pprUnique )
import PrelNames ( unboundKey )
import Maybes ( expectJust )
import FastTypes
import UniqFM
import Outputable
import GlaExts
\end{code}
......@@ -180,14 +178,6 @@ mkDerivedName :: (OccName -> OccName)
-> Name -- Result is always a value name
mkDerivedName f name uniq = name {n_uniq = uniq, n_occ = f (n_occ name)}
-- mkUnboundName makes a place-holder Name; it shouldn't be looked at except possibly
-- during compiler debugging.
mkUnboundName :: RdrName -> Name
mkUnboundName rdr_name = mkLocalName unboundKey (rdrNameOcc rdr_name) noSrcLoc
isUnboundName :: Name -> Bool
isUnboundName name = name `hasKey` unboundKey
\end{code}
\begin{code}
......@@ -413,7 +403,7 @@ isExternallyVisibleName :: Name -> Bool
hashName :: Name -> Int
hashName name = IBOX( u2i (nameUnique name) )
hashName name = iBox (u2i (nameUnique name))
nameUnique name = n_uniq name
nameOccName name = n_occ name
......
......@@ -32,6 +32,7 @@ module SrcLoc (
import Util ( thenCmp )
import Outputable
import FastString ( unpackFS )
import FastTypes
import GlaExts ( Int(..), (+#) )
\end{code}
......@@ -48,7 +49,7 @@ data SrcLoc
= NoSrcLoc
| SrcLoc FAST_STRING -- A precise location (file name)
FAST_INT
FastInt
| UnhelpfulSrcLoc FAST_STRING -- Just a general indication
\end{code}
......@@ -67,7 +68,7 @@ rare case.
Things to make 'em:
\begin{code}
noSrcLoc = NoSrcLoc
mkSrcLoc x IBOX(y) = SrcLoc x y
mkSrcLoc x y = SrcLoc x (iUnbox y)
mkIfaceSrcLoc = UnhelpfulSrcLoc SLIT("<an interface file>")
mkBuiltinSrcLoc = UnhelpfulSrcLoc SLIT("<built-into-the-compiler>")
......@@ -79,14 +80,14 @@ isNoSrcLoc other = False
srcLocFile :: SrcLoc -> FAST_STRING
srcLocFile (SrcLoc fname _) = fname
srcLocLine :: SrcLoc -> FAST_INT
srcLocLine :: SrcLoc -> FastInt
srcLocLine (SrcLoc _ l) = l
incSrcLine :: SrcLoc -> SrcLoc
incSrcLine (SrcLoc s l) = SrcLoc s (l +# 1#)
incSrcLine loc = loc
replaceSrcLine :: SrcLoc -> FAST_INT -> SrcLoc
replaceSrcLine :: SrcLoc -> FastInt -> SrcLoc
replaceSrcLine (SrcLoc s _) l = SrcLoc s l
\end{code}
......@@ -124,12 +125,12 @@ instance Outputable SrcLoc where
ppr (SrcLoc src_path src_line)
= getPprStyle $ \ sty ->
if userStyle sty then
hcat [ text src_file, char ':', int IBOX(src_line) ]
hcat [ text src_file, char ':', int (iBox src_line) ]
else
if debugStyle sty then
hcat [ ptext src_path, char ':', int IBOX(src_line) ]
hcat [ ptext src_path, char ':', int (iBox src_line) ]
else
hcat [text "{-# LINE ", int IBOX(src_line), space,
hcat [text "{-# LINE ", int (iBox src_line), space,
char '\"', ptext src_path, text " #-}"]
where
src_file = unpackFS src_path -- Leave the directory prefix intact,
......
......@@ -52,6 +52,7 @@ import FastString ( FastString, uniqueOfFS )
import GlaExts
import ST
import PrelBase ( Char(..), chr, ord )
import FastTypes
import Outputable
\end{code}
......@@ -70,7 +71,7 @@ data Unique = MkUnique Int#
\end{code}
\begin{code}
u2i :: Unique -> FAST_INT
u2i :: Unique -> FastInt
u2i (MkUnique i) = i
\end{code}
......
......@@ -39,14 +39,13 @@ import Name ( Name, OccName, NamedThing(..),
setNameUnique, setNameOcc, nameUnique,
mkSysLocalName, isExternallyVisibleName
)
import BasicTypes ( Unused )
import FastTypes
import Outputable
import IOExts ( IORef, newIORef, readIORef, writeIORef )
\end{code}
%************************************************************************
%* *
\subsection{The main data type declarations}
......@@ -63,7 +62,7 @@ in its @VarDetails@.
data Var
= Var {
varName :: Name,
realUnique :: Int#, -- Key for fast comparison
realUnique :: FastInt, -- Key for fast comparison
-- Identical to the Unique in the name,
-- cached here for speed
varType :: Type,
......
......@@ -161,6 +161,7 @@ import GlaExts
import Argv
import Constants -- Default values for some flags
import Util
import FastTypes
import Maybes ( firstJust )
import Panic ( panic )
......@@ -641,18 +642,18 @@ These things behave just like enumeration types.
\begin{code}
instance Eq SimplifierSwitch where
a == b = tagOf_SimplSwitch a _EQ_ tagOf_SimplSwitch b
a == b = tagOf_SimplSwitch a ==# tagOf_SimplSwitch b
instance Ord SimplifierSwitch where
a < b = tagOf_SimplSwitch a _LT_ tagOf_SimplSwitch b
a <= b = tagOf_SimplSwitch a _LE_ tagOf_SimplSwitch b
a < b = tagOf_SimplSwitch a <# tagOf_SimplSwitch b
a <= b = tagOf_SimplSwitch a <=# tagOf_SimplSwitch b
tagOf_SimplSwitch (SimplInlinePhase _) = ILIT(1)
tagOf_SimplSwitch (MaxSimplifierIterations _) = ILIT(2)
tagOf_SimplSwitch DontApplyRules = ILIT(3)
tagOf_SimplSwitch SimplLetToCase = ILIT(4)
tagOf_SimplSwitch NoCaseOfCase = ILIT(5)
tagOf_SimplSwitch (SimplInlinePhase _) = _ILIT(1)
tagOf_SimplSwitch (MaxSimplifierIterations _) = _ILIT(2)
tagOf_SimplSwitch DontApplyRules = _ILIT(3)
tagOf_SimplSwitch SimplLetToCase = _ILIT(4)
tagOf_SimplSwitch NoCaseOfCase = _ILIT(5)
-- If you add anything here, be sure to change lAST_SIMPL_SWITCH_TAG, too!
......@@ -700,9 +701,9 @@ isAmongSimpl on_switches -- Switches mentioned later occur *earlier*
#endif
}
where
mk_assoc_elem k@(MaxSimplifierIterations lvl) = (IBOX(tagOf_SimplSwitch k), SwInt lvl)
mk_assoc_elem k@(SimplInlinePhase n) = (IBOX(tagOf_SimplSwitch k), SwInt n)
mk_assoc_elem k = (IBOX(tagOf_SimplSwitch k), SwBool True) -- I'm here, Mom!
mk_assoc_elem k@(MaxSimplifierIterations lvl) = (_IBOX(tagOf_SimplSwitch k), SwInt lvl)
mk_assoc_elem k@(SimplInlinePhase n) = (_IBOX(tagOf_SimplSwitch k), SwInt n)
mk_assoc_elem k = (_IBOX(tagOf_SimplSwitch k), SwBool True) -- I'm here, Mom!
-- cannot have duplicates if we are going to use the array thing
rm_dups switches_so_far switch
......@@ -711,7 +712,7 @@ isAmongSimpl on_switches -- Switches mentioned later occur *earlier*
else switch : switches_so_far
where
sw `is_elem` [] = False
sw `is_elem` (s:ss) = (tagOf_SimplSwitch sw) _EQ_ (tagOf_SimplSwitch s)
sw `is_elem` (s:ss) = (tagOf_SimplSwitch sw) ==# (tagOf_SimplSwitch s)
|| sw `is_elem` ss
\end{code}
......
......@@ -73,19 +73,19 @@ primOpTag :: PrimOp -> Int
primOpTag op = IBOX( tagOf_PrimOp op )
-- supplies
-- tagOf_PrimOp :: PrimOp -> FAST_INT
-- tagOf_PrimOp :: PrimOp -> FastInt
#include "primop-tag.hs-incl"
tagOf_PrimOp op = pprPanic# "tagOf_PrimOp: pattern-match" (ppr op)
instance Eq PrimOp where
op1 == op2 = tagOf_PrimOp op1 _EQ_ tagOf_PrimOp op2
op1 == op2 = tagOf_PrimOp op1 ==# tagOf_PrimOp op2
instance Ord PrimOp where
op1 < op2 = tagOf_PrimOp op1 _LT_ tagOf_PrimOp op2
op1 <= op2 = tagOf_PrimOp op1 _LE_ tagOf_PrimOp op2
op1 >= op2 = tagOf_PrimOp op1 _GE_ tagOf_PrimOp op2
op1 > op2 = tagOf_PrimOp op1 _GT_ tagOf_PrimOp op2
op1 < op2 = tagOf_PrimOp op1 <# tagOf_PrimOp op2
op1 <= op2 = tagOf_PrimOp op1 <=# tagOf_PrimOp op2
op1 >= op2 = tagOf_PrimOp op1 >=# tagOf_PrimOp op2
op1 > op2 = tagOf_PrimOp op1 ># tagOf_PrimOp op2
op1 `compare` op2 | op1 < op2 = LT
| op1 == op2 = EQ
| otherwise = GT
......
......@@ -36,6 +36,7 @@ import Module ( Module, ModuleName, moduleName,
)
import Outputable
import CStrings ( pprStringInCStyle )
import FastTypes
import Util ( thenCmp )
\end{code}
......@@ -267,10 +268,10 @@ cmpCostCentre other_1 other_2
tag1 = tag_CC other_1
tag2 = tag_CC other_2
in
if tag1 _LT_ tag2 then LT else GT
if tag1 <# tag2 then LT else GT
where
tag_CC (NormalCC {}) = (ILIT(1) :: FAST_INT)
tag_CC (AllCafsCC {}) = ILIT(2)
tag_CC (NormalCC {}) = (_ILIT 1 :: FastInt)
tag_CC (AllCafsCC {}) = _ILIT 2
cmp_caf NotCafCC CafCC = LT
cmp_caf NotCafCC NotCafCC = EQ
......
......@@ -103,7 +103,6 @@ import TyCon ( TyCon,
-- others
import SrcLoc ( noSrcLoc )
import Maybes ( maybeToBool )
import PrimRep ( PrimRep(..), isFollowableRep )
import Unique ( Uniquable(..) )
import Util ( mapAccumL, seqList, thenCmp )
......
%
% (c) The University of Glasgow, 2000
%
\section{Fast integers and booleans}
\begin{code}
module FastTypes (
FastInt, _ILIT, iBox, iUnbox,
(+#), (-#), (*#), quotFastInt, negateFastInt,
(==#), (<#), (<=#), (>=#), (>#),
FastBool, fastBool, _IS_TRUE_
) where
#if defined(__GLASGOW_HASKELL__)
-- Import the beggars
import GlaExts
( Int(..), Int#, (+#), (-#), (*#),
quotInt#, negateInt#, (==#), (<#), (<=#), (>=#), (>#)
)
type FastInt = Int#
_ILIT (I# x) = x
iBox x = I# x
iUnbox (I# x) = x
quotFastInt = quotInt#
negateFastInt = negateInt#
type FastBool = Int#
fastBool True = 1#
fastBool False = 0#
_IS_TRUE_ x = x ==# 1#
#else {- ! __GLASGOW_HASKELL__ -}
type FastInt = Int
_ILIT x = x
iBox x = x
iUnbox x = x
(+#) = (+)
(-#) = (-)
(*#) = (*)
quotFastInt = quot
negateFastInt = negate
(==#) = (==)
(<#) = (<)
(<=#) = (<=)
(>=#) = (>=)
(>#) = (>)
type FastBool = Bool
fastBool x = x
_IS_TRUE_ x = x
#endif {- ! __GLASGOW_HASKELL__ -}
\end{code}
......@@ -12,6 +12,7 @@ some unnecessary loops in the module dependency graph.
module Panic ( panic, panic#, assertPanic, trace ) where
import IOExts ( trace )
import FastTypes
#include "HsVersions.h"
\end{code}
......@@ -27,8 +28,8 @@ panic x = error ("panic! (the `impossible' happened):\n\t"
-- what TAG_ is with GHC at the moment. Ugh. (Simon)
-- No, man -- Too Beautiful! (Will)
panic# :: String -> FAST_INT
panic# s = case (panic s) of () -> ILIT(0)
panic# :: String -> FastInt
panic# s = case (panic s) of () -> _ILIT 0
assertPanic :: String -> Int -> a
assertPanic file line = panic ("ASSERT failed! file " ++ file ++ ", line " ++ show line)
......
......@@ -204,12 +204,13 @@ allow you to use either GHC or Hugs. To get GHC, just set the CPP variable
#if defined(__GLASGOW_HASKELL__)
-- Glasgow Haskell
-- Disable ASSERT checks; they are expensive!
#define LOCAL_ASSERT(x)
#define ILIT(x) (x#)
#define IBOX(x) (I# (x))
#define INT Int#
#define MINUS -#
#define NEGATE negateInt#
......
......@@ -51,13 +51,8 @@ import {-# SOURCE #-} Name ( Name )
import Unique ( Uniquable(..), Unique, u2i, mkUniqueGrimily )
import Panic
import GlaExts -- Lots of Int# operations
import FastTypes
import Outputable
#if ! OMIT_NATIVE_CODEGEN
#define IF_NCG(a) a
#else
#define IF_NCG(a) {--}
#endif
\end{code}
%************************************************************************
......@@ -193,9 +188,9 @@ First, the DataType itself; which is either a Node, a Leaf, or an Empty.
\begin{code}
data UniqFM ele
= EmptyUFM
| LeafUFM FAST_INT ele
| NodeUFM FAST_INT -- the switching
FAST_INT -- the delta
| LeafUFM FastInt ele
| NodeUFM FastInt -- the switching
FastInt -- the delta
(UniqFM ele)
(UniqFM ele)
......@@ -275,11 +270,11 @@ delete fm key = del_ele fm
del_ele :: UniqFM a -> UniqFM a
del_ele lf@(LeafUFM j _)
| j _EQ_ key = EmptyUFM
| j ==# key = EmptyUFM
| otherwise = lf -- no delete!
del_ele nd@(NodeUFM j p t1 t2)
| j _GT_ key
| j ># key
= mkSLNodeUFM (NodeUFMData j p) (del_ele t1) t2
| otherwise
= mkLSNodeUFM (NodeUFMData j p) t1 (del_ele t2)
......@@ -537,8 +532,8 @@ isNullUFM _ = False
-- hashing is used in VarSet.uniqAway, and should be fast
-- We use a cheap and cheerful method for now
hashUFM EmptyUFM = 0
hashUFM (NodeUFM n _ _ _) = IBOX(n)
hashUFM (LeafUFM n _) = IBOX(n)
hashUFM (NodeUFM n _ _ _) = iBox n
hashUFM (LeafUFM n _) = iBox n
\end{code}
looking up in a hurry is the {\em whole point} of this binary tree lark.
......@@ -568,10 +563,10 @@ lookUp fm i = lookup_tree fm
lookup_tree :: UniqFM a -> Maybe a
lookup_tree (LeafUFM j b)
| j _EQ_ i = Just b
| j ==# i = Just b
| otherwise = Nothing
lookup_tree (NodeUFM j p t1 t2)