2d01405 · rowtype-yoga/purescript-native

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

Type wildcards are disallowed in type synonyms, data declarations, instances. #287

commit2d014058ae4af25d5de8c156ddc25f2a659517a1 authorPhil Freeman <paf31@cantab.net> dateSun 16 Nov 2014, 20:21 (12 years ago) parent165a6cb

7 files changed+46−8

compare with golang

unifiedsplit

examples/failing/TypeWildcards1.purs+4 examples/failing/TypeWildcards2.purs+4 examples/failing/TypeWildcards3.purs+7 examples/passing/TypeWildcards.purs+3 src/Language/PureScript/Parser/Declarations.hs+8−8 src/Language/PureScript/Parser/Types.hs+10 src/Language/PureScript/Types.hs+10

examples/failing/TypeWildcards1.pursnew file+4

@@ -0,0 +1,4 @@

1+module TypeWildcards where

3+type Test = _

examples/failing/TypeWildcards2.pursnew file+4

@@ -0,0 +1,4 @@

1+module TypeWildcards where

3+data Test = Test _

examples/failing/TypeWildcards3.pursnew file+7

@@ -0,0 +1,7 @@

1+module TypeWildcards where

3+data Foo a = Foo

5+instance showFoo :: Show (Foo _) where

6+ show Foo = "Foo"

examples/passing/TypeWildcards.purs+3

@@ -1,5 +1,8 @@

11module Main where

3+testTopLevel :: _ -> _

4+testTopLevel n = n + 1

36test :: forall a. (Eq a) => (a -> a) -> a -> a

47test f a = go (f a) a

58 where

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

@@ -64,7 +64,7 @@ parseDataDeclaration = do

6464 tyArgs <- many (indented *> kindedIdent)

6565 ctors <- P.option [] $ do

6666 _ <- lexeme $ indented *> P.char '='

67− sepBy1 ((,) <$> properName <*> P.many (indented *> parseTypeAtom)) pipe

67+ sepBy1 ((,) <$> properName <*> P.many (indented *> noWildcards parseTypeAtom)) pipe

6868 return $ DataDeclaration dtype name tyArgs ctors

6969

7070parseTypeDeclaration :: P.Parsec String ParseState Declaration

@@ -76,7 +76,7 @@ parseTypeSynonymDeclaration :: P.Parsec String ParseState Declaration

7676parseTypeSynonymDeclaration =

7777 TypeSynonymDeclaration <$> (P.try (reserved "type") *> indented *> properName)

7878 <*> many (indented *> kindedIdent)

79− <*> (lexeme (indented *> P.char '=') *> parsePolyType)

79+ <*> (lexeme (indented *> P.char '=') *> noWildcards parsePolyType)

8080

8181parseValueDeclaration :: P.Parsec String ParseState Declaration

8282parseValueDeclaration = do

@@ -106,16 +106,16 @@ parseExternDeclaration = P.try (reserved "foreign") *> indented *> reserved "imp

106106 <|> (do reserved "instance"

107107 name <- parseIdent <* lexeme (indented *> P.string "::")

108108 deps <- P.option [] $ do

109− deps <- parens (commaSep1 ((,) <$> parseQualified properName <*> P.many parseTypeAtom))

109+ deps <- parens (commaSep1 ((,) <$> parseQualified properName <*> P.many (noWildcards parseTypeAtom)))

110110 indented

111111 reservedOp "=>"

112112 return deps

113113 className <- indented *> parseQualified properName

114− tys <- P.many (indented *> parseTypeAtom)

114+ tys <- P.many (indented *> noWildcards parseTypeAtom)

115115 return $ ExternInstanceDeclaration name deps className tys)

116116 <|> (do ident <- parseIdent

117117 js <- P.optionMaybe (JSRaw <$> stringLiteral)

118− ty <- lexeme (indented *> P.string "::") *> parsePolyType

118+ ty <- lexeme (indented *> P.string "::") *> noWildcards parsePolyType

119119 return $ ExternDeclaration (if isJust js then InlineJavascript else ForeignImport) ident js ty))

120120

121121parseAssociativity :: P.Parsec String ParseState Associativity

@@ -176,7 +176,7 @@ parseTypeClassDeclaration = do

176176 reserved "class"

177177 implies <- P.option [] $ do

178178 indented

179− implies <- parens (commaSep1 ((,) <$> parseQualified properName <*> P.many parseTypeAtom))

179+ implies <- parens (commaSep1 ((,) <$> parseQualified properName <*> P.many (noWildcards parseTypeAtom)))

180180 reservedOp "<="

181181 return implies

182182 className <- indented *> properName

@@ -191,12 +191,12 @@ parseTypeInstanceDeclaration = do

191191 reserved "instance"

192192 name <- parseIdent <* lexeme (indented *> P.string "::")

193193 deps <- P.optionMaybe $ do

194− deps <- parens (commaSep1 ((,) <$> parseQualified properName <*> P.many parseTypeAtom))

194+ deps <- parens (commaSep1 ((,) <$> parseQualified properName <*> P.many (noWildcards parseTypeAtom)))

195195 indented

196196 reservedOp "=>"

197197 return deps

198198 className <- indented *> parseQualified properName

199− ty <- P.many (indented *> parseTypeAtom)

199+ ty <- P.many (indented *> (noWildcards parseTypeAtom))

200200 members <- P.option [] . P.try $ do

201201 indented *> reserved "where"

202202 mark (P.many (same *> positioned parseValueDeclaration))

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

@@ -16,6 +16,7 @@

1616module Language.PureScript.Parser.Types (

1717 parseType,

1818 parsePolyType,

19+ noWildcards,

1920 parseTypeAtom

2021) where

2122

@@ -112,6 +113,15 @@ parseType = do

112113parsePolyType :: P.Parsec String ParseState Type

113114parsePolyType = parseAnyType

114115

116+-- |

117+-- Parse an atomic type with no wildcards

118+--

119+noWildcards :: P.Parsec String ParseState Type -> P.Parsec String ParseState Type

120+noWildcards p = do

121+ ty <- p

122+ when (containsWildcards ty) $ P.unexpected "type wildcard"

123+ return ty

124+

115125parseNameAndType :: P.Parsec String ParseState t -> P.Parsec String ParseState (String, t)

116126parseNameAndType p = (,) <$> (indented *> (identifierName <|> stringLiteral) <* indented <* lexeme (P.string "::")) <*> p

117127

src/Language/PureScript/Types.hs+10

@@ -219,6 +219,16 @@ moveQuantifiersToFront = go [] []

219219 [] -> constrained

220220 qs' -> foldl (\ty' (q, sco) -> ForAll q ty' sco) constrained qs'

221221

222+-- |

223+-- Check if a type contains wildcards

224+--

225+containsWildcards :: Type -> Bool

226+containsWildcards = everythingOnTypes (||) go

227+ where

228+ go :: Type -> Bool

229+ go TypeWildcard = True

230+ go _ = False

231+

222232--

223233-- Traversals

224234--