From d5f19714ef9789d4c1d5ea029f06add296162140 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Facundo=20Dom=C3=ADnguez?= <facundo.dominguez@tweag.io>
Date: Thu, 8 Sep 2016 23:07:20 -0300
Subject: Fix the local type environment of module finalizers.

Summary:
Before, the local type environment of the finalizer was the one present
when the finalizer was added. This ignored the top-level Ids that would
be present in the local type environment at the end of type-checking.
This behavior was introduced in the fix to #11832.

Now the local type environment at the end of type-checking is used to
extend the local type environment of the finalizer.

Test Plan: ./validate

Reviewers: simonpj, bgamari, austin

Subscribers: mboes, thomie

Differential Revision: https://phabricator.haskell.org/D2519

GHC Trac Issues: #11832
---
 compiler/typecheck/TcRnMonad.hs              |  7 ++++++-
 testsuite/tests/th/TH_reifyGlobalDefs.hs     | 22 ++++++++++++++++++++++
 testsuite/tests/th/TH_reifyGlobalDefs.stderr |  2 ++
 testsuite/tests/th/all.T                     |  1 +
 4 files changed, 31 insertions(+), 1 deletion(-)
 create mode 100644 testsuite/tests/th/TH_reifyGlobalDefs.hs
 create mode 100644 testsuite/tests/th/TH_reifyGlobalDefs.stderr

diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs
index a83fbf26bd..1c845c305e 100644
--- a/compiler/typecheck/TcRnMonad.hs
+++ b/compiler/typecheck/TcRnMonad.hs
@@ -1539,7 +1539,12 @@ addModFinalizersWithLclEnv mod_finalizers
   = do lcl_env <- getLclEnv
        th_modfinalizers_var <- fmap tcg_th_modfinalizers getGblEnv
        updTcRef th_modfinalizers_var $ \fins ->
-         setLclEnv lcl_env (runRemoteModFinalizers mod_finalizers)
+         -- We extend the current local type environment with the local type
+         -- environment at the end of type-checking which contains all the
+         -- top-level Ids.
+         updLclEnv (\env -> lcl_env
+                      { tcl_env = plusNameEnv (tcl_env env) (tcl_env lcl_env) })
+                   (runRemoteModFinalizers mod_finalizers)
          : fins
 #else
 addModFinalizersWithLclEnv :: ThModFinalizers -> TcM ()
diff --git a/testsuite/tests/th/TH_reifyGlobalDefs.hs b/testsuite/tests/th/TH_reifyGlobalDefs.hs
new file mode 100644
index 0000000000..d909b579d2
--- /dev/null
+++ b/testsuite/tests/th/TH_reifyGlobalDefs.hs
@@ -0,0 +1,22 @@
+-- test reification of global definitions
+{-# LANGUAGE TemplateHaskell #-}
+import Language.Haskell.TH.Syntax
+import System.IO
+
+
+g :: Int
+g = 1
+
+main :: IO ()
+main =
+    $(do
+      let printTypeOf n = do
+            addModFinalizer $ do
+              VarI _ t _ <- reify (mkName n)
+              runIO $ hPutStrLn stderr (n ++ " :: " ++ show t)
+      printTypeOf "g"
+      ds <- [d| f = True |]
+      addTopDecls ds
+      printTypeOf "f"
+      [| return () |]
+     )
diff --git a/testsuite/tests/th/TH_reifyGlobalDefs.stderr b/testsuite/tests/th/TH_reifyGlobalDefs.stderr
new file mode 100644
index 0000000000..f5102490d5
--- /dev/null
+++ b/testsuite/tests/th/TH_reifyGlobalDefs.stderr
@@ -0,0 +1,2 @@
+f :: ConT GHC.Types.Bool
+g :: ConT GHC.Types.Int
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index 5d2fe3b051..5e72fef4ae 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -78,6 +78,7 @@ test('TH_spliceD2',
 test('TH_reifyDecl1', normal, compile, ['-v0'])
 test('TH_reifyDecl2', normal, compile, ['-v0'])
 test('TH_reifyLocalDefs', normal, compile, ['-v0'])
+test('TH_reifyGlobalDefs', normal, compile, ['-v0'])
 
 test('TH_reifyMkName', normal, compile, ['-v0'])
 
-- 
cgit v1.2.1