eb5d4e4 · rowtype-yoga/purescript-native

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

Merge branch 'master' into pure11

commiteb5d4e4e34ee088582fdeabf971e975c013ba1bb authorAndy Arvanitis <andyarvanitis@gmail.com> dateSun 3 Apr 2016, 14:46 (11 years ago) parent12fdbae cf11462

6 files changed+46−51

compare with golang

unifiedsplit

examples/passing/1991.purs+20 psc-bundle/Main.hs+5−16 psc-docs/Main.hs+5−15 psc-publish/Main.hs+6−1 psc/Main.hs+5−16 src/Language/PureScript/TypeChecker/Types.hs+5−3

examples/passing/1991.pursnew file+20

@@ -0,0 +1,20 @@

1+module Main where

3+import Prelude

5+singleton :: forall a. a -> Array a

6+singleton x = [x]

8+empty :: forall a. Array a

9+empty = []

10+

11+foldMap :: forall a m. (Semigroup m) => (a -> m) -> Array a -> m

12+foldMap f [a, b, c, d, e] = f a <> f b <> f c <> f d <> f e

13+

14+regression :: Array Int

15+regression =

16+ let as = [1,2,3,4,5]

17+ as' = foldMap (\x -> if 1 < x && x < 4 then singleton x else empty) as

18+ in as'

19+

20+main = Control.Monad.Eff.Console.log "Done"

psc-bundle/Main.hs+5−16

@@ -1,25 +1,12 @@

1−-----------------------------------------------------------------------------

2−--

3−-- Module : psc-bundle

4−-- Copyright : (c) Phil Freeman 2015

5−-- License : MIT

6−--

7−-- Maintainer : Phil Freeman <paf31@cantab.net>

8−-- Stability : experimental

9−-- Portability :

10−--

11−-- | Bundles compiled PureScript modules for the browser.

12−--

13−-----------------------------------------------------------------------------

14−

