Whitespace only in basicTypes/Literal.lhs
[ghc.git] / compiler / basicTypes / Literal.lhs
index b25c60f..4efe3c6 100644 (file)
@@ -5,44 +5,38 @@
 \section[Literal]{@Literal@: Machine literals (unboxed, of course)}
 
 \begin{code}
-{-# OPTIONS -fno-warn-incomplete-patterns #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
 {-# LANGUAGE DeriveDataTypeable #-}
 
 module Literal
-       ( 
-       -- * Main data type
-         Literal(..)           -- Exported to ParseIface
-       
-       -- ** Creating Literals
-       , mkMachInt, mkMachWord
-       , mkMachInt64, mkMachWord64
-       , mkMachFloat, mkMachDouble
-       , mkMachChar, mkMachString
-       
-       -- ** Operations on Literals
-       , literalType
-       , hashLiteral
+        (
+        -- * Main data type
+          Literal(..)           -- Exported to ParseIface
+
+        -- ** Creating Literals
+        , mkMachInt, mkMachWord
+        , mkMachInt64, mkMachWord64
+        , mkMachFloat, mkMachDouble
+        , mkMachChar, mkMachString
+
+        -- ** Operations on Literals
+        , literalType
+        , hashLiteral
         , absentLiteralOf
 
         -- ** Predicates on Literals and their contents
-       , litIsDupable, litIsTrivial
-       , inIntRange, inWordRange, tARGET_MAX_INT, inCharRange
-       , isZeroLit
-       , litFitsInChar
+        , litIsDupable, litIsTrivial
+        , inIntRange, inWordRange, tARGET_MAX_INT, inCharRange
+        , isZeroLit
+        , litFitsInChar
 
         -- ** Coercions
-       , word2IntLit, int2WordLit
-       , narrow8IntLit, narrow16IntLit, narrow32IntLit
-       , narrow8WordLit, narrow16WordLit, narrow32WordLit
-       , char2IntLit, int2CharLit
-       , float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit
-       , nullAddrLit, float2DoubleLit, double2FloatLit
-       ) where
+        , word2IntLit, int2WordLit
+        , narrow8IntLit, narrow16IntLit, narrow32IntLit
+        , narrow8WordLit, narrow16WordLit, narrow32WordLit
+        , char2IntLit, int2CharLit
+        , float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit
+        , nullAddrLit, float2DoubleLit, double2FloatLit
+        ) where
 
 import TysPrim
 import PrelNames
@@ -65,9 +59,9 @@ import Numeric ( fromRat )
 
 
 %************************************************************************
-%*                                                                     *
+%*                                                                      *
 \subsection{Literals}
-%*                                                                     *
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
@@ -77,41 +71,41 @@ import Numeric ( fromRat )
 --   which is presumed to be surrounded by appropriate constructors
 --   (@Int#@, etc.), so that the overall thing makes sense.
 --
--- * The literal derived from the label mentioned in a \"foreign label\" 
+-- * The literal derived from the label mentioned in a \"foreign label\"
 --   declaration ('MachLabel')
 data Literal
-  =    ------------------
-       -- First the primitive guys
-    MachChar   Char            -- ^ @Char#@ - at least 31 bits. Create with 'mkMachChar'
+  =     ------------------
+        -- First the primitive guys
+    MachChar    Char            -- ^ @Char#@ - at least 31 bits. Create with 'mkMachChar'
 
-  | MachStr    FastString      -- ^ A string-literal: stored and emitted
-                               -- UTF-8 encoded, we'll arrange to decode it
-                               -- at runtime.  Also emitted with a @'\0'@
-                               -- terminator. Create with 'mkMachString'
+  | MachStr     FastString      -- ^ A string-literal: stored and emitted
+                                -- UTF-8 encoded, we'll arrange to decode it
+                                -- at runtime.  Also emitted with a @'\0'@
+                                -- terminator. Create with 'mkMachString'
 
   | MachNullAddr                -- ^ The @NULL@ pointer, the only pointer value
-                                -- that can be represented as a Literal. Create 
+                                -- that can be represented as a Literal. Create
                                 -- with 'nullAddrLit'
 
-  | MachInt    Integer         -- ^ @Int#@ - at least @WORD_SIZE_IN_BITS@ bits. Create with 'mkMachInt'
-  | MachInt64  Integer         -- ^ @Int64#@ - at least 64 bits. Create with 'mkMachInt64'
-  | MachWord   Integer         -- ^ @Word#@ - at least @WORD_SIZE_IN_BITS@ bits. Create with 'mkMachWord'
-  | MachWord64 Integer         -- ^ @Word64#@ - at least 64 bits. Create with 'mkMachWord64'
+  | MachInt     Integer         -- ^ @Int#@ - at least @WORD_SIZE_IN_BITS@ bits. Create with 'mkMachInt'
+  | MachInt64   Integer         -- ^ @Int64#@ - at least 64 bits. Create with 'mkMachInt64'
+  | MachWord    Integer         -- ^ @Word#@ - at least @WORD_SIZE_IN_BITS@ bits. Create with 'mkMachWord'
+  | MachWord64  Integer         -- ^ @Word64#@ - at least 64 bits. Create with 'mkMachWord64'
 
-  | MachFloat  Rational        -- ^ @Float#@. Create with 'mkMachFloat'
-  | MachDouble Rational        -- ^ @Double#@. Create with 'mkMachDouble'
+  | MachFloat   Rational        -- ^ @Float#@. Create with 'mkMachFloat'
+  | MachDouble  Rational        -- ^ @Double#@. Create with 'mkMachDouble'
 
   | MachLabel   FastString
-               (Maybe Int)
+                (Maybe Int)
         FunctionOrData
                 -- ^ A label literal. Parameters:
-                       --
-                       -- 1) The name of the symbol mentioned in the declaration
-                       --
-                       -- 2) The size (in bytes) of the arguments
-                               --    the label expects. Only applicable with
-                               --    @stdcall@ labels. @Just x@ => @\<x\>@ will
-                               --    be appended to label name when emitting assembly.
+                        --
+                        -- 1) The name of the symbol mentioned in the declaration
+                        --
+                        -- 2) The size (in bytes) of the arguments
+                                --    the label expects. Only applicable with
+                                --    @stdcall@ labels. @Just x@ => @\<x\>@ will
+                                --    be appended to label name when emitting assembly.
   deriving (Data, Typeable)
 \end{code}
 
