Improve semantics of wild-card expansion (fixes #5334)

When expanding the {..} stuff in an *expression*, take
account of which variables are in scope.

I updated the documentation, and in doing so found that
part of the previously-documented semantics wasn't implemented
(namely the stuff about fields in scope), so I fixed that too.

compiler/rename/RnEnv.lhs

@@ -11,7 +11,8 @@ module RnEnv (
         lookupGlobalOccRn, lookupGlobalOccRn_maybe,
 	lookupLocalDataTcNames, lookupSigOccRn,
 	lookupFixityRn, lookupTyFixityRn, 
-	lookupInstDeclBndr, lookupSubBndr, lookupConstructorFields,
+	lookupInstDeclBndr, lookupSubBndr, 
+        lookupSubBndrGREs, lookupConstructorFields,
 	lookupSyntaxName, lookupSyntaxTable, lookupIfThenElse,
 	lookupGreRn, lookupGreLocalRn, lookupGreRn_maybe,
 	getLookupOccRn, addUsedRdrNames,
@@ -288,32 +289,19 @@ lookupSubBndr parent doc rdr_name
   = lookupOrig rdr_mod rdr_occ
 
   | otherwise	-- Find all the things the rdr-name maps to
-  = do	{	-- and pick the one with the right parent name
-	; env <- getGlobalRdrEnv
-        ; let gres = lookupGlobalRdrEnv env (rdrNameOcc rdr_name)
-	; case pick parent gres  of
+  = do	{	-- and pick the one with the right parent namep
+	  env <- getGlobalRdrEnv
+	; case lookupSubBndrGREs env parent rdr_name of
 		-- NB: lookupGlobalRdrEnv, not lookupGRE_RdrName!
 		--     The latter does pickGREs, but we want to allow 'x'
 		--     even if only 'M.x' is in scope
 	    [gre] -> do { addUsedRdrName gre (used_rdr_name gre)
                         ; return (gre_name gre) }
 	    []    -> do { addErr (unknownSubordinateErr doc rdr_name)
-			; traceRn (text "RnEnv.lookup_sub_bndr" <+> (ppr rdr_name $$ ppr gres))
 			; return (mkUnboundName rdr_name) }
 	    gres  -> do { addNameClashErrRn rdr_name gres
 			; return (gre_name (head gres)) } }
   where
-    rdr_occ = rdrNameOcc rdr_name    
-
-    pick NoParent gres		-- Normal lookup 
-      = pickGREs rdr_name gres
-    pick (ParentIs p) gres	-- Disambiguating lookup
-      | isUnqual rdr_name = filter (right_parent p) gres
-      | otherwise         = filter (right_parent p) (pickGREs rdr_name gres)
-
-    right_parent p (GRE { gre_par = ParentIs p' }) = p==p' 
-    right_parent _ _                               = False
-
     -- Note [Usage for sub-bndrs]
     used_rdr_name gre
       | isQual rdr_name = rdr_name
@@ -328,7 +316,26 @@ lookupSubBndr parent doc rdr_name
       = 	    -- Only qualified imports available, so make up 
 		    -- a suitable qualifed name from the first imp_spec
         ASSERT( not (null imp_specs) )
-        mkRdrQual (is_as (is_decl (head imp_specs))) rdr_occ
+        mkRdrQual (is_as (is_decl (head imp_specs))) (rdrNameOcc rdr_name)
+
+lookupSubBndrGREs :: GlobalRdrEnv -> Parent -> RdrName -> [GlobalRdrElt]
+-- If Parent = NoParent, just do a normal lookup
+-- If Parent = Parent p then find all GREs that
+--   (a) have parent p
+--   (b) for Unqual, are in scope qualified or unqualified
+--       for Qual, are in scope with that qualification
+lookupSubBndrGREs env parent rdr_name
+  = case parent of
+      NoParent   -> pickGREs rdr_name gres
+      ParentIs p 
+        | isUnqual rdr_name -> filter (parent_is p) gres
+        | otherwise         -> filter (parent_is p) (pickGREs rdr_name gres)
+
+  where
+    gres = lookupGlobalRdrEnv env (rdrNameOcc rdr_name)
+
+    parent_is p (GRE { gre_par = ParentIs p' }) = p == p'
+    parent_is _ _                               = False
 
 newIPNameRn :: IPName RdrName -> TcRnIf m n (IPName Name)
 newIPNameRn ip_rdr = newIPName (mapIPName rdrNameOcc ip_rdr)

compiler/rename/RnPat.lhs

@@ -47,7 +47,8 @@ import Name
 import NameSet
 import RdrName
 import BasicTypes
-import ListSetOps	( removeDups, minusList )
+import Util		( notNull )
+import ListSetOps	( removeDups )
 import Outputable
 import SrcLoc
 import FastString
@@ -468,15 +469,13 @@ rnHsRecFields1 ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot }
             Nothing  -> ptext (sLit "constructor field name")
             Just con -> ptext (sLit "field of constructor") <+> quotes (ppr con)
 
-    name_to_arg (L loc n) = L loc (mk_arg (mkRdrUnqual (nameOccName n)))
-
     rn_fld pun_ok parent (HsRecField { hsRecFieldId = fld
                        	      	     , hsRecFieldArg = arg
                        	      	     , hsRecPun = pun })
-      = do { fld' <- wrapLocM (lookupSubBndr parent doc) fld
+      = do { fld'@(L loc fld_nm) <- wrapLocM (lookupSubBndr parent doc) fld
            ; arg' <- if pun 
                      then do { checkErr pun_ok (badPun fld)
-                             ; return (name_to_arg fld') }
+                             ; return (L loc (mk_arg (mkRdrUnqual (nameOccName fld_nm)))) }
                      else return arg
            ; return (HsRecField { hsRecFieldId = fld'
                                 , hsRecFieldArg = arg'
@@ -491,30 +490,54 @@ rnHsRecFields1 ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot }
         do { loc <- getSrcSpanM	-- Rather approximate
            ; dd_flag <- xoptM Opt_RecordWildCards
            ; checkErr dd_flag (needFlagDotDot ctxt)
-
+	   ; (rdr_env, lcl_env) <- getRdrEnvs
            ; con_fields <- lookupConstructorFields con
            ; let present_flds = getFieldIds flds
-                 absent_flds  = con_fields `minusList` present_flds
+                 parent_tc = find_tycon rdr_env con
                  extras = [ HsRecField
-                              { hsRecFieldId = L loc f
-                              , hsRecFieldArg = name_to_arg (L loc f)
+                              { hsRecFieldId = loc_f
+                              , hsRecFieldArg = L loc (mk_arg arg_rdr)
                               , hsRecPun = False }
-                          | f <- absent_flds ]
+                          | f <- con_fields
+			  , let loc_f = L loc f 
+			        arg_rdr = mkRdrUnqual (nameOccName f)
+			  , not (f `elem` present_flds)
+			  , fld_in_scope f
+                          , case ctxt of
+                              HsRecFieldCon {} -> arg_in_scope arg_rdr
+                              _other           -> True ]
+
+                   -- Only fill in fields whose selectors are in scope (somehow)
+	         fld_in_scope fld = not (null (lookupGRE_Name rdr_env fld))
+
+                   -- For constructor uses, the arg should be in scope (unqualified)
+		   -- ignoring the record field itself
+		   -- 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 rdr = rdr `elemLocalRdrEnv` lcl_env
+                                 || notNull [ gre | gre <- lookupGRE_RdrName rdr rdr_env
+                                                  , case gre_par gre of
+                                                      ParentIs p -> p /= parent_tc
+                                                      _          -> True ]
 
            ; return (flds ++ extras) }
 
     check_disambiguation :: Bool -> Maybe Name -> RnM Parent
-    -- When disambiguation is on, return the parent *type constructor*
-    -- That is, the parent of the data constructor.  That's the parent
-    -- to use for looking up record fields.
+    -- When disambiguation is on, 
     check_disambiguation disambig_ok mb_con
       | disambig_ok, Just con <- mb_con
-      = do { env <- getGlobalRdrEnv
-           ; return (case lookupGRE_Name env con of
-	       	       [gre] -> gre_par gre
-               	       gres  -> WARN( True, ppr con <+> ppr gres ) NoParent) }
+      = do { env <- getGlobalRdrEnv; return (ParentIs (find_tycon env con)) }
       | otherwise = return NoParent
  
+    find_tycon :: GlobalRdrEnv -> Name {- DataCon -} -> Name {- TyCon -}
+    -- Return the parent *type constructor* of the data constructor
+    -- That is, the parent of the data constructor.  
+    -- That's the parent to use for looking up record fields.
+    find_tycon env con 
+      = case lookupGRE_Name env con of
+	  [GRE { gre_par = ParentIs p }] -> p
+          gres  -> pprPanic "find_tycon" (ppr con $$ ppr gres)
+
     dup_flds :: [[RdrName]]
         -- Each list represents a RdrName that occurred more than once
         -- (the list contains all occurrences)

docs/users_guide/glasgow_exts.xml

@@ -1812,18 +1812,35 @@ the same as the omitted field names.
 
 <listitem><para>
 The "<literal>..</literal>" expands to the missing
-<emphasis>in-scope</emphasis> record fields, where "in scope"
-includes both unqualified and qualified-only.
-Any fields that are not in scope are not filled in.  For example
+<emphasis>in-scope</emphasis> record fields.  
+Specifically the expansion of "<literal>C {..}</literal>" includes
+<literal>f</literal> if and only if:
+<itemizedlist>
+<listitem><para>
+<literal>f</literal> is a record field of constructor <literal>C</literal>.
+</para></listitem>
+<listitem><para>
+The record field <literal>f</literal> is in scope somehow (either qualified or unqualified).
+</para></listitem>
+<listitem><para>
+In the case of expressions (but not patterns), 
+the variable <literal>f</literal> is in scope unqualified, 
+apart from the binding of the record selector itself.
+</para></listitem>
+</itemizedlist>
+For example
 <programlisting>
 module M where
   data R = R { a,b,c :: Int }
 module X where
-  import qualified M( R(a,b) )
-  f a b = R { .. }
-</programlisting>
-The <literal>{..}</literal> expands to <literal>{M.a=a,M.b=b}</literal>,
-omitting <literal>c</literal> since it is not in scope at all.
+  import M( R(a,c) )
+  f b = R { .. }
+</programlisting>
+The <literal>R{..}</literal> expands to <literal>R{M.a=a}</literal>,
+omitting <literal>b</literal> since the record field is not in scope,
+and omitting <literal>c</literal> since the variable <literal>c</literal>
+is not in scope (apart from the binding of the 
+record selector <literal>c</literal>, of course).
 </para></listitem>
 </itemizedlist>
 </para>