e7d219e · rowtype-yoga/purescript-native

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

Fix Category bug #158

commite7d219edf2394e220effad8d9c5ce7d89980547b authorPhil Freeman <paf31@cantab.net> dateSun 2 Feb 2014, 15:18 (13 years ago) parent98d1989

7 files changed+23−9

compare with golang

unifiedsplit

examples/passing/Category.purs+15 libraries/prelude/prelude.purs+2−2 src/Language/PureScript/Parser/Common.hs−3 src/Language/PureScript/Parser/Declarations.hs+1−1 src/Language/PureScript/Pretty/Types.hs+1 src/Language/PureScript/TypeChecker/Types.hs+2−1 src/Language/PureScript/Types.hs+2−2

examples/passing/Category.pursnew file+15

@@ -0,0 +1,15 @@

1+module Category where

3+class Category c where

4+ id :: forall x. c x x

5+ (<|) :: forall x y z. c y z -> c x y -> c x z

7+instance Category (->) where

8+ id = Prelude.id

9+ (<|) = Prelude.(<|)

10+

11+module Main where

12+

13+import Category

14+

15+main = Trace.trace (id "Done")

libraries/prelude/prelude.purs+2−2

@@ -3,8 +3,8 @@ module Prelude where

33 foreign import data String :: *

44 foreign import data Number :: *

55 foreign import data Boolean :: *

6− foreign import data [] :: * -> *

7− foreign import data (->) :: * -> * -> *

6+ foreign import data Array :: * -> *

7+ foreign import data Function :: * -> * -> *

99 id :: forall a. a -> a

1010 id = \x -> x

src/Language/PureScript/Parser/Common.hs−3

@@ -239,9 +239,6 @@ natural = PT.natural tokenParser

239239properName :: P.Parsec String u ProperName

240240properName = lexeme $ ProperName <$> P.try ((:) <$> P.upper <*> many (PT.identLetter langDef) P.<?> "name")

241241

242−properNameOrExternalType :: P.Parsec String u ProperName

243−properNameOrExternalType = P.try properName <|> (ProperName <$> (P.try (lexeme $ P.string "[]") <|> (lexeme $ P.string "(->)")))

244−

245242-- |

246243-- Parse a qualified name, i.e. M.name or just name

247244--

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

@@ -64,7 +64,7 @@ parseValueDeclaration =

6464

6565parseExternDeclaration :: P.Parsec String ParseState Declaration

6666parseExternDeclaration = P.try (reserved "foreign") *> indented *> (reserved "import") *> indented *>

67− (ExternDataDeclaration <$> (P.try (reserved "data") *> indented *> properNameOrExternalType)

67+ (ExternDataDeclaration <$> (P.try (reserved "data") *> indented *> properName)

6868 <*> (lexeme (indented *> P.string "::") *> parseKind)

6969 <|> do ident <- parseNonReservedIdent

7070 js <- P.optionMaybe (parseJSLiteral <$> stringLiteral)

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

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

3333 where

3434 match (Object row) = Just $ "{ " ++ prettyPrintType row ++ " }"

3535 match (TypeVar var) = Just var

36+ match (TypeApp arr ty) | arr == tyArray = Just $ "[" ++ prettyPrintType ty ++ "]"

3637 match (TypeConstructor ctor) = Just $ show ctor

3738 match (TUnknown (TypedUnknown (Unknown u))) = Just $ 'u' : show u

3839 match (Skolem s) = Just $ 's' : show s

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

@@ -922,7 +922,8 @@ checkFunctionApplication fn fnTy arg ret = rethrow errorMessage $ checkFunctionA

922922-- Check the type of a function application

923923--

924924checkFunctionApplication' :: Value -> Type -> Value -> Type -> UnifyT Check Value

925−checkFunctionApplication' fn (TypeApp (TypeApp t argTy) retTy) arg ret | t == tyFunction = do

925+checkFunctionApplication' fn (TypeApp (TypeApp tyFunction' argTy) retTy) arg ret = do

926+ tyFunction' ?= tyFunction

926927 arg' <- check arg argTy

927928 _ <- subsumes Nothing retTy ret

928929 return $ App fn arg'

src/Language/PureScript/Types.hs+2−2

@@ -77,7 +77,7 @@ data Type

7777-- Type constructor for functions

7878--

7979tyFunction :: Type

80−tyFunction = TypeConstructor $ (Qualified $ Just $ ModuleName $ ProperName "Prelude") (ProperName "(->)")

80+tyFunction = TypeConstructor $ (Qualified $ Just $ ModuleName $ ProperName "Prelude") (ProperName "Function")

8181

8282-- |

8383-- Type constructor for strings

@@ -101,7 +101,7 @@ tyBoolean = TypeConstructor $ (Qualified $ Just $ ModuleName $ ProperName "Prelu

101101-- Type constructor for arrays

102102--

103103tyArray :: Type

104−tyArray = TypeConstructor $ (Qualified $ Just $ ModuleName $ ProperName "Prelude") (ProperName "[]")

104+tyArray = TypeConstructor $ (Qualified $ Just $ ModuleName $ ProperName "Prelude") (ProperName "Array")

105105

106106-- |

107107-- Smart constructor for function types