git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge pull request #1738 from purescript/1731-negative-bottom
ebc4aacGary Burgess
examples/failing/IntOutOfRange.purs+1−1
compare with golang
unifiedsplit
@@ -3,4 +3,4 @@
3module Main where
3module Main where
4
4
5n :: Int
5n :: Int
6−n = 35028715023
6+n = 2147483648
examples/passing/NegativeIntInRange.pursnew file+8
@@ -0,0 +1,8 @@
1+module Main where
2+
3+import Prelude
4+
5+n :: Int
6+n = -2147483648
7+
8+main = Control.Monad.Eff.Console.log "Done"
src/Language/PureScript/CodeGen/JS.hs+30−13
@@ -10,7 +10,6 @@ module Language.PureScript.CodeGen.JS
10 ( module AST
10 ( module AST
11 , module Common
11 , module Common
12 , moduleToJs
12 , moduleToJs
13− , mainCall
14 ) where
13 ) where
15
14
16import Prelude ()
15import Prelude ()
@@ -19,10 +18,11 @@ import Prelude.Compat
19import Data.List ((\\), delete, intersect)
18import Data.List ((\\), delete, intersect)
20import Data.Maybe (isNothing, fromMaybe)
19import Data.Maybe (isNothing, fromMaybe)
21import qualified Data.Map as M
20import qualified Data.Map as M
22−import qualified Data.Traversable as T (traverse)
21+import qualified Data.Foldable as F
22+import qualified Data.Traversable as T
23
23
24import Control.Arrow ((&&&))
24import Control.Arrow ((&&&))
25−import Control.Monad (replicateM, forM)
25+import Control.Monad (replicateM, forM, void)
26import Control.Monad.Error.Class (MonadError(..))
26import Control.Monad.Error.Class (MonadError(..))
27import Control.Monad.Reader (MonadReader, asks)
27import Control.Monad.Reader (MonadReader, asks)
28import Control.Monad.Supply.Class
28import Control.Monad.Supply.Class
@@ -45,8 +45,12 @@ import System.FilePath.Posix ((</>))
45-- Generate code in the simplified Javascript intermediate representation for all declarations in a
45-- Generate code in the simplified Javascript intermediate representation for all declarations in a
46-- module.
46-- module.
47--
47--
48+moduleToJs
49+ :: forall m
48−moduleToJs :: forall m. (Applicative m, Monad m, MonadReader Options m, MonadSupply m, MonadError MultipleErrors m)
50+ . (Applicative m, Monad m, MonadReader Options m, MonadSupply m, MonadError MultipleErrors m)
49− => Module Ann -> Maybe JS -> m [JS]
51+ => Module Ann
52+ -> Maybe JS
53+ -> m [JS]
50moduleToJs (Module coms mn imps exps foreigns decls) foreign_ =
54moduleToJs (Module coms mn imps exps foreigns decls) foreign_ =
51 rethrow (addHint (ErrorInModule mn)) $ do
55 rethrow (addHint (ErrorInModule mn)) $ do
52 let usedNames = concatMap getNames decls
56 let usedNames = concatMap getNames decls
@@ -55,6 +59,7 @@ moduleToJs (Module coms mn imps exps foreigns decls) foreign_ =
55 let decls' = renameModules mnLookup decls
59 let decls' = renameModules mnLookup decls
56 jsDecls <- mapM bindToJs decls'
60 jsDecls <- mapM bindToJs decls'
57 optimized <- T.traverse (T.traverse optimize) jsDecls
61 optimized <- T.traverse (T.traverse optimize) jsDecls
62+ F.traverse_ (F.traverse_ checkIntegers) optimized
58 comments <- not <$> asks optionsNoComments
63 comments <- not <$> asks optionsNoComments
59 let strict = JSStringLiteral "use strict"
64 let strict = JSStringLiteral "use strict"
60 let header = if comments && not (null coms) then JSComment coms strict else strict
65 let header = if comments && not (null coms) then JSComment coms strict else strict
@@ -256,12 +261,7 @@ moduleToJs (Module coms mn imps exps foreigns decls) foreign_ =
256 iife v exprs = JSApp (JSFunction Nothing [] (JSBlock $ exprs ++ [JSReturn $ JSVar v])) []
261 iife v exprs = JSApp (JSFunction Nothing [] (JSBlock $ exprs ++ [JSReturn $ JSVar v])) []
257
262
258 literalToValueJS :: Literal (Expr Ann) -> m JS
263 literalToValueJS :: Literal (Expr Ann) -> m JS
259− literalToValueJS (NumericLiteral (Left i)) =
264+ literalToValueJS (NumericLiteral (Left i)) = return $ JSNumericLiteral (Left i)
260− let minInt = -2147483648
261− maxInt = 2147483647
262− in if i < minInt || i > maxInt
263− then throwError . errorMessage $ IntOutOfRange i "JavaScript" minInt maxInt
264− else return $ JSNumericLiteral (Left i)
265 literalToValueJS (NumericLiteral (Right n)) = return $ JSNumericLiteral (Right n)
265 literalToValueJS (NumericLiteral (Right n)) = return $ JSNumericLiteral (Right n)
266 literalToValueJS (StringLiteral s) = return $ JSStringLiteral s
266 literalToValueJS (StringLiteral s) = return $ JSStringLiteral s
267 literalToValueJS (CharLiteral c) = return $ JSStringLiteral [c]
267 literalToValueJS (CharLiteral c) = return $ JSStringLiteral [c]
@@ -414,5 +414,22 @@ moduleToJs (Module coms mn imps exps foreigns decls) foreign_ =
414 js <- binderToJs elVar done'' binder
414 js <- binderToJs elVar done'' binder
415 return (JSVariableIntroduction elVar (Just (JSIndexer (JSNumericLiteral (Left index)) (JSVar varName))) : js)
415 return (JSVariableIntroduction elVar (Just (JSIndexer (JSNumericLiteral (Left index)) (JSVar varName))) : js)
416
416
417−mainCall :: ModuleName -> String -> JS
417+ -- Check that all integers fall within the valid int range for JavaScript.
418−mainCall mmi ns = JSApp (JSAccessor C.main (JSAccessor (moduleNameToJs mmi) (JSVar ns))) []
418+ checkIntegers :: JS -> m ()
419+ checkIntegers = void . everywhereOnJSTopDownM go
420+ where
421+ go :: JS -> m JS
422+ go (JSUnary Negate (JSNumericLiteral (Left i))) =
423+ -- Move the negation inside the literal; since this is a top-down
424+ -- traversal doing this replacement will stop the next case from raising
425+ -- the error when attempting to use -2147483648, as if left unrewritten
426+ -- the value is `JSUnary Negate (JSNumericLiteral (Left 2147483648))`, and
427+ -- 2147483648 is larger than the maximum allowed int.
428+ return $ JSNumericLiteral (Left (-i))
429+ go js@(JSNumericLiteral (Left i)) =
430+ let minInt = -2147483648
431+ maxInt = 2147483647
432+ in if i < minInt || i > maxInt
433+ then throwError . errorMessage $ IntOutOfRange i "JavaScript" minInt maxInt
434+ else return js
435+ go other = return other