git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge pull request #1467 from purescript/862

Fix #862

commita4888d2958447b654f5dc5c08fdd1580132b8550 authorPhil Freeman <paf31@cantab.net> dateMon 14 Sep 2015, 11:07 (11 years ago) parentb843d2fb5a1b02
6 files changed+19−6
examples/failing/Arrays.purs+1−1 examples/failing/MultipleErrors.purs+2−2 examples/failing/Rank2Types.purs+1−1 examples/failing/TypeError.purs+1−1 examples/passing/862.purs+8 src/Language/PureScript/TypeChecker/Types.hs+6−1
examples/failing/Arrays.purs+1−1
@@ -1,4 +1,4 @@
1−-- @shouldFailWith ExprDoesNotHaveType
1+-- @shouldFailWith TypesDoNotUnify
22module Main where
33
44import Prelude
examples/failing/MultipleErrors.purs+2−2
@@ -1,5 +1,5 @@
1−-- @shouldFailWith ExprDoesNotHaveType
2−-- @shouldFailWith ExprDoesNotHaveType
1+-- @shouldFailWith TypesDoNotUnify
2+-- @shouldFailWith TypesDoNotUnify
33module MultipleErrors where
44
55import Prelude
examples/failing/Rank2Types.purs+1−1
@@ -1,4 +1,4 @@
1−-- @shouldFailWith ExprDoesNotHaveType
1+-- @shouldFailWith TypesDoNotUnify
22module Main where
33
44import Prelude
examples/failing/TypeError.purs+1−1
@@ -1,4 +1,4 @@
1−-- @shouldFailWith ExprDoesNotHaveType
1+-- @shouldFailWith TypesDoNotUnify
22module Main where
33
44import Prelude
examples/passing/862.pursnew file+8
@@ -0,0 +1,8 @@
1+module Main where
2+
3+import Prelude
4+import Control.Monad.Eff.Console
5+
6+id' = (\x -> x) <$> \y -> y
7+
8+main = log (id' "Done")
src/Language/PureScript/TypeChecker/Types.hs+6−1
@@ -592,7 +592,12 @@ check' val kt@(KindedType ty kind) = do
592592 return $ TypedValue True val' kt
593593check' (PositionedValue pos _ val) ty =
594594 warnAndRethrowWithPosition pos $ check' val ty
595−check' val ty = throwError . errorMessage $ ExprDoesNotHaveType val ty
595+check' val ty = do
596+ TypedValue _ val' ty' <- infer val
597+ mt <- subsumes (Just val') ty' ty
598+ case mt of
599+ Nothing -> throwError . errorMessage $ SubsumptionCheckFailed
600+ Just v' -> return $ TypedValue True v' ty
596601
597602containsTypeSynonyms :: Type -> Bool
598603containsTypeSynonyms = everythingOnTypes (||) go where