diff options
| -rw-r--r-- | compiler/main/DynFlags.hs | 2 | ||||
| -rw-r--r-- | compiler/parser/Lexer.x | 17 | ||||
| -rw-r--r-- | 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 eeb48bab8e..9a56b50562 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 68712109c5..11d849ab71 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 e2fd0aa093..6d42ce7dfe 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 |