07eacbd · rowtype-yoga/purescript-native

examples/failing/IntOutOfRange.purs+1−1

compare with golang

unifiedsplit

@@ -3,4 +3,4 @@

3module Main where

4

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"

psc/JSON.hs+1−1

@@ -53,7 +53,7 @@ toJSONErrors verbose level = map (toJSONError verbose level) . P.runMultipleErro

53toJSONError :: Bool -> P.Level -> P.ErrorMessage -> JSONError

54toJSONError verbose level e =

55 JSONError (toErrorPosition <$> sspan)

56− (P.renderBox (P.prettyPrintSingleError' verbose level (P.stripModuleAndSpan e)))

56+ (P.renderBox (P.prettyPrintSingleError verbose level (P.stripModuleAndSpan e)))

57 (P.errorCode e)

58 (P.spanName <$> sspan)

59 (P.runModuleName <$> P.errorModule e)

psci/Completion.hs+1−1

@@ -171,7 +171,7 @@ getAllQualifications sho m (declName, decl) = do

171 qualificationsUsing (_, importType, asQ') =

172 let q = qualifyWith asQ'

173 in case importType of

174− P.Implicit _ -> [q]

174+ P.Implicit -> [q]

175 P.Explicit refs -> [q | referencedBy refs]

176 P.Hiding refs -> [q | not $ referencedBy refs]

177

psci/PSCi.hs+1−1

@@ -317,7 +317,7 @@ handleShowImportedModules = do

317 Just mn' -> "qualified " ++ N.runModuleName mn ++ " as " ++ N.runModuleName mn'

318 Nothing -> N.runModuleName mn ++ " " ++ showDeclType declType

319

320− showDeclType (P.Implicit _) = ""

320+ showDeclType P.Implicit = ""

321 showDeclType (P.Explicit refs) = refsList refs

322 showDeclType (P.Hiding refs) = " hiding " ++ refsList refs

323 refsList refs = " (" ++ commaList (map showRef refs) ++ ")"

psci/tests/Main.hs+2−2

@@ -141,11 +141,11 @@ getPSCiState = do

141 Left err ->

142 print err >> exitFailure

143 Right modules ->

144− let imports = [controlMonadSTasST, (P.ModuleName [P.ProperName "Prelude"], P.Implicit True, Nothing)]

144+ let imports = [controlMonadSTasST, (P.ModuleName [P.ProperName "Prelude"], P.Implicit, Nothing)]

145 in return (mkPSCiState imports modules foreigns [] [])

146

147controlMonadSTasST :: ImportedModule

148−controlMonadSTasST = (s "Control.Monad.ST", P.Implicit True, Just (s "ST"))

148+controlMonadSTasST = (s "Control.Monad.ST", P.Implicit, Just (s "ST"))

149 where

150 s = P.moduleNameFromString

151

src/Language/PureScript/AST/Declarations.hs+4−6

@@ -47,7 +47,7 @@ getModuleName (Module _ _ name _ _) = name

47addDefaultImport :: ModuleName -> Module -> Module

48addDefaultImport toImport m@(Module ss coms mn decls exps) =

49 if isExistingImport `any` decls || mn == toImport then m

50− else Module ss coms mn (ImportDeclaration toImport (Implicit True) Nothing False : decls) exps

50+ else Module ss coms mn (ImportDeclaration toImport Implicit Nothing False : decls) exps

51 where

52 isExistingImport (ImportDeclaration mn' _ _ _) | mn' == toImport = True

53 isExistingImport (PositionedDeclaration _ _ d) = isExistingImport d

@@ -130,11 +130,9 @@ findDuplicateRefs refs =

130--

131data ImportDeclarationType

132 -- |

133− -- An import with no explicit list: `import M`. The boolean signifies whether

133+ -- An import with no explicit list: `import M`.

134− -- the import was generated by the compiler. If not, a warning is

135− -- raised for each member implicitly imported.

136 --

134 --

137− = Implicit Bool

135+ = Implicit

138 -- |

136 -- |

139 -- An import with an explicit list of references to import: `import M (foo)`

137 -- An import with an explicit list of references to import: `import M (foo)`

140 --

138 --

@@ -146,7 +144,7 @@ data ImportDeclarationType

146 deriving (Eq, Show, Read, D.Data, D.Typeable)

144 deriving (Eq, Show, Read, D.Data, D.Typeable)

147

145

148isImplicit :: ImportDeclarationType -> Bool

146isImplicit :: ImportDeclarationType -> Bool

149−isImplicit (Implicit _) = True

147+isImplicit Implicit = True

150isImplicit _ = False

148isImplicit _ = False

151

149

152-- |

150-- |

src/Language/PureScript/CodeGen/JS.hs+30−13

@@ -10,7 +10,6 @@ module Language.PureScript.CodeGen.JS

10 ( module AST

11 , module Common

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

24import Control.Arrow ((&&&))

25−import Control.Monad (replicateM, forM)

25+import Control.Monad (replicateM, forM, void)

26import Control.Monad.Error.Class (MonadError(..))

27import Control.Monad.Reader (MonadReader, asks)

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

46-- module.

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)

266 literalToValueJS (StringLiteral s) = return $ JSStringLiteral s

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

415 return (JSVariableIntroduction elVar (Just (JSIndexer (JSNumericLiteral (Left index)) (JSVar varName))) : js)

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

src/Language/PureScript/Errors.hs+15−20

@@ -412,14 +412,11 @@ onTypesInErrorMessageM f (ErrorMessage hints simple) = ErrorMessage <$> traverse

412 gHint (ErrorInInstance cl ts) = ErrorInInstance cl <$> traverse f ts

413 gHint other = pure other

414

415−prettyPrintSingleError' :: Bool -> Level -> ErrorMessage ->Box.Box

416−prettyPrintSingleError' full level = flip evalState defaultUnknownMap . prettyPrintSingleError full level

417−

418-- |

415-- |

419-- Pretty print a single error, simplifying if necessary

416-- Pretty print a single error, simplifying if necessary

420--

417--

421−prettyPrintSingleError :: Bool -> Level -> ErrorMessage -> State TypeMap Box.Box

418+prettyPrintSingleError :: Bool -> Level -> ErrorMessage -> Box.Box

422−prettyPrintSingleError full level e = do

419+prettyPrintSingleError full level e = flip evalState defaultUnknownMap $ do

423 em <- onTypesInErrorMessageM replaceUnknowns (if full then e else simplifyErrorMessage e)

420 em <- onTypesInErrorMessageM replaceUnknowns (if full then e else simplifyErrorMessage e)

424 um <- get

421 um <- get

425 return (prettyPrintErrorMessage um em)

422 return (prettyPrintErrorMessage um em)

@@ -1014,8 +1011,7 @@ prettyPrintSingleError full level e = do

1014 prettyPrintImport :: ModuleName -> ImportDeclarationType -> Maybe ModuleName -> String

1011 prettyPrintImport :: ModuleName -> ImportDeclarationType -> Maybe ModuleName -> String

1015 prettyPrintImport mn idt qual =

1012 prettyPrintImport mn idt qual =

1016 let i = case idt of

1013 let i = case idt of

1017− Implicit True -> runModuleName mn ++ " (..)"

1018− Implicit False -> runModuleName mn

1014+ Implicit -> runModuleName mn

1019 Explicit refs -> runModuleName mn ++ " (" ++ intercalate ", " (map prettyPrintRef refs) ++ ")"

1015 Explicit refs -> runModuleName mn ++ " (" ++ intercalate ", " (map prettyPrintRef refs) ++ ")"

1020 Hiding refs -> runModuleName mn ++ " hiding (" ++ intercalate "," (map prettyPrintRef refs) ++ ")"

1016 Hiding refs -> runModuleName mn ++ " hiding (" ++ intercalate "," (map prettyPrintRef refs) ++ ")"

1021 in i ++ maybe "" (\q -> " as " ++ runModuleName q) qual

1017 in i ++ maybe "" (\q -> " as " ++ runModuleName q) qual

@@ -1061,22 +1057,21 @@ prettyPrintMultipleWarnings full = renderBox . prettyPrintMultipleWarningsBox fu

1061

1057

1062-- | Pretty print warnings as a Box

1058-- | Pretty print warnings as a Box

1063prettyPrintMultipleWarningsBox :: Bool -> MultipleErrors -> Box.Box

1059prettyPrintMultipleWarningsBox :: Bool -> MultipleErrors -> Box.Box

1064−prettyPrintMultipleWarningsBox full = flip evalState defaultUnknownMap . prettyPrintMultipleErrorsWith Warning "Warning found:" "Warning" full

1060+prettyPrintMultipleWarningsBox full = prettyPrintMultipleErrorsWith Warning "Warning found:" "Warning" full

1065

1061

1066-- | Pretty print errors as a Box

1062-- | Pretty print errors as a Box

1067prettyPrintMultipleErrorsBox :: Bool -> MultipleErrors -> Box.Box

1063prettyPrintMultipleErrorsBox :: Bool -> MultipleErrors -> Box.Box

1068−prettyPrintMultipleErrorsBox full = flip evalState defaultUnknownMap . prettyPrintMultipleErrorsWith Error "Error found:" "Error" full

1064+prettyPrintMultipleErrorsBox full = prettyPrintMultipleErrorsWith Error "Error found:" "Error" full

1069−

1065+

1070−prettyPrintMultipleErrorsWith :: Level -> String -> String -> Bool -> MultipleErrors -> State TypeMap Box.Box

1066+prettyPrintMultipleErrorsWith :: Level -> String -> String -> Bool -> MultipleErrors -> Box.Box

1071−prettyPrintMultipleErrorsWith level intro _ full (MultipleErrors [e]) = do

1067+prettyPrintMultipleErrorsWith level intro _ full (MultipleErrors [e]) =

1072− result <- prettyPrintSingleError full level e

1068+ let result = prettyPrintSingleError full level e

1073− return $

1074− Box.vcat Box.left [ Box.text intro

1069+ in Box.vcat Box.left [ Box.text intro

1075− , result

1070+ , result

1076− ]

1071+ ]

1077−prettyPrintMultipleErrorsWith level _ intro full (MultipleErrors es) = do

1072+prettyPrintMultipleErrorsWith level _ intro full (MultipleErrors es) =

1078− result <- forM es $ prettyPrintSingleError full level

1073+ let result = map (prettyPrintSingleError full level) es

1079− return $ Box.vsep 1 Box.left $ concat $ zipWith withIntro [1 :: Int ..] result

1074+ in Box.vsep 1 Box.left $ concat $ zipWith withIntro [1 :: Int ..] result

1080 where

1075 where

1081 withIntro i err = [ Box.text (intro ++ " " ++ show i ++ " of " ++ show (length es) ++ ":")

1076 withIntro i err = [ Box.text (intro ++ " " ++ show i ++ " of " ++ show (length es) ++ ":")

1082 , Box.moveRight 2 err

1077 , Box.moveRight 2 err

src/Language/PureScript/Linter/Imports.hs+3−8

@@ -7,7 +7,7 @@ import Prelude ()

7import Prelude.Compat

8

9import qualified Data.Map as M

10−import Data.Maybe (mapMaybe)

10+import Data.Maybe (mapMaybe, isNothing)

11import Data.List ((\\), find, intersect, nub)

12import Control.Monad.Error.Class (MonadError(..))

13import Control.Monad.Writer.Class

@@ -58,12 +58,11 @@ findUnusedImports (Module _ _ _ mdecls mexports) env usedImps = do

58 forM_ (M.toAscList imps) $ \(mni, decls) -> unless (mni `elem` alwaysUsedModules) $

59 forM_ decls $ \(ss, declType, qualifierName) ->

60 censor (onErrorMessages $ addModuleLocError ss) $ unless (qnameUsed qualifierName) $

61− let names = nub $ sugarNames mni ++ M.findWithDefault [] mni usedImps

61+ let names = nub $ M.findWithDefault [] mni usedImps

62 usedNames = mapMaybe (matchName (typeForDCtor mni) qualifierName) names

63 usedDctors = mapMaybe (matchDctor qualifierName) names

64 in case declType of

65− Implicit _ | null usedNames -> tell $ errorMessage $ UnusedImport mni

65+ Implicit | isNothing qualifierName ->

66− Implicit False ->

67 let classRefs = TypeClassRef <$> mapMaybe getClassName names

66 let classRefs = TypeClassRef <$> mapMaybe getClassName names

68 valueRefs = ValueRef <$> mapMaybe getIdentName names

67 valueRefs = ValueRef <$> mapMaybe getIdentName names

69 types = mapMaybe getTypeName names

68 types = mapMaybe getTypeName names

@@ -96,10 +95,6 @@ findUnusedImports (Module _ _ _ mdecls mexports) env usedImps = do

96

95

97 _ -> return ()

96 _ -> return ()

98 where

97 where

99− sugarNames :: ModuleName -> [ Name ]

100− sugarNames (ModuleName [ProperName n]) | n == C.prelude = [ IdentName $ Qualified Nothing (Ident C.bind) ]

101− sugarNames _ = []

102−

103 reconstructTypeRefs :: ModuleName -> [ProperName] -> M.Map ProperName [ProperName]

98 reconstructTypeRefs :: ModuleName -> [ProperName] -> M.Map ProperName [ProperName]

104 reconstructTypeRefs mni = foldr accumDctors M.empty

99 reconstructTypeRefs mni = foldr accumDctors M.empty

105 where

100 where

src/Language/PureScript/Parser/Declarations.hs+3−3

@@ -152,7 +152,7 @@ parseImportDeclaration' = do

152 return (moduleName', declType, Just qName, True)

153 qualifyingList expectedType = do

154 declType <- P.optionMaybe (expectedType <$> (indented *> parens (commaSep parseDeclarationRef)))

155− return $ fromMaybe (Implicit False) declType

155+ return $ fromMaybe Implicit declType

156

157parseDeclarationRef :: TokenParser DeclarationRef

158parseDeclarationRef =

@@ -322,8 +322,8 @@ parseIdentifierAndValue =

322 return (name, b)

323 <|> (,) <$> (C.indented *> stringLiteral) <*> rest

324 where

325− rest = C.indented *> colon *> C.indented *> val

325+ rest = C.indented *> colon *> C.indented *> val

326− val = (underscore *> pure Nothing) <|> (Just <$> parseValue)

326+ val = P.try (Just <$> parseValue) <|> (underscore *> pure Nothing)

327

328parseAbs :: TokenParser Expr

329parseAbs = do

src/Language/PureScript/Sugar/Names/Imports.hs+3−3

@@ -98,7 +98,7 @@ resolveImports env (Module ss coms currentModule decls exps) =

98

99 return ()

100

101− let scope = M.insert currentModule [(Nothing, Implicit True, Nothing)] imports

101+ let scope = M.insert currentModule [(Nothing, Implicit, Nothing)] imports

102 resolved <- foldM (resolveModuleImport env) nullImports (M.toList scope)

103 return (Module ss coms currentModule decls' exps, resolved)

104

@@ -138,7 +138,7 @@ resolveImports env (Module ss coms currentModule decls exps) =

138 updateImportRef (ImportDeclaration mn typ qual isOldSyntax) = do

139 modExports <- getExports env mn

140 typ' <- case typ of

141− Implicit b -> return $ Implicit b

141+ Implicit -> return Implicit

142 Explicit refs -> Explicit <$> updateProperRef mn modExports `traverse` refs

143 Hiding refs -> Hiding <$> updateProperRef mn modExports `traverse` refs

144 return $ ImportDeclaration mn typ' qual isOldSyntax

@@ -191,7 +191,7 @@ resolveImport importModule exps imps impQual = resolveByType

191 where

192

193 resolveByType :: ImportDeclarationType -> m Imports

194− resolveByType (Implicit _) = importAll importExplicit

194+ resolveByType Implicit = importAll importExplicit

195 resolveByType (Explicit refs) = checkRefs False refs >> foldM importExplicit imps refs

196 resolveByType (Hiding refs) = do

197 imps' <- checkRefs True refs >> importAll (importNonHidden refs)