From c02d1273205612a724770830b5a75d6a443ba376 Mon Sep 17 00:00:00 2001
From: Liam Goodacre <goodacre.liam@gmail.com>
Date: Sun, 22 Oct 2017 19:49:22 +0100
Subject: [PATCH] Instantiate abstraction body during inference

---
 examples/passing/3125.purs                   | 16 ++++++++++++++++
 src/Language/PureScript/TypeChecker/Types.hs |  3 ++-
 2 files changed, 18 insertions(+), 1 deletion(-)
 create mode 100644 examples/passing/3125.purs

diff --git a/examples/passing/3125.purs b/examples/passing/3125.purs
new file mode 100644
index 0000000000..d427fd46bb
--- /dev/null
+++ b/examples/passing/3125.purs
@@ -0,0 +1,16 @@
+module Main where
+
+import Prelude
+import Data.Monoid (class Monoid, mempty)
+import Control.Monad.Eff.Console (log, logShow)
+
+data B a = B a a
+
+memptyB :: forall a b. Monoid b => B (a -> b)
+memptyB = B l r where
+  l _ = mempty
+  r _ = mempty
+
+main = do
+  logShow $ case (memptyB :: B (Int -> Array Unit)) of B l r -> l 0 == r 0
+  log "Done"
diff --git a/src/Language/PureScript/TypeChecker/Types.hs b/src/Language/PureScript/TypeChecker/Types.hs
index e3bb2d442b..8e7adf80d8 100644
--- a/src/Language/PureScript/TypeChecker/Types.hs
+++ b/src/Language/PureScript/TypeChecker/Types.hs
@@ -357,7 +357,8 @@ infer' (Abs binder ret)
       ty <- freshType
       withBindingGroupVisible $ bindLocalVariables [(arg, ty, Defined)] $ do
         body@(TypedValue _ _ bodyTy) <- infer' ret
-        return $ TypedValue True (Abs (VarBinder arg) body) $ function ty bodyTy
+        (body', bodyTy') <- instantiatePolyTypeWithUnknowns body bodyTy
+        return $ TypedValue True (Abs (VarBinder arg) body') (function ty bodyTy')
   | otherwise = internalError "Binder was not desugared"
 infer' (App f arg) = do
   f'@(TypedValue _ _ ft) <- infer f