git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Fix #1991, instantiate polymorphic types before unification in if..then.else
e17d536Phil Freeman
examples/passing/1991.pursnew file+20
@@ -0,0 +1,20 @@
1+module Main where
2+
3+import Prelude
4+
5+singleton :: forall a. a -> Array a
6+singleton x = [x]
7+
8+empty :: forall a. Array a
9+empty = []
10+
11+foldMap :: forall a m. (Semigroup m) => (a -> m) -> Array a -> m
12+foldMap f [a, b, c, d, e] = f a <> f b <> f c <> f d <> f e
13+
14+regression :: Array Int
15+regression =
16+ let as = [1,2,3,4,5]
17+ as' = foldMap (\x -> if 1 < x && x < 4 then singleton x else empty) as
18+ in as'
19+
20+main = Control.Monad.Eff.Console.log "Done"
src/Language/PureScript/TypeChecker/Types.hs+5−3
@@ -179,7 +179,7 @@ overTypes f = let (_, f', _) = everywhereOnValues id g id in f'
179 g (TypedValue checkTy val t) = TypedValue checkTy val (f t)
179 g (TypedValue checkTy val t) = TypedValue checkTy val (f t)
180 g (TypeClassDictionary (nm, tys) sco) = TypeClassDictionary (nm, map f tys) sco
180 g (TypeClassDictionary (nm, tys) sco) = TypeClassDictionary (nm, map f tys) sco
181 g other = other
181 g other = other
182−
182+
183-- | Check the kind of a type, failing if it is not of kind *.
183-- | Check the kind of a type, failing if it is not of kind *.
184checkTypeKind ::
184checkTypeKind ::
185 (MonadState CheckState m, MonadError MultipleErrors m) =>
185 (MonadState CheckState m, MonadError MultipleErrors m) =>
@@ -283,8 +283,10 @@ infer' (IfThenElse cond th el) = do
283 cond' <- check cond tyBoolean
283 cond' <- check cond tyBoolean
284 th'@(TypedValue _ _ thTy) <- infer th
284 th'@(TypedValue _ _ thTy) <- infer th
285 el'@(TypedValue _ _ elTy) <- infer el
285 el'@(TypedValue _ _ elTy) <- infer el
286+ (th'', thTy') <- instantiatePolyTypeWithUnknowns th' thTy
287+ (el'', elTy') <- instantiatePolyTypeWithUnknowns el' elTy
286− unifyTypes thTy elTy
288+ unifyTypes thTy' elTy'
287− return $ TypedValue True (IfThenElse cond' th' el') thTy
289+ return $ TypedValue True (IfThenElse cond' th'' el'') thTy'
288infer' (Let ds val) = do
290infer' (Let ds val) = do
289 (ds', val'@(TypedValue _ _ valTy)) <- inferLetBinding [] ds val infer
291 (ds', val'@(TypedValue _ _ valTy)) <- inferLetBinding [] ds val infer
290 return $ TypedValue True (Let ds' val') valTy
292 return $ TypedValue True (Let ds' val') valTy