git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Satisfy type class dictionaries when LHS of a function application is constrained
9e188fcPhil Freeman
examples/passing/Rank2TypeSynonym.pursnew file+15
compare with golang
unifiedsplit
@@ -0,0 +1,15 @@
1+module Main where
2+
3+import Control.Monad.Eff
4+
5+type Foo a = forall f. (Monad f) => f a
6+
7+foo :: forall a. a -> Foo a
8+foo x = pure x
9+
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
1022checkFunctionApplication' :: Value -> Type -> Value -> Maybe Type -> UnifyT Type Check (Type, Value)
1022checkFunctionApplication' :: Value -> Type -> Value -> Maybe Type -> UnifyT Type Check (Type, Value)
1023checkFunctionApplication' fn (TypeApp (TypeApp tyFunction' argTy) retTy) arg ret = do
1023checkFunctionApplication' fn (TypeApp (TypeApp tyFunction' argTy) retTy) arg ret = do
1024 tyFunction' =?= tyFunction
1024 tyFunction' =?= tyFunction
1025− _ <- maybe (return Nothing) (subsumes Nothing retTy) ret
1026 arg' <- check arg argTy
1025 arg' <- check arg argTy
1026+ case ret of
1027− return (retTy, App fn arg')
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')
1028checkFunctionApplication' fn (ForAll ident ty _) arg ret = do
1031checkFunctionApplication' fn (ForAll ident ty _) arg ret = do
1029 replaced <- replaceVarWithUnknown ident ty
1032 replaced <- replaceVarWithUnknown ident ty
1030 checkFunctionApplication fn replaced arg ret
1033 checkFunctionApplication fn replaced arg ret
@@ -1084,8 +1087,7 @@ subsumes' val ty1 (SaturatedTypeSynonym name tyArgs) = do
1084 subsumes val ty1 ty2
1087 subsumes val ty1 ty2
1085subsumes' (Just val) (ConstrainedType constraints ty1) ty2 = do
1088subsumes' (Just val) (ConstrainedType constraints ty1) ty2 = do
1086 dicts <- getTypeClassDictionaries
1089 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
1089subsumes' val (TypeApp f1 r1) (TypeApp f2 r2) | f1 == tyObject && f2 == tyObject = do
1091subsumes' val (TypeApp f1 r1) (TypeApp f2 r2) | f1 == tyObject && f2 == tyObject = do
1090 let
1092 let
1091 (ts1, r1') = rowToList r1
1093 (ts1, r1') = rowToList r1