fe55e94 · rowtype-yoga/purescript-native

psc-make/Main.hs+4−4

compare with golang

unifiedsplit

@@ -17,7 +17,7 @@

17module Main where

18

19import Control.Applicative

20−import Control.Monad.Error

20+import Control.Monad.Except

21import Control.Monad.Reader

22

23import Data.Version (showVersion)

@@ -52,14 +52,14 @@ readInput InputOptions{..} = do

52 content <- forM ioInputFiles $ \inFile -> (Right inFile, ) <$> readFile inFile

53 return (if ioNoPrelude then content else (Left P.RebuildNever, P.prelude) : content)

54

55−newtype Make a = Make { unMake :: ReaderT (P.Options P.Make) (ErrorT String IO) a }

55+newtype Make a = Make { unMake :: ReaderT (P.Options P.Make) (ExceptT String IO) a }

56 deriving (Functor, Applicative, Monad, MonadIO, MonadError String, MonadReader (P.Options P.Make))

57

58runMake :: P.Options P.Make -> Make a -> IO (Either String a)

59−runMake opts = runErrorT . flip runReaderT opts . unMake

59+runMake opts = runExceptT . flip runReaderT opts . unMake

60

61makeIO :: IO a -> Make a

62−makeIO = Make . lift . ErrorT . fmap (either (Left . show) Right) . tryIOError

62+makeIO = Make . lift . ExceptT . fmap (either (Left . show) Right) . tryIOError

63

64instance P.MonadMake Make where

65 getTimestamp path = makeIO $ do

psc/Main.hs+1−1

@@ -17,7 +17,7 @@

17module Main where

18

19import Control.Applicative

20−import Control.Monad.Error

20+import Control.Monad.Except

21import Control.Monad.Reader

22

23import Data.Maybe (fromMaybe)

psci/Main.hs+4−4

@@ -31,7 +31,7 @@ import qualified Data.Map as M

31

32import Control.Applicative

33import Control.Monad

34−import Control.Monad.Error (ErrorT(..), MonadError)

34+import Control.Monad.Except (ExceptT(..), MonadError, runExceptT)

35import Control.Monad.Reader (MonadReader, ReaderT, runReaderT)

36import Control.Monad.Trans.Class

37import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)

