git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Monotype check
commitf6055cbae5361466bacca94626b2abdbdfdb7e15 authorPhil Freeman <paf31@cantab.net> dateSun 17 Nov 2013, 18:28 (13 years ago) parent1075979
3 files changed+48−22
compare with golang
unifiedsplit
src/Language/PureScript/Parser/Types.hs+21−8 src/Language/PureScript/TypeChecker/Types.hs−13 src/Language/PureScript/Types.hs+27−1
src/Language/PureScript/Parser/Types.hs+21−8
@@ -25,6 +25,7 @@ import Control.Applicative
2525import qualified Text.Parsec as P
2626import qualified Text.Parsec.Expr as P
2727import Control.Arrow (Arrow(..))
28+import Control.Monad (unless)
2829
2930parseNumber :: P.Parsec String ParseState Type
3031parseNumber = const Number <$> reserved "Number"
@@ -43,7 +44,7 @@ parseObject = braces $ Object <$> parseRow
4344
4445parseFunction :: P.Parsec String ParseState Type
4546parseFunction = do
46− args <- lexeme $ parens $ commaSep parseType
47+ args <- lexeme $ parens $ commaSep parsePolyType
4748 lexeme $ P.string "->"
4849 resultType <- parseType
4950 return $ Function args resultType
@@ -54,6 +55,10 @@ parseTypeVariable = TypeVar <$> identifier
5455parseTypeConstructor :: P.Parsec String ParseState Type
5556parseTypeConstructor = TypeConstructor <$> parseQualified properName
5657
58+parseForAll :: P.Parsec String ParseState Type
59+parseForAll = (ForAll <$> (P.try (reserved "forall") *> many (indented *> identifier) <* indented <* dot)
60+ <*> parseType)
61+
5762parseTypeAtom :: P.Parsec String ParseState Type
5863parseTypeAtom = indented *> P.choice (map P.try
5964 [ parseNumber
@@ -64,20 +69,28 @@ parseTypeAtom = indented *> P.choice (map P.try
6469 , parseFunction
6570 , parseTypeVariable
6671 , parseTypeConstructor
72+ , parseForAll
6773 , parens parseType ])
6874
69−parsePolyType :: P.Parsec String ParseState PolyType
70−parsePolyType = (ForAll <$> (P.try (reserved "forall") *> many (indented *> identifier) <* indented <* dot)
71− <*> parseType) <|>
72− (ForAll [] <$> parseType)
73−
74−parseType :: P.Parsec String ParseState Type
75−parseType = (P.buildExpressionParser operators . buildPostfixParser postfixTable $ parseTypeAtom) P.<?> "type"
75+parseAnyType :: P.Parsec String ParseState Type
76+parseAnyType = (P.buildExpressionParser operators . buildPostfixParser postfixTable $ parseTypeAtom) P.<?> "type"
7677 where
7778 postfixTable :: [P.Parsec String ParseState (Type -> Type)]
7879 postfixTable = [ flip TypeApp <$> P.try (indented *> parseTypeAtom) ]
7980 operators = [ [ P.Infix (lexeme (P.try (P.string "->")) >> return (\t1 t2 -> Function [t1] t2)) P.AssocRight ] ]
8081
82+parseType :: P.Parsec String ParseState Type
83+parseType = do
84+ ty <- parseAnyType
85+ unless (isMonoType ty) $ P.unexpected "polymorphic type"
86+ return ty
87+
88+parsePolyType :: P.Parsec String ParseState PolyType
89+parsePolyType = do
90+ ty <- parseAnyType
91+ unless (isPolyType ty) $ P.unexpected "polymorphic type"
92+ return ty
93+
8194parseNameAndType :: P.Parsec String ParseState (String, Type)
8295parseNameAndType = (,) <$> (indented *> identifier <* indented <* lexeme (P.string "::")) <*> parseType
8396
src/Language/PureScript/TypeChecker/Types.hs−13
@@ -229,19 +229,6 @@ occursCheck u = everything (||) $ flip extQ g $ mkQ False f
229229 g (RUnknown u') | u' == u = True
230230 g _ = False
231231
232−typesToRow :: [(String, Type)] -> Row
233−typesToRow [] = REmpty
234−typesToRow ((name, ty):tys) = RCons name ty (typesToRow tys)
235−
236−rowToList :: Row -> ([(String, Type)], Row)
237−rowToList (RCons name ty row) = let (tys, rest) = rowToList row
238− in ((name, ty):tys, rest)
239−rowToList r = ([], r)
240−
241−rowFromList :: ([(String, Type)], Row) -> Row
242−rowFromList ([], r) = r
243−rowFromList ((name, t):ts, r) = RCons name t (rowFromList (ts, r))
244−
245232ensureNoDuplicateProperties :: [(String, Value)] -> Check ()
246233ensureNoDuplicateProperties ps = guardWith "Duplicate property names" $ length (nub . map fst $ ps) == length ps
247234
src/Language/PureScript/Types.hs+27−1
@@ -26,7 +26,7 @@ data Type
2626 | Boolean
2727 | Array Type
2828 | Object Row
29− | Function [Type] Type
29+ | Function [PolyType] Type
3030 | TypeVar String
3131 | TypeConstructor (Qualified ProperName)
3232 | TypeApp Type Type
@@ -41,3 +41,29 @@ data Row
4141 | RowVar String
4242 | REmpty
4343 | RCons String Type Row deriving (Show, Eq, Data, Typeable)
44+
45+typesToRow :: [(String, Type)] -> Row
46+typesToRow [] = REmpty
47+typesToRow ((name, ty):tys) = RCons name ty (typesToRow tys)
48+
49+rowToList :: Row -> ([(String, Type)], Row)
50+rowToList (RCons name ty row) = let (tys, rest) = rowToList row
51+ in ((name, ty):tys, rest)
52+rowToList r = ([], r)
53+
54+rowFromList :: ([(String, Type)], Row) -> Row
55+rowFromList ([], r) = r
56+rowFromList ((name, t):ts, r) = RCons name t (rowFromList (ts, r))
57+
58+isMonoType :: Type -> Bool
59+isMonoType (ForAll _ _) = False
60+isMonoType ty = isPolyType ty
61+
62+isPolyType :: Type -> Bool
63+isPolyType (Array ty) = isMonoType ty
64+isPolyType (Object ps) = all isMonoType (map snd . fst $ rowToList ps)
65+isPolyType (Function args ret) = all isPolyType args && isMonoType ret
66+isPolyType (TypeApp t1 t2) = isMonoType t1 && isMonoType t2
67+isPolyType (SaturatedTypeSynonym _ args) = all isMonoType args
68+isPolyType (ForAll idents ty) = isPolyType ty
69+isPolyType _ = True