@@ -134,39 +128,39 @@ instance Binary Literal where
              put_ bh mb
              put_ bh fod
     get bh = do
-           h <- getByte bh
-           case h of
-             0 -> do
-                   aa <- get bh
-                   return (MachChar aa)
-             1 -> do
-                   ab <- get bh
-                   return (MachStr ab)
-             2 -> do
-                   return (MachNullAddr)
-             3 -> do
-                   ad <- get bh
-                   return (MachInt ad)
-             4 -> do
-                   ae <- get bh
-                   return (MachInt64 ae)
-             5 -> do
-                   af <- get bh
-                   return (MachWord af)
-             6 -> do
-                   ag <- get bh
-                   return (MachWord64 ag)
-             7 -> do
-                   ah <- get bh
-                   return (MachFloat ah)
-             8 -> do
-                   ai <- get bh
-                   return (MachDouble ai)
-             9 -> do
-                   aj <- get bh
-                   mb <- get bh
-                   fod <- get bh
-                   return (MachLabel aj mb fod)
+            h <- getByte bh
+            case h of
+              0 -> do
+                    aa <- get bh
+                    return (MachChar aa)
+              1 -> do
+                    ab <- get bh
+                    return (MachStr ab)
+              2 -> do
+                    return (MachNullAddr)
+              3 -> do
+                    ad <- get bh
+                    return (MachInt ad)
+              4 -> do
+                    ae <- get bh
+                    return (MachInt64 ae)
+              5 -> do
+                    af <- get bh
+                    return (MachWord af)
+              6 -> do
+                    ag <- get bh
+                    return (MachWord64 ag)
+              7 -> do
+                    ah <- get bh
+                    return (MachFloat ah)
+              8 -> do
+                    ai <- get bh
+                    return (MachDouble ai)
+              9 -> do
+                    aj <- get bh
+                    mb <- get bh
+                    fod <- get bh
+                    return (MachLabel aj mb fod)
 \end{code}
 
 \begin{code}
