[commit: ghc] master: Add NegativeLiterals extension (ef73963)

[Ian Lynagh]

Repository : http://darcs.haskell.org/ghc.git/

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/ef739635a8c2646112d2a1fa4c8715704aff1f1f

>---------------------------------------------------------------

commit ef739635a8c2646112d2a1fa4c8715704aff1f1f
Author: Ian Lynagh <ian at well-typed.com>
Date:   Wed Jul 31 18:43:11 2013 +0100

    Add NegativeLiterals extension
    
    I'd been meaning to do this for some time, but finally got around to it
    due to the overflowing literals warning. With that enabled, we were
    getting a warning for
        -128 :: Int8
    as that is parsed as
        negate (fromInteger 128)
    which just happens to do the right thing, as
        negate (fromInteger 128) = negate (-128) = -128

>---------------------------------------------------------------

 compiler/main/DynFlags.hs |    2 ++
 compiler/parser/Lexer.x   |   17 +++++++++++++----
 compiler/utils/Util.lhs   |    2 +-
 3 files changed, 16 insertions(+), 5 deletions(-)

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index eeb48ba..9a56b50 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -558,6 +558,7 @@ data ExtensionFlag
    | Opt_LambdaCase
    | Opt_MultiWayIf
    | Opt_TypeHoles
+   | Opt_NegativeLiterals
    | Opt_EmptyCase
    deriving (Eq, Enum, Show)
 
@@ -2726,6 +2727,7 @@ xFlags = [
   ( "IncoherentInstances",              Opt_IncoherentInstances, nop ),
   ( "PackageImports",                   Opt_PackageImports, nop ),
   ( "TypeHoles",                        Opt_TypeHoles, nop ),
+  ( "NegativeLiterals",                 Opt_NegativeLiterals, nop ),
   ( "EmptyCase",                        Opt_EmptyCase, nop )
   ]
 
diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index 6871210..11d849a 100644
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -385,12 +385,16 @@ $tab+         { warn Opt_WarnTabs (text "Tab character") }
 -- when trying to be close to Haskell98
 <0> {
   -- Normal integral literals (:: Num a => a, from Integer)
-  @decimal           { tok_num positive 0 0 decimal }
-  0[oO] @octal       { tok_num positive 2 2 octal }
-  0[xX] @hexadecimal { tok_num positive 2 2 hexadecimal }
+  @decimal                                                               { tok_num positive 0 0 decimal }
+  0[oO] @octal                                                           { tok_num positive 2 2 octal }
+  0[xX] @hexadecimal                                                     { tok_num positive 2 2 hexadecimal }
+  @negative @decimal           / { ifExtension negativeLiteralsEnabled } { tok_num negative 1 1 decimal }
+  @negative 0[oO] @octal       / { ifExtension negativeLiteralsEnabled } { tok_num negative 3 3 octal }
+  @negative 0[xX] @hexadecimal / { ifExtension negativeLiteralsEnabled } { tok_num negative 3 3 hexadecimal }
 
   -- Normal rational literals (:: Fractional a => a, from Rational)
-  @floating_point    { strtoken tok_float }
+  @floating_point                                                        { strtoken tok_float }
+  @negative @floating_point    / { ifExtension negativeLiteralsEnabled } { strtoken tok_float }
 }
 
 <0> {
@@ -1870,6 +1874,8 @@ explicitNamespacesBit :: Int
 explicitNamespacesBit = 29
 lambdaCaseBit :: Int
 lambdaCaseBit = 30
+negativeLiteralsBit :: Int
+negativeLiteralsBit = 31
 
 
 always :: Int -> Bool
@@ -1925,6 +1931,8 @@ explicitNamespacesEnabled :: Int -> Bool
 explicitNamespacesEnabled flags = testBit flags explicitNamespacesBit
 lambdaCaseEnabled :: Int -> Bool
 lambdaCaseEnabled flags = testBit flags lambdaCaseBit
+negativeLiteralsEnabled :: Int -> Bool
+negativeLiteralsEnabled flags = testBit flags negativeLiteralsBit
 
 -- PState for parsing options pragmas
 --
@@ -1988,6 +1996,7 @@ mkPState flags buf loc =
                .|. typeLiteralsBit             `setBitIf` xopt Opt_DataKinds flags
                .|. explicitNamespacesBit       `setBitIf` xopt Opt_ExplicitNamespaces flags
                .|. lambdaCaseBit               `setBitIf` xopt Opt_LambdaCase               flags
+               .|. negativeLiteralsBit         `setBitIf` xopt Opt_NegativeLiterals         flags
       --
       setBitIf :: Int -> Bool -> Int
       b `setBitIf` cond | cond      = bit b
diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs
index e2fd0aa..6d42ce7 100644
--- a/compiler/utils/Util.lhs
+++ b/compiler/utils/Util.lhs
@@ -1095,7 +1095,7 @@ charToC w =
 hashString :: String -> Int32
 hashString = foldl' f golden
    where f m c = fromIntegral (ord c) * magic + hashInt32 m
-         magic = 0xdeadbeef
+         magic = fromIntegral (0xdeadbeef :: Word32)
 
 golden :: Int32
 golden = 1013904242 -- = round ((sqrt 5 - 1) * 2^32) :: Int32