151{-# LANGUAGE FlexibleContexts #-}

162{-# LANGUAGE ScopedTypeVariables #-}

173{-# LANGUAGE TupleSections #-}

184{-# LANGUAGE RecordWildCards #-}

195

6+-- | Bundles compiled PureScript modules for the browser.

207module Main (main) where

218

22−import Data.Maybe

9+import Data.Maybe

2310import Data.Traversable (for)

2411import Data.Version (showVersion)

2512

@@ -32,7 +19,7 @@ import Control.Monad.IO.Class

3219import System.FilePath (takeFileName, takeDirectory)

3320import System.FilePath.Glob (glob)

3421import System.Exit (exitFailure)

35−import System.IO (stderr, hPutStrLn)

22+import System.IO (stderr, stdout, hPutStrLn, hSetEncoding, utf8)

3623import System.Directory (createDirectoryIfMissing)

3724

3825import Language.PureScript.Bundle

@@ -125,6 +112,8 @@ options = Options <$> some inputFile

125112-- | Make it go.

126113main :: IO ()

127114main = do

115+ hSetEncoding stdout utf8

116+ hSetEncoding stderr utf8

128117 opts <- execParser (info (version <*> helper <*> options) infoModList)

129118 when (isJust (optionsRequirePath opts)) $ hPutStrLn stderr "The require-path option is deprecated and will be removed in PureScript 0.9."

130119 output <- runExceptT (app opts)

psc-docs/Main.hs+5−15

@@ -1,17 +1,4 @@

11{-# LANGUAGE TupleSections #-}

2−----------------------------------------------------------------------------

3−--

4−-- Module : Main

5−-- Copyright : (c) Phil Freeman 2013

6−-- License : MIT

7−--

8−-- Maintainer : Phil Freeman <paf31@cantab.net>

9−-- Stability : experimental

10−-- Portability :

11−--

12−-- |

13−--

14−-----------------------------------------------------------------------------

152

163module Main where

174

@@ -32,7 +19,7 @@ import qualified Text.PrettyPrint.ANSI.Leijen as PP

3219import qualified Language.PureScript as P

3320import qualified Paths_purescript as Paths

3421import System.Exit (exitFailure)

35−import System.IO (hPutStrLn, hPrint, stderr)

22+import System.IO (hPutStrLn, hPrint, hSetEncoding, stderr, stdout, utf8)

3623import System.Directory (createDirectoryIfMissing)

3724import System.FilePath (takeDirectory)

3825import System.FilePath.Glob (glob)

@@ -228,7 +215,10 @@ buildOptions (fmt, input, mapping) =

228215 exitFailure

229216

230217main :: IO ()

231−main = execParser opts >>= buildOptions >>= docgen

218+main = do

219+ hSetEncoding stdout utf8

220+ hSetEncoding stderr utf8

221+ execParser opts >>= buildOptions >>= docgen

232222 where

233223 opts = info (version <*> helper <*> pscDocsOptions) infoModList

234224 infoModList = fullDesc <> headerInfo <> footerInfo

psc-publish/Main.hs+6−1

@@ -7,6 +7,8 @@ import qualified Data.ByteString.Lazy.Char8 as BL

88import Options.Applicative hiding (str)

10+import System.IO (hSetEncoding, stderr, stdout, utf8)

11+

1012import qualified Paths_purescript as Paths

1113import Language.PureScript.Publish

1214import Language.PureScript.Publish.ErrorsWarnings

@@ -24,7 +26,10 @@ dryRunOptions = defaultPublishOptions

2426 where dummyVersion = ("0.0.0", Version [0,0,0] [])

2527

2628main :: IO ()

27−main = execParser opts >>= publish

29+main = do

30+ hSetEncoding stdout utf8

31+ hSetEncoding stderr utf8

32+ execParser opts >>= publish

2833 where

2934 opts = info (version <*> helper <*> dryRun) infoModList

3035 infoModList = fullDesc <> headerInfo <> footerInfo

psc/Main.hs+5−16

@@ -1,17 +1,3 @@

1−-----------------------------------------------------------------------------

2−--

3−-- Module : Main

5−-- License : MIT (http://opensource.org/licenses/MIT)

6−--

7−-- Maintainer : Phil Freeman <paf31@cantab.net>

8−-- Stability : experimental

9−-- Portability :

10−--

11−-- |

12−--

13−-----------------------------------------------------------------------------

14−

151{-# LANGUAGE DataKinds #-}

162{-# LANGUAGE FlexibleContexts #-}

173{-# LANGUAGE RecordWildCards #-}

@@ -34,7 +20,7 @@ import qualified Data.ByteString.UTF8 as BU8

3420import Options.Applicative as Opts

3521

3622import System.Exit (exitSuccess, exitFailure)

37−import System.IO (hPutStrLn, stderr)

23+import System.IO (hSetEncoding, hPutStrLn, stdout, stderr, utf8)

3824import System.IO.UTF8

3925import System.FilePath.Glob (glob)

4026

@@ -202,7 +188,10 @@ pscMakeOptions = PSCMakeOptions <$> many inputFile

202188 <*> jsonErrors

203189

204190main :: IO ()

205−main = execParser opts >>= compile

191+main = do

192+ hSetEncoding stdout utf8

193+ hSetEncoding stderr utf8

194+ execParser opts >>= compile

206195 where

207196 opts = info (version <*> helper <*> pscMakeOptions) infoModList

208197 infoModList = fullDesc <> headerInfo <> footerInfo

src/Language/PureScript/TypeChecker/Types.hs+5−3

@@ -179,7 +179,7 @@ overTypes f = let (_, f', _) = everywhereOnValues id g id in f'

179179 g (TypedValue checkTy val t) = TypedValue checkTy val (f t)

180180 g (TypeClassDictionary (nm, tys) sco) = TypeClassDictionary (nm, map f tys) sco

181181 g other = other

182−

182+

183183-- | Check the kind of a type, failing if it is not of kind *.

184184checkTypeKind ::

185185 (MonadState CheckState m, MonadError MultipleErrors m) =>

@@ -283,8 +283,10 @@ infer' (IfThenElse cond th el) = do

283283 cond' <- check cond tyBoolean

284284 th'@(TypedValue _ _ thTy) <- infer th

285285 el'@(TypedValue _ _ elTy) <- infer el

286− unifyTypes thTy elTy

287− return $ TypedValue True (IfThenElse cond' th' el') thTy

286+ (th'', thTy') <- instantiatePolyTypeWithUnknowns th' thTy

287+ (el'', elTy') <- instantiatePolyTypeWithUnknowns el' elTy

288+ unifyTypes thTy' elTy'

289+ return $ TypedValue True (IfThenElse cond' th'' el'') thTy'

288290infer' (Let ds val) = do

289291 (ds', val'@(TypedValue _ _ valTy)) <- inferLetBinding [] ds val infer

290292 return $ TypedValue True (Let ds' val') valTy