@@ -182,29 +176,29 @@ instance Eq Literal where
 
 instance Ord Literal where
     a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
-    a <         b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
+    a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
     a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
-    a >         b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
+    a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
     compare a b = cmpLit a b
 \end{code}
 
 
-       Construction
-       ~~~~~~~~~~~~
+        Construction
+        ~~~~~~~~~~~~
 \begin{code}
 -- | Creates a 'Literal' of type @Int#@
 mkMachInt :: Integer -> Literal
-mkMachInt  x   = -- ASSERT2( inIntRange x,  integer x ) 
-                -- Not true: you can write out of range Int# literals
-                -- For example, one can write (intToWord# 0xffff0000) to
-                -- get a particular Word bit-pattern, and there's no other
-                -- convenient way to write such literals, which is why we allow it.
-                MachInt x
+mkMachInt  x   = -- ASSERT2( inIntRange x,  integer x )
+                 -- Not true: you can write out of range Int# literals
+                 -- For example, one can write (intToWord# 0xffff0000) to
+                 -- get a particular Word bit-pattern, and there's no other
+                 -- convenient way to write such literals, which is why we allow it.
+                 MachInt x
 
 -- | Creates a 'Literal' of type @Word#@
 mkMachWord :: Integer -> Literal
-mkMachWord x   = -- ASSERT2( inWordRange x, integer x ) 
-                MachWord x
+mkMachWord x   = -- ASSERT2( inWordRange x, integer x )
+                 MachWord x
 
 -- | Creates a 'Literal' of type @Int64#@
 mkMachInt64 :: Integer -> Literal
@@ -233,7 +227,7 @@ mkMachString s = MachStr (mkFastString s) -- stored UTF-8 encoded
 
 inIntRange, inWordRange :: Integer -> Bool
 inIntRange  x = x >= tARGET_MIN_INT && x <= tARGET_MAX_INT
-inWordRange x = x >= 0             && x <= tARGET_MAX_WORD
+inWordRange x = x >= 0              && x <= tARGET_MAX_WORD
 
 inCharRange :: Char -> Bool
 inCharRange c =  c >= '\0' && c <= chr tARGET_MAX_CHAR
@@ -249,8 +243,8 @@ isZeroLit (MachDouble 0) = True
 isZeroLit _              = False
 \end{code}
 
-       Coercions
-       ~~~~~~~~~
+        Coercions
+        ~~~~~~~~~
 \begin{code}
 word2IntLit, int2WordLit,
   narrow8IntLit, narrow16IntLit, narrow32IntLit,
@@ -260,12 +254,12 @@ word2IntLit, int2WordLit,
   float2DoubleLit, double2FloatLit
   :: Literal -> Literal
 
-word2IntLit (MachWord w) 
+word2IntLit (MachWord w)
   | w > tARGET_MAX_INT = MachInt (w - tARGET_MAX_WORD - 1)
-  | otherwise         = MachInt w
+  | otherwise          = MachInt w
 
 int2WordLit (MachInt i)
-  | i < 0     = MachWord (1 + tARGET_MAX_WORD + i)     -- (-1)  --->  tARGET_MAX_WORD
+  | i < 0     = MachWord (1 + tARGET_MAX_WORD + i)      -- (-1)  --->  tARGET_MAX_WORD
   | otherwise = MachWord i
 
 narrow8IntLit    (MachInt  i) = MachInt  (toInteger (fromInteger i :: Int8))
@@ -291,32 +285,32 @@ nullAddrLit :: Literal
 nullAddrLit = MachNullAddr
 \end{code}
 
-       Predicates
-       ~~~~~~~~~~
+        Predicates
+        ~~~~~~~~~~
 \begin{code}
 -- | True if there is absolutely no penalty to duplicating the literal.
 -- False principally of strings
 litIsTrivial :: Literal -> Bool
---     c.f. CoreUtils.exprIsTrivial
+--      c.f. CoreUtils.exprIsTrivial
 litIsTrivial (MachStr _) = False
 litIsTrivial _           = True
 
 -- | True if code space does not go bad if we duplicate this literal
 -- Currently we treat it just like 'litIsTrivial'
 litIsDupable :: Literal -> Bool
---     c.f. CoreUtils.exprIsDupable
+--      c.f. CoreUtils.exprIsDupable
 litIsDupable (MachStr _) = False
 litIsDupable _           = True
 
 litFitsInChar :: Literal -> Bool
 litFitsInChar (MachInt i)
-                        = fromInteger i <= ord minBound 
-                        && fromInteger i >= ord maxBound 
+                         = fromInteger i <= ord minBound
+                        && fromInteger i >= ord maxBound
 litFitsInChar _         = False
 \end{code}
 
-       Types
-       ~~~~~
+        Types
+        ~~~~~
 \begin{code}
 -- | Find the Haskell 'Type' the literal occupies
 literalType :: Literal -> Type
@@ -338,32 +332,32 @@ absentLiteralOf tc = lookupUFM absent_lits (tyConName tc)
 
 absent_lits :: UniqFM Literal
 absent_lits = listToUFM [ (addrPrimTyConKey,    MachNullAddr)
-                       , (charPrimTyConKey,    MachChar 'x')
-                       , (intPrimTyConKey,     MachInt 0)
-                       , (int64PrimTyConKey,   MachInt64 0)
-                       , (floatPrimTyConKey,   MachFloat 0)
-                       , (doublePrimTyConKey,  MachDouble 0)
-                       , (wordPrimTyConKey,    MachWord 0)
-                       , (word64PrimTyConKey,  MachWord64 0) ]
+                        , (charPrimTyConKey,    MachChar 'x')
+                        , (intPrimTyConKey,     MachInt 0)
+                        , (int64PrimTyConKey,   MachInt64 0)
+                        , (floatPrimTyConKey,   MachFloat 0)
+                        , (doublePrimTyConKey,  MachDouble 0)
+                        , (wordPrimTyConKey,    MachWord 0)
+                        , (word64PrimTyConKey,  MachWord64 0) ]
 \end{code}
 
 
-       Comparison
-       ~~~~~~~~~~
+        Comparison
+        ~~~~~~~~~~
 \begin{code}
 cmpLit :: Literal -> Literal -> Ordering
-cmpLit (MachChar      a)   (MachChar      b)   = a `compare` b
-cmpLit (MachStr       a)   (MachStr       b)   = a `compare` b
+cmpLit (MachChar      a)   (MachChar       b)   = a `compare` b
+cmpLit (MachStr       a)   (MachStr        b)   = a `compare` b
 cmpLit (MachNullAddr)      (MachNullAddr)       = EQ
-cmpLit (MachInt       a)   (MachInt       b)   = a `compare` b
-cmpLit (MachWord      a)   (MachWord      b)   = a `compare` b
-cmpLit (MachInt64     a)   (MachInt64     b)   = a `compare` b
-cmpLit (MachWord64    a)   (MachWord64    b)   = a `compare` b
-cmpLit (MachFloat     a)   (MachFloat     b)   = a `compare` b
-cmpLit (MachDouble    a)   (MachDouble    b)   = a `compare` b
+cmpLit (MachInt       a)   (MachInt        b)   = a `compare` b
+cmpLit (MachWord      a)   (MachWord       b)   = a `compare` b
+cmpLit (MachInt64     a)   (MachInt64      b)   = a `compare` b
+cmpLit (MachWord64    a)   (MachWord64     b)   = a `compare` b
+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 lit1               lit2                 | litTag lit1 <# litTag lit2 = LT
-                                               | otherwise                  = GT
+cmpLit lit1                lit2                 | litTag lit1 <# litTag lit2 = LT
+                                                | otherwise                  = GT
 
 litTag :: Literal -> FastInt
 litTag (MachChar      _)   = _ILIT(1)
@@ -378,22 +372,22 @@ litTag (MachDouble    _)   = _ILIT(9)
 litTag (MachLabel _ _ _)   = _ILIT(10)
 \end{code}
 
-       Printing
-       ~~~~~~~~
+        Printing
+        ~~~~~~~~
 * MachX (i.e. unboxed) things are printed unadornded (e.g. 3, 'a', "foo")
   exceptions: MachFloat gets an initial keyword prefix.
 
 \begin{code}
 pprLit :: Literal -> SDoc
-pprLit (MachChar ch)   = pprHsChar ch
-pprLit (MachStr s)     = pprHsString s
-pprLit (MachInt i)     = pprIntVal i
-pprLit (MachInt64 i)   = ptext (sLit "__int64") <+> integer i
-pprLit (MachWord w)    = ptext (sLit "__word") <+> integer w
-pprLit (MachWord64 w)  = ptext (sLit "__word64") <+> integer w
-pprLit (MachFloat f)   = ptext (sLit "__float") <+> float (fromRat f)
-pprLit (MachDouble d)  = double (fromRat d)
-pprLit (MachNullAddr)  = ptext (sLit "__NULL")
+pprLit (MachChar ch)    = pprHsChar ch
+pprLit (MachStr s)      = pprHsString s
+pprLit (MachInt i)      = pprIntVal i
+pprLit (MachInt64 i)    = ptext (sLit "__int64") <+> integer i
+pprLit (MachWord w)     = ptext (sLit "__word") <+> integer w
+pprLit (MachWord64 w)   = ptext (sLit "__word64") <+> integer w
+pprLit (MachFloat f)    = ptext (sLit "__float") <+> float (fromRat f)
+pprLit (MachDouble d)   = double (fromRat d)
+pprLit (MachNullAddr)   = ptext (sLit "__NULL")
 pprLit (MachLabel l mb fod) = ptext (sLit "__label") <+> b <+> ppr fod
     where b = case mb of
               Nothing -> pprHsString l
@@ -402,14 +396,14 @@ pprLit (MachLabel l mb fod) = ptext (sLit "__label") <+> b <+> ppr fod
 pprIntVal :: Integer -> SDoc
 -- ^ Print negative integers with parens to be sure it's unambiguous
 pprIntVal i | i < 0     = parens (integer i)
-           | otherwise = integer i
+            | otherwise = integer i
 \end{code}
 
 
 %************************************************************************
-%*                                                                     *
+%*                                                                      *
 \subsection{Hashing}
-%*                                                                     *
+%*                                                                      *
 %************************************************************************
 
 Hash values should be zero or a positive integer.  No negatives please.
@@ -417,15 +411,15 @@ Hash values should be zero or a positive integer.  No negatives please.
 
 \begin{code}
 hashLiteral :: Literal -> Int
-hashLiteral (MachChar c)       = ord c + 1000  -- Keep it out of range of common ints
-hashLiteral (MachStr s)        = hashFS s
-hashLiteral (MachNullAddr)     = 0
-hashLiteral (MachInt i)        = hashInteger i
-hashLiteral (MachInt64 i)      = hashInteger i
-hashLiteral (MachWord i)       = hashInteger i
-hashLiteral (MachWord64 i)     = hashInteger i
-hashLiteral (MachFloat r)      = hashRational r
-hashLiteral (MachDouble r)     = hashRational r
+hashLiteral (MachChar c)        = ord c + 1000  -- Keep it out of range of common ints
+hashLiteral (MachStr s)         = hashFS s
+hashLiteral (MachNullAddr)      = 0
+hashLiteral (MachInt i)         = hashInteger i
+hashLiteral (MachInt64 i)       = hashInteger i
+hashLiteral (MachWord i)        = hashInteger i
+hashLiteral (MachWord64 i)      = hashInteger i
+hashLiteral (MachFloat r)       = hashRational r
+hashLiteral (MachDouble r)      = hashRational r
 hashLiteral (MachLabel s _ _)     = hashFS s
 
 hashRational :: Rational -> Int
@@ -433,8 +427,8 @@ hashRational r = hashInteger (numerator r)
 
 hashInteger :: Integer -> Int
 hashInteger i = 1 + abs (fromInteger (i `rem` 10000))
-               -- The 1+ is to avoid zero, which is a Bad Number
-               -- since we use * to combine hash values
+                -- The 1+ is to avoid zero, which is a Bad Number
+                -- since we use * to combine hash values
 
 hashFS :: FastString -> Int
 hashFS s = iBox (uniqueOfFS s)