Narrow the use of record wildcards slightly

In reviewing the fix to Trac #12130 I found the wild-card
fill-in code for ".." notation in record constructions hard
to understand.  It went to great contortions (including the
find_tycon code) to allow
    data T = C { x, y :: Int }
    f x = C { .. }
to expand to
    f x = C { x = x, y = y }
where 'y' is an /imported function/!  That seems way over the top
for what record wildcards are supposed to do.

So I have narrowed the record-wildcard expansion to include only
/locally-bound/ variables; i.e. not top level, and certainly not
imported.

I don't think anyone is using record wildcards in this bizarre way, so
I don't expect any fallout. Even if there is, you can easily
initialise fields with eponymous but imported values by hand.

An intermediate position would be to allow /local/ top-level
definitions.  But I doubt anyone is doing that either.

Let's see if there's any fallout.  It's a local change, easy to
revert, so I've just gone ahead to save everyone's time.

1 files changed, 23 insertions, 16 deletions

diff --git a/compiler/rename/RnPat.hs b/compiler/rename/RnPat.hs
index 8c7831497b..f44d492fe0 100644
--- a/compiler/rename/RnPat.hs
+++ b/compiler/rename/RnPat.hs
@@ -588,23 +588,13 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
            ; con_fields <- lookupConstructorFields con
            ; when (null con_fields) (addErr (badDotDotCon con))
            ; let present_flds = map (occNameFS . rdrNameOcc) $ getFieldLbls flds
-                 parent_tc = find_tycon rdr_env con
 
                    -- For constructor uses (but not patterns)
-                   -- the arg should be in scope (unqualified)
-                   -- ignoring the record field itself
+                   -- the arg should be in scope locally;
+                   -- i.e. not top level or imported
                    -- Eg.  data R = R { x,y :: Int }
                    --      f x = R { .. }   -- Should expand to R {x=x}, not R{x=x,y=y}
-                 arg_in_scope lbl
-                   = rdr `elemLocalRdrEnv` lcl_env
-                   || notNull [ gre | gre <- lookupGRE_RdrName rdr rdr_env
-                                    , case gre_par gre of
-                                        ParentIs p     -> Just p /= parent_tc
-                                        FldParent p _  -> Just p /= parent_tc
-                                        PatternSynonym -> False
-                                        NoParent       -> True ]
-                   where
-                     rdr = mkVarUnqual lbl
+                 arg_in_scope lbl = mkVarUnqual lbl `elemLocalRdrEnv` lcl_env
 
                  dot_dot_gres = [ (lbl, sel, head gres)
                                 | fl <- con_fields
@@ -646,11 +636,12 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
       | Just gre <- lookupGRE_Name env con_name
       = case gre_par gre of
           ParentIs p -> Just p
-          _          -> Nothing
+          _          -> Nothing   -- Can happen if the con_name
+                                  -- is for a pattern synonym
 
       | otherwise = Nothing
-        -- This can happen if the datacon is not in scope
-        -- and we are in a TH splice (Trac #12130)
+        -- Data constructor not lexically in scope at all
+        -- See Note [Disambiguation and Template Haskell]
 
     dup_flds :: [[RdrName]]
         -- Each list represents a RdrName that occurred more than once
@@ -659,6 +650,22 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
     (_, dup_flds) = removeDups compare (getFieldLbls flds)
 
 
+{- Note [Disambiguation and Template Haskell]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider (Trac #12130)
+   module Foo where
+     import M
+     b = $(funny)
+
+   module M(funny) where
+     data T = MkT { x :: Int }
+     funny :: Q Exp
+     funny = [| MkT { x = 3 } |]
+
+When we splice, neither T nor MkT are lexically in scope, so find_tycon will
+fail.  But there is no need for diambiguation anyway, so we just return Nothing
+-}
+
 rnHsRecUpdFields
     :: [LHsRecUpdField RdrName]
     -> RnM ([LHsRecUpdField Name], FreeVars)