07eacbd · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

Merge branch 'master' into pure11

commit07eacbd32678c5c9c76d7305cedc73eaaf16e38b authorAndy Arvanitis <andyarvanitis@gmail.com> dateTue 22 Dec 2015, 20:14 (11 years ago) parenta27f04d 6587019

12 files changed+72−59

compare with golang

unifiedsplit

examples/failing/IntOutOfRange.purs+1−1 examples/passing/NegativeIntInRange.purs+8 psc/JSON.hs+1−1 psci/Completion.hs+1−1 psci/PSCi.hs+1−1 psci/tests/Main.hs+2−2 src/Language/PureScript/AST/Declarations.hs+4−6 src/Language/PureScript/CodeGen/JS.hs+30−13 src/Language/PureScript/Errors.hs+15−20 src/Language/PureScript/Linter/Imports.hs+3−8 src/Language/PureScript/Parser/Declarations.hs+3−3 src/Language/PureScript/Sugar/Names/Imports.hs+3−3

examples/failing/IntOutOfRange.purs+1−1

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

33module Main where

55n :: Int

6−n = 35028715023

6+n = 2147483648

examples/passing/NegativeIntInRange.pursnew file+8

@@ -0,0 +1,8 @@

1+module Main where

3+import Prelude

5+n :: Int

6+n = -2147483648

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

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

5454toJSONError verbose level e =

5555 JSONError (toErrorPosition <$> sspan)

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

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

5757 (P.errorCode e)

5858 (P.spanName <$> sspan)

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

psci/Completion.hs+1−1

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

171171 qualificationsUsing (_, importType, asQ') =

172172 let q = qualifyWith asQ'

173173 in case importType of

174− P.Implicit _ -> [q]

174+ P.Implicit -> [q]

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

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

177177

psci/PSCi.hs+1−1

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

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

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

319319

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

320+ showDeclType P.Implicit = ""

321321 showDeclType (P.Explicit refs) = refsList refs

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

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

psci/tests/Main.hs+2−2

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

141141 Left err ->

142142 print err >> exitFailure

143143 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)]

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

146146

147147controlMonadSTasST :: ImportedModule

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

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

149149 where

150150 s = P.moduleNameFromString

151151

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

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

4747addDefaultImport :: ModuleName -> Module -> Module

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

4949 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

5151 where

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

5353 isExistingImport (PositionedDeclaration _ _ d) = isExistingImport d

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

130130--

131131data ImportDeclarationType

132132 -- |

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

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

135− -- raised for each member implicitly imported.

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

136134 --

137− = Implicit Bool

135+ = Implicit

138136 -- |

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

140138 --

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

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

147145

148146isImplicit :: ImportDeclarationType -> Bool

149−isImplicit (Implicit _) = True

147+isImplicit Implicit = True

150148isImplicit _ = False

151149

152150-- |

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

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

1010 ( module AST

1111 , module Common

1212 , moduleToJs

13− , mainCall

1413 ) where

1514

1615import Prelude ()

@@ -19,10 +18,11 @@ import Prelude.Compat

1918import Data.List ((\\), delete, intersect)

2019import Data.Maybe (isNothing, fromMaybe)

2120import 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

2323

2424import Control.Arrow ((&&&))

25−import Control.Monad (replicateM, forM)

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

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

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

2828import Control.Monad.Supply.Class

@@ -45,8 +45,12 @@ import System.FilePath.Posix ((</>))

4545-- Generate code in the simplified Javascript intermediate representation for all declarations in a

4646-- module.

4747--

48−moduleToJs :: forall m. (Applicative m, Monad m, MonadReader Options m, MonadSupply m, MonadError MultipleErrors m)

49− => Module Ann -> Maybe JS -> m [JS]

48+moduleToJs

49+ :: forall m

50+ . (Applicative m, Monad m, MonadReader Options m, MonadSupply m, MonadError MultipleErrors m)

51+ => Module Ann

52+ -> Maybe JS

53+ -> m [JS]

5054moduleToJs (Module coms mn imps exps foreigns decls) foreign_ =

5155 rethrow (addHint (ErrorInModule mn)) $ do

5256 let usedNames = concatMap getNames decls

@@ -55,6 +59,7 @@ moduleToJs (Module coms mn imps exps foreigns decls) foreign_ =

5559 let decls' = renameModules mnLookup decls

5660 jsDecls <- mapM bindToJs decls'

