From be7ce7174fd6cd0852f79da024f3d0d7ff3b309e Mon Sep 17 00:00:00 2001
From: Martin Huschenbett <31696042+martin-drhu-da@users.noreply.github.com>
Date: Thu, 11 Apr 2019 13:52:22 +0200
Subject: [PATCH] Turn off -Woverlowed-literals in damlc (#375)

* Turn off -Woverlowed-literals in damlc

This flag does not play well with location information obtained via `-ticky`.
Also, the error message you get from overflowed literals suggests to use
`-XNegativeLiterals`, which is a bad idea since it changes the meaning of
`(-1)` from `\x -> x - 1` to `negate 1`.

* Fix module name in test

Co-Authored-By: martin-drhu-da <31696042+martin-drhu-da@users.noreply.github.com>
---
 .../src/Development/IDE/UtilGHC.hs            |  2 +-
 .../src/DA/Daml/GHC/Compiler/Convert.hs       | 20 +++++++++----------
 ...tBoundsStatic.daml => IntBoundsLower.daml} |  8 ++------
 .../daml-ghc/tests/IntBoundsUpper.daml        | 10 ++++++++++
 4 files changed, 22 insertions(+), 18 deletions(-)
 rename daml-foundations/daml-ghc/tests/{IntBoundsStatic.daml => IntBoundsLower.daml} (60%)
 create mode 100644 daml-foundations/daml-ghc/tests/IntBoundsUpper.daml

diff --git a/compiler/haskell-ide-core/src/Development/IDE/UtilGHC.hs b/compiler/haskell-ide-core/src/Development/IDE/UtilGHC.hs
index 14ac457d3b..2d0781b5b5 100644
--- a/compiler/haskell-ide-core/src/Development/IDE/UtilGHC.hs
+++ b/compiler/haskell-ide-core/src/Development/IDE/UtilGHC.hs
@@ -94,7 +94,6 @@ wOptsSet =
 wOptsSetFatal :: [ WarningFlag ]
 wOptsSetFatal =
   [ Opt_WarnMissingFields
-  , Opt_WarnOverflowedLiterals
   ]
 
 -- | Warning options unset for DAML compilation. Note that these can be modified
@@ -103,6 +102,7 @@ wOptsSetFatal =
 wOptsUnset :: [ WarningFlag ]
 wOptsUnset =
   [ Opt_WarnMissingMonadFailInstances -- failable pattern plus RebindableSyntax raises this error
+  , Opt_WarnOverflowedLiterals -- this does not play well with -ticky and the error message is misleading
   ]
 
 
diff --git a/daml-foundations/daml-ghc/src/DA/Daml/GHC/Compiler/Convert.hs b/daml-foundations/daml-ghc/src/DA/Daml/GHC/Compiler/Convert.hs
index c4f5c421a0..43aaefc7fa 100644
--- a/daml-foundations/daml-ghc/src/DA/Daml/GHC/Compiler/Convert.hs
+++ b/daml-foundations/daml-ghc/src/DA/Daml/GHC/Compiler/Convert.hs
@@ -232,11 +232,12 @@ isBuiltinTextMap :: NamedThing a => Env -> a -> Bool
 isBuiltinTextMap env a =
     supportsTextMap (envLfVersion env) && isBuiltinName "TextMap" a
 
-toInt64 :: Integer -> Maybe Int64
-toInt64 x
+convertInt64 :: Integer -> ConvertM LF.Expr
+convertInt64 x
     | toInteger (minBound :: Int64) <= x && x <= toInteger (maxBound :: Int64) =
-        Just $ fromInteger x
-    | otherwise = Nothing
+        pure $ EBuiltin $ BEInt64 (fromInteger x)
+    | otherwise =
+        unsupported "Int literal out of bounds" (negate x)
 
 convertModule :: LF.Version -> MS.Map UnitId T.Text -> GhcModule -> Either Diagnostic LF.Module
 convertModule lfVersion pkgMap mod0 = runConvertM (ConversionEnv (gmPath mod0) Nothing) $ do
