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

[Simon Peyton-Jones]

Ian,

Thanks...  but if you have added a new language extension, shouldn't you document it in the user manual?  What exactly is the different behaviour seen by the user?

Simon

|  -----Original Message-----
|  From: ghc-commits [mailto:ghc-commits-bounces at haskell.org] On Behalf Of Ian
|  Lynagh
|  Sent: 31 July 2013 20:12
|  To: ghc-commits at haskell.org
|  Subject: [commit: ghc] master: Add NegativeLiterals extension (ef73963)
|  
|  Repository : http://darcs.haskell.org/ghc.git/
|  
|  On branch  : master
|  
|  http://hackage.haskell.org/trac/ghc/changeset/ef739635a8c2646112d2a1fa4c871
|  5704aff1f1f
|  
|  >---------------------------------------------------------------
|  
|  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
|  
|  
|  
|  _______________________________________________
|  ghc-commits mailing list
|  ghc-commits at haskell.org
|  http://www.haskell.org/mailman/listinfo/ghc-commits