c9f0839 · rowtype-yoga/purescript-native

src/Language/PureScript/Constants.hs+3

compare with golang

unifiedsplit

@@ -327,6 +327,9 @@ partial = "Partial"

327pattern Partial :: Qualified (ProperName 'ClassName)

328pattern Partial = Qualified (Just (ModuleName [ProperName "Prim"])) (ProperName "Partial")

329

330+pattern Fail :: Qualified (ProperName 'ClassName)

331+pattern Fail = Qualified (Just (ModuleName [ProperName "Prim"])) (ProperName "Fail")

332+

330-- Code Generation

333-- Code Generation

331

334

332__superclass_ :: String

335__superclass_ :: String

src/Language/PureScript/Environment.hs+4−1

@@ -240,6 +240,7 @@ primTypes =

240 , (primName "Int", (Star, ExternData))

241 , (primName "Boolean", (Star, ExternData))

242 , (primName "Partial", (Star, ExternData))

243+ , (primName "Fail", (FunKind Symbol Star, ExternData))

243 ]

244 ]

244

245

245-- |

246-- |

@@ -249,7 +250,9 @@ primTypes =

249primClasses :: M.Map (Qualified (ProperName 'ClassName)) ([(String, Maybe Kind)], [(Ident, Type)], [Constraint])

250primClasses :: M.Map (Qualified (ProperName 'ClassName)) ([(String, Maybe Kind)], [(Ident, Type)], [Constraint])

250primClasses =

251primClasses =

251 M.fromList

252 M.fromList

252− [ (primName "Partial", ([], [], [])) ]

253+ [ (primName "Partial", ([], [], []))

254+ , (primName "Fail", ([("message", Just Symbol)], [], []))

255+ ]

253

256

254-- |

257-- |

255-- Finds information about data constructors from the current environment.

258-- Finds information about data constructors from the current environment.

src/Language/PureScript/Errors.hs+4

@@ -713,6 +713,10 @@ prettyPrintSingleError (PPEOptions codeColor full level showWiki) e = flip evalS

713 , line "They may be disallowed completely in a future version of the compiler."

714 ]

715 renderSimpleErrorMessage OverlappingInstances{} = internalError "OverlappingInstances: empty instance list"

716+ renderSimpleErrorMessage (NoInstanceFound (Constraint C.Fail [ TypeLevelString message ] _)) =

717+ paras [ line "A custom type error occurred while solving type class constraints:"

718+ , indent . paras . map line . lines $ message

719+ ]

716 renderSimpleErrorMessage (NoInstanceFound (Constraint C.Partial

720 renderSimpleErrorMessage (NoInstanceFound (Constraint C.Partial

717 _

721 _

718 (Just (PartialConstraintData bs b)))) =

722 (Just (PartialConstraintData bs b)))) =

src/Language/PureScript/Kinds.hs+8−18

@@ -6,30 +6,20 @@ import Prelude.Compat

6

7import qualified Data.Aeson.TH as A

8

9−-- |

10−-- The data type of kinds

9+-- | The data type of kinds

11−--

12data Kind

10data Kind

13− -- |

14− -- Unification variable of type Kind

11+ -- | Unification variable of type Kind

15− --

16 = KUnknown Int

12 = KUnknown Int

17− -- |

18− -- The kind of types

13+ -- | The kind of types

19− --

20 | Star

14 | Star

21− -- |

22− -- The kind of effects

15+ -- | The kind of effects

23− --

24 | Bang

16 | Bang

25− -- |

26− -- Kinds for labelled, unordered rows without duplicates

17+ -- | Kinds for labelled, unordered rows without duplicates

27− --

28 | Row Kind

18 | Row Kind

29− -- |

30− -- Function kinds

19+ -- | Function kinds

31− --

32 | FunKind Kind Kind

20 | FunKind Kind Kind

21+ -- | Type-level strings

22+ | Symbol

33 deriving (Show, Read, Eq, Ord)

23 deriving (Show, Read, Eq, Ord)

34

24

35$(A.deriveJSON A.defaultOptions ''Kind)

25$(A.deriveJSON A.defaultOptions ''Kind)

src/Language/PureScript/Parser/Kinds.hs+4

@@ -18,10 +18,14 @@ parseStar = const Star <$> symbol' "*"

18parseBang :: TokenParser Kind

19parseBang = const Bang <$> symbol' "!"

20

21+parseSymbol :: TokenParser Kind

22+parseSymbol = const Symbol <$> uname' "Symbol"

23+

21parseTypeAtom :: TokenParser Kind

24parseTypeAtom :: TokenParser Kind

22parseTypeAtom = indented *> P.choice

25parseTypeAtom = indented *> P.choice

23 [ parseStar

26 [ parseStar

24 , parseBang

27 , parseBang

28+ , parseSymbol

25 , parens parseKind

29 , parens parseKind

26 ]

30 ]

27-- |

31-- |

src/Language/PureScript/Parser/Types.hs+4

@@ -26,6 +26,9 @@ parseFunction = parens rarrow >> return tyFunction

26parseObject :: TokenParser Type

27parseObject = braces $ TypeApp tyRecord <$> parseRow

28

29+parseTypeLevelString :: TokenParser Type

30+parseTypeLevelString = TypeLevelString <$> stringLiteral

31+

29parseTypeWildcard :: TokenParser Type

32parseTypeWildcard :: TokenParser Type

30parseTypeWildcard = do

33parseTypeWildcard = do

31 start <- P.getPosition

34 start <- P.getPosition

@@ -53,6 +56,7 @@ parseTypeAtom :: TokenParser Type

53parseTypeAtom = indented *> P.choice

56parseTypeAtom = indented *> P.choice

54 [ P.try parseConstrainedType

57 [ P.try parseConstrainedType

55 , P.try parseFunction

58 , P.try parseFunction

59+ , parseTypeLevelString

56 , parseObject

60 , parseObject

57 , parseTypeWildcard

61 , parseTypeWildcard

58 , parseForAll

62 , parseForAll

src/Language/PureScript/Pretty/Kinds.hs+1

@@ -21,6 +21,7 @@ typeLiterals = mkPattern match

21 where

22 match Star = Just "*"

23 match Bang = Just "!"

24+ match Symbol = Just "Symbol"

24 match (KUnknown u) = Just $ 'u' : show u

25 match (KUnknown u) = Just $ 'u' : show u

25 match _ = Nothing

26 match _ = Nothing

26

27

src/Language/PureScript/Pretty/Types.hs+1

@@ -32,6 +32,7 @@ typeLiterals = mkPattern match

32 where

33 match TypeWildcard{} = Just $ text "_"

34 match (TypeVar var) = Just $ text var

35+ match (TypeLevelString s) = Just . text $ show s

35 match (PrettyPrintObject row) = Just $ prettyPrintRowWith '{' '}' row

36 match (PrettyPrintObject row) = Just $ prettyPrintRowWith '{' '}' row

36 match (TypeConstructor ctor) = Just $ text $ runProperName $ disqualify ctor

37 match (TypeConstructor ctor) = Just $ text $ runProperName $ disqualify ctor

37 match (TUnknown u) = Just $ text $ 't' : show u

38 match (TUnknown u) = Just $ text $ 't' : show u

src/Language/PureScript/TypeChecker.hs+1

@@ -147,6 +147,7 @@ checkTypeClassInstance

147 -> Type

148 -> m ()

149checkTypeClassInstance _ (TypeVar _) = return ()

150+checkTypeClassInstance _ (TypeLevelString _) = return ()

150checkTypeClassInstance _ (TypeConstructor ctor) = do

151checkTypeClassInstance _ (TypeConstructor ctor) = do

151 env <- getEnv

152 env <- getEnv

152 when (ctor `M.member` typeSynonyms env) . throwError . errorMessage $ TypeSynonymInstance

153 when (ctor `M.member` typeSynonyms env) . throwError . errorMessage $ TypeSynonymInstance

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

@@ -184,6 +184,7 @@ typeHeadsAreEqual _ (TUnknown u1) (TUnknown u2) | u1 == u2 = Just

184typeHeadsAreEqual _ (Skolem _ s1 _ _) (Skolem _ s2 _ _) | s1 == s2 = Just []

185typeHeadsAreEqual _ t (TypeVar v) = Just [(v, t)]

186typeHeadsAreEqual _ (TypeConstructor c1) (TypeConstructor c2) | c1 == c2 = Just []

187+typeHeadsAreEqual _ (TypeLevelString s1) (TypeLevelString s2) | s1 == s2 = Just []

187typeHeadsAreEqual m (TypeApp h1 t1) (TypeApp h2 t2) = (++) <$> typeHeadsAreEqual m h1 h2

188typeHeadsAreEqual m (TypeApp h1 t1) (TypeApp h2 t2) = (++) <$> typeHeadsAreEqual m h1 h2

188 <*> typeHeadsAreEqual m t1 t2

189 <*> typeHeadsAreEqual m t1 t2

189typeHeadsAreEqual _ REmpty REmpty = Just []

190typeHeadsAreEqual _ REmpty REmpty = Just []

src/Language/PureScript/TypeChecker/Kinds.hs+2

@@ -87,6 +87,7 @@ unifyKinds k1 k2 = do

87 go k (KUnknown u) = solveKind u k

88 go Star Star = return ()

89 go Bang Bang = return ()

90+ go Symbol Symbol = return ()

90 go (Row k1') (Row k2') = go k1' k2'

91 go (Row k1') (Row k2') = go k1' k2'

91 go (FunKind k1' k2') (FunKind k3 k4) = do

92 go (FunKind k1' k2') (FunKind k3 k4) = do

92 go k1' k3

93 go k1' k3

@@ -230,6 +231,7 @@ infer' other = (, []) <$> go other

230 unifyKinds k k'

231 unifyKinds k k'

231 return k'

232 return k'

232 go TypeWildcard{} = freshKind

233 go TypeWildcard{} = freshKind

234+ go (TypeLevelString _) = return Symbol

233 go (TypeVar v) = do

235 go (TypeVar v) = do

234 Just moduleName <- checkCurrentModule <$> get

236 Just moduleName <- checkCurrentModule <$> get

235 lookupTypeVariable moduleName (Qualified Nothing (ProperName v))

237 lookupTypeVariable moduleName (Qualified Nothing (ProperName v))

src/Language/PureScript/TypeChecker/Unify.hs+8−7

@@ -153,13 +153,14 @@ unifyRows r1 r2 =

153-- Check that two types unify

154--

155unifiesWith :: Type -> Type -> Bool

156−unifiesWith (TUnknown u1) (TUnknown u2) | u1 == u2 = True

156+unifiesWith (TUnknown u1) (TUnknown u2) = u1 == u2

157−unifiesWith (Skolem _ s1 _ _) (Skolem _ s2 _ _) | s1 == s2 = True

157+unifiesWith (Skolem _ s1 _ _) (Skolem _ s2 _ _) = s1 == s2

158−unifiesWith (TypeVar v1) (TypeVar v2) | v1 == v2 = True

158+unifiesWith (TypeVar v1) (TypeVar v2) = v1 == v2

159+unifiesWith (TypeLevelString s1) (TypeLevelString s2) = s1 == s2

159−unifiesWith (TypeConstructor c1) (TypeConstructor c2) | c1 == c2 = True

160+unifiesWith (TypeConstructor c1) (TypeConstructor c2) = c1 == c2

160−unifiesWith (TypeApp h1 t1) (TypeApp h2 t2) = h1 `unifiesWith` h2 && t1 `unifiesWith` t2

161+unifiesWith (TypeApp h1 t1) (TypeApp h2 t2) = h1 `unifiesWith` h2 && t1 `unifiesWith` t2

161−unifiesWith REmpty REmpty = True

162+unifiesWith REmpty REmpty = True

162−unifiesWith r1@RCons{} r2@RCons{} =

163+unifiesWith r1@RCons{} r2@RCons{} =

163 let (s1, r1') = rowToList r1

164 let (s1, r1') = rowToList r1

164 (s2, r2') = rowToList r2

165 (s2, r2') = rowToList r2

165

166

src/Language/PureScript/Types.hs+19−51

@@ -29,79 +29,47 @@ newtype SkolemScope = SkolemScope { runSkolemScope :: Int }

29-- The type of types

30--

31data Type

32− -- |

33− -- A unification variable of type Type

32+ -- | A unification variable of type Type

34− --

35 = TUnknown Int

33 = TUnknown Int

36− -- |

37− -- A named type variable

34+ -- | A named type variable

38− --

39 | TypeVar String

35 | TypeVar String

40− -- |

36+ -- | A type-level string

37+ | TypeLevelString String

41− -- A type wildcard, as would appear in a partial type synonym

38+ -- | A type wildcard, as would appear in a partial type synonym

42− --

43 | TypeWildcard SourceSpan

39 | TypeWildcard SourceSpan

44− -- |

45− -- A type constructor

40+ -- | A type constructor

46− --

47 | TypeConstructor (Qualified (ProperName 'TypeName))

41 | TypeConstructor (Qualified (ProperName 'TypeName))

48− -- |

49− -- A type operator. This will be desugared into a type constructor during the

42+ -- | A type operator. This will be desugared into a type constructor during the

50 -- "operators" phase of desugaring.

43 -- "operators" phase of desugaring.

51− --

52 | TypeOp (Qualified (OpName 'TypeOpName))

44 | TypeOp (Qualified (OpName 'TypeOpName))

53− -- |

54− -- A type application

45+ -- | A type application

55− --

56 | TypeApp Type Type

46 | TypeApp Type Type

57− -- |

58− -- Forall quantifier

47+ -- | Forall quantifier

59− --

60 | ForAll String Type (Maybe SkolemScope)

48 | ForAll String Type (Maybe SkolemScope)

61− -- |

62− -- A type with a set of type class constraints

49+ -- | A type with a set of type class constraints

63− --

64 | ConstrainedType [Constraint] Type

50 | ConstrainedType [Constraint] Type

65− -- |

66− -- A skolem constant

51+ -- | A skolem constant

67− --

68 | Skolem String Int SkolemScope (Maybe SourceSpan)

52 | Skolem String Int SkolemScope (Maybe SourceSpan)

69− -- |

70− -- An empty row

53+ -- | An empty row

71− --

72 | REmpty

54 | REmpty

73− -- |

74− -- A non-empty row

55+ -- | A non-empty row

75− --

76 | RCons String Type Type

56 | RCons String Type Type

77− -- |

78− -- A type with a kind annotation

57+ -- | A type with a kind annotation

79− --

80 | KindedType Type Kind

58 | KindedType Type Kind

81− -- |

82− -- A placeholder used in pretty printing

59+ -- | A placeholder used in pretty printing

83− --

84 | PrettyPrintFunction Type Type

60 | PrettyPrintFunction Type Type

85− -- |

86− -- A placeholder used in pretty printing

61+ -- | A placeholder used in pretty printing

87− --

88 | PrettyPrintObject Type

62 | PrettyPrintObject Type

89− -- |

90− -- A placeholder used in pretty printing

63+ -- | A placeholder used in pretty printing

91− --

92 | PrettyPrintForAll [String] Type

64 | PrettyPrintForAll [String] Type

93− -- |

94− -- Binary operator application. During the rebracketing phase of desugaring,

65+ -- | Binary operator application. During the rebracketing phase of desugaring,

95 -- this data constructor will be removed.

66 -- this data constructor will be removed.

96− --

97 | BinaryNoParensType Type Type Type

67 | BinaryNoParensType Type Type Type

98− -- |

99− -- Explicit parentheses. During the rebracketing phase of desugaring, this

68+ -- | Explicit parentheses. During the rebracketing phase of desugaring, this

100 -- data constructor will be removed.

69 -- data constructor will be removed.

101 --

70 --

102 -- Note: although it seems this constructor is not used, it _is_ useful,

71 -- Note: although it seems this constructor is not used, it _is_ useful,

103 -- since it prevents certain traversals from matching.

72 -- since it prevents certain traversals from matching.

104− --

105 | ParensInType Type

73 | ParensInType Type

106 deriving (Show, Read, Eq, Ord)

74 deriving (Show, Read, Eq, Ord)

107

75