5761 optimized <- T.traverse (T.traverse optimize) jsDecls

62+ F.traverse_ (F.traverse_ checkIntegers) optimized

5863 comments <- not <$> asks optionsNoComments

5964 let strict = JSStringLiteral "use strict"

6065 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_ =

256261 iife v exprs = JSApp (JSFunction Nothing [] (JSBlock $ exprs ++ [JSReturn $ JSVar v])) []

257262

258263 literalToValueJS :: Literal (Expr Ann) -> m JS

259− literalToValueJS (NumericLiteral (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)

264+ literalToValueJS (NumericLiteral (Left i)) = return $ JSNumericLiteral (Left i)

265265 literalToValueJS (NumericLiteral (Right n)) = return $ JSNumericLiteral (Right n)

266266 literalToValueJS (StringLiteral s) = return $ JSStringLiteral s

267267 literalToValueJS (CharLiteral c) = return $ JSStringLiteral [c]

@@ -414,5 +414,22 @@ moduleToJs (Module coms mn imps exps foreigns decls) foreign_ =

414414 js <- binderToJs elVar done'' binder

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

416416

417−mainCall :: ModuleName -> String -> JS

418−mainCall mmi ns = JSApp (JSAccessor C.main (JSAccessor (moduleNameToJs mmi) (JSVar ns))) []

417+ -- Check that all integers fall within the valid int range for JavaScript.

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

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

413413 gHint other = pure other

414414

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

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

417−

418415-- |

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

420417--

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

422−prettyPrintSingleError full level e = do

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

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

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

424421 um <- get

425422 return (prettyPrintErrorMessage um em)

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

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

10151012 prettyPrintImport mn idt qual =

10161013 let i = case idt of

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

1018− Implicit False -> runModuleName mn

1014+ Implicit -> runModuleName mn

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

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

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

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

10611057

10621058-- | Pretty print warnings as a Box

10631059prettyPrintMultipleWarningsBox :: 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

10651061

10661062-- | Pretty print errors as a Box

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

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

1069−

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

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

1072− result <- prettyPrintSingleError full level e

1073− return $

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

1075− , result

1076− ]

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

1078− result <- forM es $ prettyPrintSingleError full level

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

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

1065+

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

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

1068+ let result = prettyPrintSingleError full level e

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

1070+ , result

1071+ ]

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

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

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

10801075 where

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

10821077 , Box.moveRight 2 err

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

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

77import Prelude.Compat

99import qualified Data.Map as M

10−import Data.Maybe (mapMaybe)

10+import Data.Maybe (mapMaybe, isNothing)

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

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

1313import Control.Monad.Writer.Class

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

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

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

6060 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

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

6363 usedDctors = mapMaybe (matchDctor qualifierName) names

6464 in case declType of

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

66− Implicit False ->

65+ Implicit | isNothing qualifierName ->

6766 let classRefs = TypeClassRef <$> mapMaybe getClassName names

6867 valueRefs = ValueRef <$> mapMaybe getIdentName names

6968 types = mapMaybe getTypeName names

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

9695

9796 _ -> return ()

9897 where

99− sugarNames :: ModuleName -> [ Name ]

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

101− sugarNames _ = []

102−

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

10499 reconstructTypeRefs mni = foldr accumDctors M.empty

105100 where

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

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

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

153153 qualifyingList expectedType = do

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

155− return $ fromMaybe (Implicit False) declType

155+ return $ fromMaybe Implicit declType

156156

157157parseDeclarationRef :: TokenParser DeclarationRef

158158parseDeclarationRef =

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

322322 return (name, b)

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

324324 where

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

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

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

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

327327

328328parseAbs :: TokenParser Expr

329329parseAbs = do

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

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

9898

9999 return ()

100100

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

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

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

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

104104

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

138138 updateImportRef (ImportDeclaration mn typ qual isOldSyntax) = do

139139 modExports <- getExports env mn

140140 typ' <- case typ of

141− Implicit b -> return $ Implicit b

141+ Implicit -> return Implicit

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

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

144144 return $ ImportDeclaration mn typ' qual isOldSyntax

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

191191 where

192192

193193 resolveByType :: ImportDeclarationType -> m Imports

194− resolveByType (Implicit _) = importAll importExplicit

194+ resolveByType Implicit = importAll importExplicit

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

196196 resolveByType (Hiding refs) = do

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