@@ -325,14 +325,14 @@ newtype PSCI a = PSCI { runPSCI :: InputT (StateT PSCiState IO) a } deriving (Fu

325psciIO :: IO a -> PSCI a

326psciIO io = PSCI . lift $ lift io

327

328−newtype Make a = Make { unMake :: ReaderT (P.Options P.Make) (ErrorT String IO) a }

328+newtype Make a = Make { unMake :: ReaderT (P.Options P.Make) (ExceptT String IO) a }

329 deriving (Functor, Applicative, Monad, MonadError String, MonadReader (P.Options P.Make))

330

331runMake :: Make a -> IO (Either String a)

332−runMake = runErrorT . flip runReaderT options . unMake

332+runMake = runExceptT . flip runReaderT options . unMake

333

334makeIO :: IO a -> Make a

335−makeIO = Make . lift . ErrorT . fmap (either (Left . show) Right) . tryIOError

335+makeIO = Make . lift . ExceptT . fmap (either (Left . show) Right) . tryIOError

336

337instance P.MonadMake Make where

338 getTimestamp path = makeIO $ do

purescript.cabal+9−8

@@ -31,10 +31,9 @@ library

31 filepath -any,

32 mtl >= 2.1.0 && < 2.3.0,

33 parsec -any,

34− transformers >= 0.3 && < 0.5,

34+ transformers >= 0.4.0 && < 0.5,

35 utf8-string >= 1 && < 2,

36 pattern-arrows >= 0.0.2 && < 0.1,

37− monad-unify >= 0.2.2 && < 0.3,

38 file-embed >= 0.0.7 && < 0.0.8,

37 file-embed >= 0.0.7 && < 0.0.8,

39 time -any

38 time -any

40 exposed-modules: Language.PureScript

39 exposed-modules: Language.PureScript

@@ -111,11 +110,13 @@ library

111 Language.PureScript.TypeChecker.Unify

110 Language.PureScript.TypeChecker.Unify

112 Language.PureScript.TypeClassDictionaries

111 Language.PureScript.TypeClassDictionaries

113 Language.PureScript.Types

112 Language.PureScript.Types

113+

114+ Control.Monad.Unify

114 exposed: True

115 exposed: True

115 buildable: True

116 buildable: True

116 hs-source-dirs: src

117 hs-source-dirs: src

117 other-modules: Paths_purescript

118 other-modules: Paths_purescript

118− ghc-options: -Wall -fno-warn-warnings-deprecations -O2

119+ ghc-options: -Wall -O2

119

120

120executable psc

121executable psc

121 build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,

122 build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,

@@ -125,7 +126,7 @@ executable psc

125 buildable: True

126 buildable: True

126 hs-source-dirs: psc

127 hs-source-dirs: psc

127 other-modules:

128 other-modules:

128− ghc-options: -Wall -fno-warn-warnings-deprecations -O2 -fno-warn-unused-do-bind

129+ ghc-options: -Wall -O2 -fno-warn-unused-do-bind

129

130

130executable psc-make

131executable psc-make

131 build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,

132 build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,

@@ -135,7 +136,7 @@ executable psc-make

135 buildable: True

136 buildable: True

136 hs-source-dirs: psc-make

137 hs-source-dirs: psc-make

137 other-modules:

138 other-modules:

138− ghc-options: -Wall -fno-warn-warnings-deprecations -O2 -fno-warn-unused-do-bind

139+ ghc-options: -Wall -O2 -fno-warn-unused-do-bind

139

140

140executable psci

141executable psci

141 build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,

142 build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,

@@ -148,7 +149,7 @@ executable psci

148 hs-source-dirs: psci

149 hs-source-dirs: psci

149 other-modules: Commands

150 other-modules: Commands

150 Parser

151 Parser

151− ghc-options: -Wall -fno-warn-warnings-deprecations -O2

152+ ghc-options: -Wall -O2

152

153

153executable psc-docs

154executable psc-docs

154 build-depends: base >=4 && <5, purescript -any,

155 build-depends: base >=4 && <5, purescript -any,

@@ -157,7 +158,7 @@ executable psc-docs

157 buildable: True

158 buildable: True

158 hs-source-dirs: psc-docs

159 hs-source-dirs: psc-docs

159 other-modules:

160 other-modules:

160− ghc-options: -Wall -fno-warn-warnings-deprecations -O2

161+ ghc-options: -Wall -O2

161

162

162executable psc-hierarchy

163executable psc-hierarchy

163 build-depends: base >=4 && <5, purescript -any, optparse-applicative >= 0.10.0,

164 build-depends: base >=4 && <5, purescript -any, optparse-applicative >= 0.10.0,

@@ -166,7 +167,7 @@ executable psc-hierarchy

166 buildable: True

167 buildable: True

167 hs-source-dirs: hierarchy

168 hs-source-dirs: hierarchy

168 other-modules:

169 other-modules:

169− ghc-options: -Wall -fno-warn-warnings-deprecations -O2

170+ ghc-options: -Wall -O2

170

171

171test-suite tests

172test-suite tests

172 build-depends: base >=4 && <5, containers -any, directory -any,

173 build-depends: base >=4 && <5, containers -any, directory -any,

src/Control/Monad/Unify.hsnew file+155

@@ -0,0 +1,155 @@

1+-----------------------------------------------------------------------------

2+--

3+-- Module : Control.Monad.Unify

4+-- Copyright : (c) Phil Freeman 2013

5+-- License : MIT

6+--

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

8+-- Stability : experimental

9+-- Portability :

10+--

11+-- |

12+--

13+--

14+-----------------------------------------------------------------------------

15+

16+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

17+{-# LANGUAGE FlexibleInstances #-}

18+{-# LANGUAGE FlexibleContexts #-}

19+{-# LANGUAGE DeriveDataTypeable #-}

20+{-# LANGUAGE MultiParamTypeClasses #-}

21+{-# LANGUAGE FunctionalDependencies #-}

22+{-# LANGUAGE UndecidableInstances #-}

23+{-# LANGUAGE OverloadedStrings #-}

24+

25+module Control.Monad.Unify where

26+

27+import Data.String (IsString)

28+import Data.Monoid

29+

30+import Control.Applicative

31+import Control.Monad.State

32+import Control.Monad.Error.Class

33+

34+import Data.HashMap.Strict as M

35+

36+-- |

37+-- Untyped unification variables

38+--

39+type Unknown = Int

40+

41+-- |

42+-- A type which can contain unification variables

43+--

44+class Partial t where

45+ unknown :: Unknown -> t

46+ isUnknown :: t -> Maybe Unknown

47+ unknowns :: t -> [Unknown]

48+ ($?) :: Substitution t -> t -> t

49+

50+-- |

51+-- Identifies types which support unification

52+--

53+class (Partial t) => Unifiable m t | t -> m where

54+ (=?=) :: t -> t -> UnifyT t m ()

55+

56+-- |

57+-- A substitution maintains a mapping from unification variables to their values

58+--

59+data Substitution t = Substitution { runSubstitution :: M.HashMap Int t }

60+

61+instance (Partial t) => Monoid (Substitution t) where

62+ mempty = Substitution M.empty

63+ s1 `mappend` s2 = Substitution $

64+ M.map (s2 $?) (runSubstitution s1) `M.union`

65+ M.map (s1 $?) (runSubstitution s2)

66+

67+-- |

68+-- State required for type checking

69+--

70+data UnifyState t = UnifyState {

71+ -- |

72+ -- The next fresh unification variable

73+ --

74+ unifyNextVar :: Int

75+ -- |

76+ -- The current substitution

77+ --

78+ , unifyCurrentSubstitution :: Substitution t

79+ }

80+

81+-- |

82+-- An empty @UnifyState@

83+--

84+defaultUnifyState :: (Partial t) => UnifyState t

85+defaultUnifyState = UnifyState 0 mempty

86+

87+-- |

88+-- The type checking monad, which provides the state of the type checker, and error reporting capabilities

89+--

90+newtype UnifyT t m a = UnifyT { unUnify :: (StateT (UnifyState t) m) a }

91+ deriving (Functor, Monad, Applicative, Alternative, MonadPlus)

92+

93+instance (MonadState s m) => MonadState s (UnifyT t m) where

94+ get = UnifyT . lift $ get

95+ put = UnifyT . lift . put

96+

97+instance (MonadError e m) => MonadError e (UnifyT t m) where

98+ throwError = UnifyT . throwError

99+ catchError e f = UnifyT $ catchError (unUnify e) (unUnify . f)

100+

101+-- |

102+-- Run a computation in the Unify monad, failing with an error, or succeeding with a return value and the new next unification variable

103+--

104+runUnify :: UnifyState t -> UnifyT t m a -> m (a, UnifyState t)

105+runUnify s = flip runStateT s . unUnify

106+

107+-- |

108+-- Substitute a single unification variable

109+--

110+substituteOne :: (Partial t) => Unknown -> t -> Substitution t

111+substituteOne u t = Substitution $ M.singleton u t

112+

113+-- |

114+-- Replace a unification variable with the specified value in the current substitution

115+--

116+(=:=) :: (IsString e, Monad m, MonadError e m, Unifiable m t) => Unknown -> t -> UnifyT t m ()

117+(=:=) u t' = do

118+ st <- UnifyT get

119+ let sub = unifyCurrentSubstitution st

120+ let t = sub $? t'

121+ occursCheck u t

122+ let current = sub $? unknown u

123+ case isUnknown current of

124+ Just u1 | u1 == u -> return ()

125+ _ -> current =?= t

126+ UnifyT $ modify $ \s -> s { unifyCurrentSubstitution = substituteOne u t <> unifyCurrentSubstitution s }

127+

128+-- |

129+-- Perform the occurs check, to make sure a unification variable does not occur inside a value

130+--

131+occursCheck :: (IsString e, Monad m, MonadError e m, Partial t) => Unknown -> t -> UnifyT t m ()

132+occursCheck u t =

133+ case isUnknown t of

134+ Nothing -> when (u `elem` unknowns t) $ UnifyT . lift . throwError $ "Occurs check fails"

135+ _ -> return ()

136+

137+-- |

138+-- Generate a fresh untyped unification variable

139+--

140+fresh' :: (Monad m) => UnifyT t m Unknown

141+fresh' = do

142+ st <- UnifyT get

143+ UnifyT $ modify $ \s -> s { unifyNextVar = succ (unifyNextVar s) }

144+ return $ unifyNextVar st

145+

146+-- |

147+-- Generate a fresh unification variable at a specific type

148+--

149+fresh :: (Monad m, Partial t) => UnifyT t m t

150+fresh = do

151+ u <- fresh'

152+ return $ unknown u

153+

154+

155+

src/Language/PureScript.hs+1−1

@@ -29,7 +29,7 @@ import qualified Data.Set as S

29

30import Control.Applicative

31import Control.Arrow ((&&&))

32−import Control.Monad.Error

32+import Control.Monad.Except

33import Control.Monad.Reader

34

35import System.FilePath ((</>))

src/Language/PureScript/Errors.hs+10−4

@@ -17,10 +17,11 @@

17module Language.PureScript.Errors where

18

19import Data.Either (lefts, rights)

20+import Data.String (IsString(..))

20import Data.List (intersperse, intercalate)

21import Data.List (intersperse, intercalate)

21import Data.Monoid

22import Data.Monoid

22

23

23−import Control.Monad.Error

24+import Control.Monad.Except

24import Control.Applicative ((<$>))

25import Control.Applicative ((<$>))

25

26

26import Language.PureScript.AST

27import Language.PureScript.AST

@@ -73,9 +74,14 @@ instance Monoid ErrorStack where

73 mappend (MultipleErrors es) x = MultipleErrors [ e <> x | e <- es ]

74 mappend (MultipleErrors es) x = MultipleErrors [ e <> x | e <- es ]

74 mappend x (MultipleErrors es) = MultipleErrors [ x <> e | e <- es ]

75 mappend x (MultipleErrors es) = MultipleErrors [ x <> e | e <- es ]

75

76

76−instance Error ErrorStack where

77+-- TODO: Remove strMsg, the IsString instance, and unnecessary

78+-- OverloadedStrings pragmas. See #745

79+-- | Create an ErrorStack from a string

80+strMsg :: String -> ErrorStack

77− strMsg s = ErrorStack [CompileError s Nothing Nothing]

81+strMsg s = ErrorStack [CompileError s Nothing Nothing]

78− noMsg = ErrorStack []

82+

83+instance IsString ErrorStack where

84+ fromString = strMsg

79

85

80prettyPrintErrorStack :: Bool -> ErrorStack -> String

86prettyPrintErrorStack :: Bool -> ErrorStack -> String

81prettyPrintErrorStack printFullStack (ErrorStack es) =

87prettyPrintErrorStack printFullStack (ErrorStack es) =

src/Language/PureScript/ModuleDependencies.hs+1−1

@@ -19,7 +19,7 @@ module Language.PureScript.ModuleDependencies (

19 ModuleGraph

20) where

21

22−import Control.Monad.Error.Class

22+import Control.Monad.Except

23

24import Data.Graph

25import Data.List (nub)

src/Language/PureScript/Sugar/CaseDeclarations.hs+1−1

@@ -24,7 +24,7 @@ import Data.List (nub, groupBy)

24

25import Control.Applicative

26import Control.Monad ((<=<), forM, join, unless, replicateM)

27−import Control.Monad.Error.Class

27+import Control.Monad.Except (throwError)

28

29import Language.PureScript.Names

30import Language.PureScript.AST

src/Language/PureScript/Sugar/Names.hs+1−1

@@ -21,7 +21,7 @@ import Data.Maybe (fromMaybe, isJust, mapMaybe)

21import Data.Monoid ((<>))

22

23import Control.Applicative (Applicative(..), (<$>), (<*>))

24−import Control.Monad.Error

24+import Control.Monad.Except

25

26import qualified Data.Map as M

27

src/Language/PureScript/Sugar/Operators.hs+1−1

@@ -32,7 +32,7 @@ import Language.PureScript.Supply

32

33import Control.Applicative

34import Control.Monad.State

35−import Control.Monad.Error.Class

35+import Control.Monad.Except

36

37import Data.Monoid ((<>))

38import Data.Function (on)

src/Language/PureScript/Sugar/TypeClasses.hs+1−1

@@ -34,7 +34,7 @@ import qualified Language.PureScript.Constants as C

34

35import Control.Applicative

36import Control.Arrow (first, second)

37−import Control.Monad.Error

37+import Control.Monad.Except

38import Control.Monad.State

39import Data.List ((\\), find)

40import Data.Maybe (catMaybes, mapMaybe, isJust)

src/Language/PureScript/Sugar/TypeDeclarations.hs+1−1

@@ -22,8 +22,8 @@ module Language.PureScript.Sugar.TypeDeclarations (

22import Data.Monoid ((<>))

23

24import Control.Applicative

25−import Control.Monad.Error.Class

26import Control.Monad (forM)

25import Control.Monad (forM)

26+import Control.Monad.Except (throwError)

27

28import Language.PureScript.AST

29import Language.PureScript.Names

src/Language/PureScript/Supply.hs+1−1

@@ -24,7 +24,7 @@ import Data.Functor.Identity

24

25import Control.Applicative

26import Control.Monad.State

27−import Control.Monad.Error.Class

27+import Control.Monad.Except

28

29newtype SupplyT m a = SupplyT { unSupplyT :: StateT Integer m a } deriving (Functor, Applicative, Monad, MonadTrans)

30

src/Language/PureScript/TypeChecker.hs+1−1

@@ -32,7 +32,7 @@ import Data.Foldable (for_)

32import qualified Data.Map as M

33

34import Control.Monad.State

35−import Control.Monad.Error

35+import Control.Monad.Except

36

37import Language.PureScript.Types

38import Language.PureScript.Names

src/Language/PureScript/TypeChecker/Entailment.hs+2−1

@@ -25,9 +25,10 @@ import qualified Data.Map as M

25

26import Control.Applicative

27import Control.Arrow (Arrow(..))

28−import Control.Monad.Error

28+import Control.Monad.Except

29

30import Language.PureScript.AST

31+import Language.PureScript.Errors

31import Language.PureScript.Environment

32import Language.PureScript.Environment

32import Language.PureScript.Names

33import Language.PureScript.Names

33import Language.PureScript.Pretty

34import Language.PureScript.Pretty

src/Language/PureScript/TypeChecker/Kinds.hs+1−1

@@ -31,7 +31,7 @@ import qualified Data.Map as M

31

32import Control.Arrow (second)

33import Control.Applicative

34−import Control.Monad.Error

34+import Control.Monad.Except

35import Control.Monad.State

36import Control.Monad.Unify

37

src/Language/PureScript/TypeChecker/Monad.hs+7−7

@@ -14,7 +14,7 @@

14-----------------------------------------------------------------------------

15

16{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleInstances, RankNTypes,

17− MultiParamTypeClasses, FlexibleContexts #-}

17+ MultiParamTypeClasses, FlexibleContexts, GADTs #-}

18

19module Language.PureScript.TypeChecker.Monad where

20

@@ -22,7 +22,7 @@ import Data.Maybe

22import qualified Data.Map as M

23

24import Control.Applicative

25−import Control.Monad.Error

25+import Control.Monad.Except

26import Control.Monad.Reader.Class

27import Control.Monad.State

28import Control.Monad.Unify

@@ -109,7 +109,7 @@ makeBindingGroupVisible action = do

109-- |

110-- Lookup the type of a value by name in the @Environment@

111--

112−lookupVariable :: (Error e, Functor m, MonadState CheckState m, MonadError e m) => ModuleName -> Qualified Ident -> m Type

112+lookupVariable :: (e ~ ErrorStack, Functor m, MonadState CheckState m, MonadError e m) => ModuleName -> Qualified Ident -> m Type

113lookupVariable currentModule (Qualified moduleName var) = do

114 env <- getEnv

115 case M.lookup (fromMaybe currentModule moduleName, var) (names env) of

@@ -119,7 +119,7 @@ lookupVariable currentModule (Qualified moduleName var) = do

119-- |

120-- Lookup the visibility of a value by name in the @Environment@

121--

122−getVisibility :: (Error e, Functor m, MonadState CheckState m, MonadError e m) => ModuleName -> Qualified Ident -> m NameVisibility

122+getVisibility :: (e ~ ErrorStack, Functor m, MonadState CheckState m, MonadError e m) => ModuleName -> Qualified Ident -> m NameVisibility

123getVisibility currentModule (Qualified moduleName var) = do

124 env <- getEnv

125 case M.lookup (fromMaybe currentModule moduleName, var) (names env) of

@@ -129,7 +129,7 @@ getVisibility currentModule (Qualified moduleName var) = do

129-- |

130-- Assert that a name is visible

131--

132−checkVisibility :: (Error e, Functor m, MonadState CheckState m, MonadError e m) => ModuleName -> Qualified Ident -> m ()

132+checkVisibility :: (e ~ ErrorStack, Functor m, MonadState CheckState m, MonadError e m) => ModuleName -> Qualified Ident -> m ()

133checkVisibility currentModule name@(Qualified _ var) = do

134 vis <- getVisibility currentModule name

135 case vis of

@@ -139,7 +139,7 @@ checkVisibility currentModule name@(Qualified _ var) = do

139-- |

140-- Lookup the kind of a type by name in the @Environment@

141--

142−lookupTypeVariable :: (Error e, Functor m, MonadState CheckState m, MonadError e m) => ModuleName -> Qualified ProperName -> m Kind

142+lookupTypeVariable :: (e ~ ErrorStack, Functor m, MonadState CheckState m, MonadError e m) => ModuleName -> Qualified ProperName -> m Kind

143lookupTypeVariable currentModule (Qualified moduleName name) = do

144 env <- getEnv

145 case M.lookup (Qualified (Just $ fromMaybe currentModule moduleName) name) (types env) of

@@ -172,7 +172,7 @@ data CheckState = CheckState {

172-- The type checking monad, which provides the state of the type checker, and error reporting capabilities

173--

174newtype Check a = Check { unCheck :: StateT CheckState (Either ErrorStack) a }

175− deriving (Functor, Monad, Applicative, Alternative, MonadPlus, MonadState CheckState, MonadError ErrorStack)

175+ deriving (Functor, Monad, Applicative, MonadState CheckState, MonadError ErrorStack)

176

177-- |

178-- Get the current @Environment@

src/Language/PureScript/TypeChecker/Rows.hs+1−1

@@ -19,7 +19,7 @@ module Language.PureScript.TypeChecker.Rows (

19

20import Data.List

21

22−import Control.Monad.Error

22+import Control.Monad.Except

23

24import Language.PureScript.AST

25import Language.PureScript.Errors

src/Language/PureScript/TypeChecker/Skolems.hs+1−1

@@ -26,7 +26,7 @@ import Data.List (nub, (\\))

26import Data.Monoid

27

28import Control.Applicative

29−import Control.Monad.Error

29+import Control.Monad.Except

30import Control.Monad.Unify

31

32import Language.PureScript.AST

src/Language/PureScript/TypeChecker/Subsumption.hs+1−1

@@ -22,7 +22,7 @@ import Data.Monoid

22import Data.Ord (comparing)

23

24import Control.Applicative

25−import Control.Monad.Error

25+import Control.Monad.Except

26import Control.Monad.Unify

27

28import Language.PureScript.AST

src/Language/PureScript/TypeChecker/Synonyms.hs+6−5

@@ -13,7 +13,7 @@

13--

14-----------------------------------------------------------------------------

15

16−{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses #-}

16+{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, GADTs #-}

17

18module Language.PureScript.TypeChecker.Synonyms (

19 saturateAllTypeSynonyms,

@@ -28,10 +28,11 @@ import Data.Maybe (fromMaybe)

28import qualified Data.Map as M

29

30import Control.Applicative

31−import Control.Monad.Error

31+import Control.Monad.Except

32import Control.Monad.State

33

34import Language.PureScript.Environment

35+import Language.PureScript.Errors

35import Language.PureScript.Names

36import Language.PureScript.Names

36import Language.PureScript.TypeChecker.Monad

37import Language.PureScript.TypeChecker.Monad

37import Language.PureScript.Types

38import Language.PureScript.Types

@@ -82,7 +83,7 @@ replaceAllTypeSynonyms' env d =

82 in

83 in

83 saturateAllTypeSynonyms syns d

84 saturateAllTypeSynonyms syns d

84

85

85−replaceAllTypeSynonyms :: (Error e, Functor m, Monad m, MonadState CheckState m, MonadError e m) => Type -> m Type

86+replaceAllTypeSynonyms :: (e ~ ErrorStack, Functor m, Monad m, MonadState CheckState m, MonadError e m) => Type -> m Type

86replaceAllTypeSynonyms d = do

87replaceAllTypeSynonyms d = do

87 env <- getEnv

88 env <- getEnv

88 either (throwError . strMsg) return $ replaceAllTypeSynonyms' env d

89 either (throwError . strMsg) return $ replaceAllTypeSynonyms' env d

@@ -98,12 +99,12 @@ expandTypeSynonym' env name args =

98 replaceAllTypeSynonyms' env repl

99 replaceAllTypeSynonyms' env repl

99 Nothing -> error "Type synonym was not defined"

100 Nothing -> error "Type synonym was not defined"

100

101

101−expandTypeSynonym :: (Error e, Functor m, Monad m, MonadState CheckState m, MonadError e m) => Qualified ProperName -> [Type] -> m Type

102+expandTypeSynonym :: (e ~ ErrorStack, Functor m, Monad m, MonadState CheckState m, MonadError e m) => Qualified ProperName -> [Type] -> m Type

102expandTypeSynonym name args = do

103expandTypeSynonym name args = do

103 env <- getEnv

104 env <- getEnv

104 either (throwError . strMsg) return $ expandTypeSynonym' env name args

105 either (throwError . strMsg) return $ expandTypeSynonym' env name args

105

106

106−expandAllTypeSynonyms :: (Error e, Functor m, Applicative m, Monad m, MonadState CheckState m, MonadError e m) => Type -> m Type

107+expandAllTypeSynonyms :: (e ~ ErrorStack, Functor m, Applicative m, Monad m, MonadState CheckState m, MonadError e m) => Type -> m Type

107expandAllTypeSynonyms = everywhereOnTypesTopDownM go

108expandAllTypeSynonyms = everywhereOnTypesTopDownM go

108 where

109 where

109 go (SaturatedTypeSynonym name args) = expandTypeSynonym name args

110 go (SaturatedTypeSynonym name args) = expandTypeSynonym name args

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

@@ -13,7 +13,7 @@

13--

14-----------------------------------------------------------------------------

15

16−{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses #-}

16+{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, OverloadedStrings #-}

17

18module Language.PureScript.TypeChecker.Types (

19 typesOf

@@ -40,9 +40,10 @@ import Data.List

40import Data.Maybe (fromMaybe)

41import Data.Monoid

42import qualified Data.Map as M

43+import Data.String (IsString)

43

44

44import Control.Applicative

45import Control.Applicative

45−import Control.Monad.Error

46+import Control.Monad.Except

46import Control.Monad.State

47import Control.Monad.State

47import Control.Monad.Unify

48import Control.Monad.Unify

48

49

@@ -673,5 +674,5 @@ meet e1 e2 t1 t2 = do

673-- |

674-- |

674-- Ensure a set of property names and value does not contain duplicate labels

675-- Ensure a set of property names and value does not contain duplicate labels

675--

676--

676−ensureNoDuplicateProperties :: (Error e, MonadError e m) => [(String, Expr)] -> m ()

677+ensureNoDuplicateProperties :: (IsString e, MonadError e m) => [(String, Expr)] -> m ()

677−ensureNoDuplicateProperties ps = guardWith (strMsg "Duplicate property names") $ length (nub . map fst $ ps) == length ps

678+ensureNoDuplicateProperties ps = guardWith "Duplicate property names" $ length (nub . map fst $ ps) == length ps

src/Language/PureScript/TypeChecker/Unify.hs+1−1

@@ -30,7 +30,7 @@ import Data.Maybe (fromMaybe)

30import Data.Monoid

31import qualified Data.HashMap.Strict as H

32

33−import Control.Monad.Error

33+import Control.Monad.Except

34import Control.Monad.Unify

35

36import Language.PureScript.Environment