9e188fc · rowtype-yoga/purescript-native

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

Satisfy type class dictionaries when LHS of a function application is constrained

commit9e188fc53c9452e6a808284c9450d82537391a53 authorPhil Freeman <paf31@cantab.net> dateSun 27 Jul 2014, 18:56 (12 years ago) parent3fa1d04

2 files changed+21−4

unifiedsplit

examples/passing/Rank2TypeSynonym.pursnew file+15

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

1+module Main where

3+import Control.Monad.Eff

5+type Foo a = forall f. (Monad f) => f a

7+foo :: forall a. a -> Foo a

8+foo x = pure x

10+bar :: Foo Number

11+bar = foo 3

12+

13+main = do

14+ x <- bar

15+ Debug.Trace.print x

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

@@ -1022,9 +1022,12 @@ checkFunctionApplication fn fnTy arg ret = rethrow (mkErrorStack errorMessage (J

10221022checkFunctionApplication' :: Value -> Type -> Value -> Maybe Type -> UnifyT Type Check (Type, Value)

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

10241024 tyFunction' =?= tyFunction

1025− _ <- maybe (return Nothing) (subsumes Nothing retTy) ret

10261025 arg' <- check arg argTy

1027− return (retTy, App fn arg')

1026+ case ret of

1027+ Nothing -> return (retTy, App fn arg')

1028+ Just ret' -> do

1029+ Just app' <- subsumes (Just (App fn arg')) retTy ret'

1030+ return (retTy, app')

10281031checkFunctionApplication' fn (ForAll ident ty _) arg ret = do

10291032 replaced <- replaceVarWithUnknown ident ty

10301033 checkFunctionApplication fn replaced arg ret

@@ -1084,8 +1087,7 @@ subsumes' val ty1 (SaturatedTypeSynonym name tyArgs) = do

10841087 subsumes val ty1 ty2

10851088subsumes' (Just val) (ConstrainedType constraints ty1) ty2 = do

10861089 dicts <- getTypeClassDictionaries

1087− _ <- subsumes' Nothing ty1 ty2

1088− return . Just $ foldl App val (map (flip (TypeClassDictionary True) dicts) constraints)

1090+ subsumes' (Just $ foldl App val (map (flip (TypeClassDictionary True) dicts) constraints)) ty1 ty2

10891091subsumes' val (TypeApp f1 r1) (TypeApp f2 r2) | f1 == tyObject && f2 == tyObject = do

10901092 let

10911093 (ts1, r1') = rowToList r1