@@ -583,11 +584,11 @@ convertExpr env0 e = do
     go env (VarIs "fromRational") ((VarIs ":%" `App` tyInteger `App` Lit (LitNumber _ top _) `App` Lit (LitNumber _ bot _)) : args)
         = fmap (, args) $ pure $ EBuiltin $ BEDecimal $ fromRational $ top % bot
     go env (VarIs "negate") (tyInt : VarIs "$fAdditiveInt" : (VarIs "fromInteger" `App` Lit (LitNumber _ x _)) : args)
-        | Just y <- toInt64 (negate x)
-        = fmap (, args) $ pure $ EBuiltin $ BEInt64 y
+        = fmap (, args) $ convertInt64 (negate x)
     go env (VarIs "fromInteger") (Lit (LitNumber _ x _) : args)
-        | Just y <- toInt64 x
-        = fmap (, args) $ pure $ EBuiltin $ BEInt64 y
+        = fmap (, args) $ convertInt64 x
+    go env (Lit (LitNumber LitNumInt x _)) args
+        = fmap (, args) $ convertInt64 x
     go env (VarIs "fromString") (x : args)
         = fmap (, args) $ convertExpr env x
     go env (VarIs "unpackCString#") (Lit (LitString x) : args)
@@ -632,9 +633,6 @@ convertExpr env0 e = do
         let mkCtor (Ctor c _ _) = EVariantCon (fromTCon tt') (mkVariantCon (getOccString c)) mkEUnit
             mkEqInt i = EBuiltin (BEEqual BTInt64) `ETmApp` x' `ETmApp` EBuiltin (BEInt64 i)
         pure (foldr ($) (mkCtor c1) [mkIf (mkEqInt i) (mkCtor c) | (i,c) <- zipFrom 0 cs])
-    go env (Lit (LitNumber LitNumInt x _)) args
-        | toInteger (minBound :: Int64) <= x && x <= toInteger (maxBound :: Int64)
-        = fmap (, args) $ pure $ EBuiltin $ BEInt64 $ fromInteger x
 
     -- built ins because they are lazy
     go env (VarIs "ifThenElse") (Type tRes : cond : true : false : args)
diff --git a/daml-foundations/daml-ghc/tests/IntBoundsStatic.daml b/daml-foundations/daml-ghc/tests/IntBoundsLower.daml
similarity index 60%
rename from daml-foundations/daml-ghc/tests/IntBoundsStatic.daml
rename to daml-foundations/daml-ghc/tests/IntBoundsLower.daml
index 41a3e35465..00bd534daf 100644
--- a/daml-foundations/daml-ghc/tests/IntBoundsStatic.daml
+++ b/daml-foundations/daml-ghc/tests/IntBoundsLower.daml
@@ -2,13 +2,9 @@
 -- All rights reserved.
 
 -- Test that overflowing integer literals are detected at compile time.
--- @ ERROR Literal 9223372036854775808
--- @ ERROR Literal -9223372036854775809
+-- @ ERROR Int literal out of bounds
 daml 1.2
-module IntBoundsStatic where
-
-tooBig : Int
-tooBig = 9223372036854775808
+module IntBoundsLower where
 
 tooSmall : Int
 tooSmall = -9223372036854775809
diff --git a/daml-foundations/daml-ghc/tests/IntBoundsUpper.daml b/daml-foundations/daml-ghc/tests/IntBoundsUpper.daml
new file mode 100644
index 0000000000..5588339adc
--- /dev/null
+++ b/daml-foundations/daml-ghc/tests/IntBoundsUpper.daml
@@ -0,0 +1,10 @@
+-- Copyright (c) 2019, Digital Asset (Switzerland) GmbH and/or its affiliates.
+-- All rights reserved.
+
+-- Test that overflowing integer literals are detected at compile time.
+-- @ ERROR Int literal out of bounds
+daml 1.2
+module IntBoundsUpper where
+
+tooBig : Int
+tooBig = 9223372036854775808