git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Fix #1991, instantiate polymorphic types before unification in if..then.else
commite17d536052761592a5dd4a235bf286ddd4af050d authorPhil Freeman <paf31@cantab.net> dateSat 2 Apr 2016, 16:52 (11 years ago) parentfd59e1a
2 files changed+25−3
compare with golang
unifiedsplit
examples/passing/1991.purs+20 src/Language/PureScript/TypeChecker/Types.hs+5−3
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'
179179 g (TypedValue checkTy val t) = TypedValue checkTy val (f t)
180180 g (TypeClassDictionary (nm, tys) sco) = TypeClassDictionary (nm, map f tys) sco
181181 g other = other
182−
182+
183183-- | Check the kind of a type, failing if it is not of kind *.
184184checkTypeKind ::
185185 (MonadState CheckState m, MonadError MultipleErrors m) =>
@@ -283,8 +283,10 @@ infer' (IfThenElse cond th el) = do
283283 cond' <- check cond tyBoolean
284284 th'@(TypedValue _ _ thTy) <- infer th
285285 el'@(TypedValue _ _ elTy) <- infer el
286− unifyTypes thTy elTy
287− return $ TypedValue True (IfThenElse cond' th' el') thTy
286+ (th'', thTy') <- instantiatePolyTypeWithUnknowns th' thTy
287+ (el'', elTy') <- instantiatePolyTypeWithUnknowns el' elTy
288+ unifyTypes thTy' elTy'
289+ return $ TypedValue True (IfThenElse cond' th'' el'') thTy'
288290infer' (Let ds val) = do
289291 (ds', val'@(TypedValue _ _ valTy)) <- inferLetBinding [] ds val infer
290292 return $ TypedValue True (Let ds' val') valTy