[commit: ghc] wip/orf-reboot: Use Maybe Name instead of Parent where that's what we mean (ac647b3)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/orf-reboot
Link       : http://ghc.haskell.org/trac/ghc/changeset/ac647b3d530777cd247b4ed5d9c65b200ddf9529/ghc

>---------------------------------------------------------------

commit ac647b3d530777cd247b4ed5d9c65b200ddf9529
Author: Adam Gundry <adam at well-typed.com>
Date:   Tue Jul 14 21:01:13 2015 +0100

    Use Maybe Name instead of Parent where that's what we mean


>---------------------------------------------------------------

ac647b3d530777cd247b4ed5d9c65b200ddf9529
 compiler/rename/RnEnv.hs | 21 +++++++++------------
 compiler/rename/RnPat.hs | 15 ++++++++-------
 2 files changed, 17 insertions(+), 19 deletions(-)

diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs
index 73aa90d..c938d73 100644
--- a/compiler/rename/RnEnv.hs
+++ b/compiler/rename/RnEnv.hs
@@ -414,7 +414,7 @@ lookupInstDeclBndr cls what rdr
                                 -- warnings when a deprecated class
                                 -- method is defined. We only warn
                                 -- when it's used
-                          (ParentIs cls) doc rdr }
+                          (Just cls) doc rdr }
   where
     doc = what <+> ptext (sLit "of class") <+> quotes (ppr cls)
 
@@ -461,8 +461,8 @@ lookupConstructorFields con_name
 -- unambiguous because there is only one field id 'fld' in scope.
 -- But currently it's rejected.
 lookupSubBndrOcc :: Bool
-                 -> Parent  -- NoParent   => just look it up as usual
-                            -- ParentIs p => use p to disambiguate
+                 -> Maybe Name  -- Nothing => just look it up as usual
+                                -- Just p  => use parent p to disambiguate
                  -> SDoc -> RdrName
                  -> RnM Name
 lookupSubBndrOcc warnIfDeprec parent doc rdr_name
@@ -496,19 +496,16 @@ lookupSubBndrOcc warnIfDeprec parent doc rdr_name
       | isQual rdr_name = rdr_name
       | otherwise       = greUsedRdrName gre
 
-lookupSubBndrGREs :: GlobalRdrEnv -> Parent -> RdrName -> [GlobalRdrElt]
--- If Parent = NoParent, just do a normal lookup
--- If Parent = Parent p then find all GREs that
+lookupSubBndrGREs :: GlobalRdrEnv -> Maybe Name -> RdrName -> [GlobalRdrElt]
+-- If parent = Nothing, just do a normal lookup
+-- If parent = Just 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)
-      FldParent { par_is = p }
+      Nothing               -> pickGREs rdr_name gres
+      Just p
         | isUnqual rdr_name -> filter (parent_is p) gres
         | otherwise         -> filter (parent_is p) (pickGREs rdr_name gres)
 
@@ -1196,7 +1193,7 @@ lookupBindGroupOcc ctxt what rdr_name
   where
     lookup_cls_op cls
       = do { env <- getGlobalRdrEnv
-           ; let gres = lookupSubBndrGREs env (ParentIs cls) rdr_name
+           ; let gres = lookupSubBndrGREs env (Just cls) rdr_name
            ; case gres of
                []      -> return (Left (unknownSubordinateErr doc rdr_name))
                (gre:_) -> return (Right (gre_name gre)) }
diff --git a/compiler/rename/RnPat.hs b/compiler/rename/RnPat.hs
index 9bd3718..08c836b 100644
--- a/compiler/rename/RnPat.hs
+++ b/compiler/rename/RnPat.hs
@@ -552,7 +552,8 @@ rnHsRecFields 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)
 
-    rn_fld :: Bool -> Parent -> LHsRecField RdrName (Located arg) -> RnM (LHsRecField Name (Located arg))
+    rn_fld :: Bool -> Maybe Name -> LHsRecField RdrName (Located arg)
+           -> RnM (LHsRecField Name (Located arg))
     rn_fld pun_ok parent (L l (HsRecField { hsRecFieldLbl = L loc (FieldOcc lbl _)
                                           , hsRecFieldArg = arg
                                           , hsRecPun      = pun }))
@@ -611,7 +612,7 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
                                     HsRecFieldCon {} -> arg_in_scope lbl
                                     _other           -> True ]
 
-           ; addUsedRdrNames (map (\ (_, _, gre) -> greUsedRdrName gre) dot_dot_gres) -- AMG TODO wrong
+           ; addUsedRdrNames (map (\ (_, _, gre) -> greUsedRdrName gre) dot_dot_gres)
            ; return [ L loc (HsRecField
                         { hsRecFieldLbl = L loc (FieldOcc arg_rdr sel)
                         , hsRecFieldArg = L loc (mk_arg arg_rdr)
@@ -619,12 +620,12 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
                     | (lbl, sel, _) <- dot_dot_gres
                     , let arg_rdr = mkVarUnqual lbl ] }
 
-    check_disambiguation :: Bool -> Maybe Name -> RnM Parent
-    -- When disambiguation is on,
+    check_disambiguation :: Bool -> Maybe Name -> RnM (Maybe Name)
+    -- When disambiguation is on, return name of parent tycon.
     check_disambiguation disambig_ok mb_con
       | disambig_ok, Just con <- mb_con
-      = do { env <- getGlobalRdrEnv; return (ParentIs (find_tycon env con)) }
-      | otherwise = return NoParent
+      = do { env <- getGlobalRdrEnv; return (Just (find_tycon env con)) }
+      | otherwise = return Nothing
 
     find_tycon :: GlobalRdrEnv -> Name {- DataCon -} -> Name {- TyCon -}
     -- Return the parent *type constructor* of the data constructor
@@ -676,7 +677,7 @@ rnHsRecUpdFields flds
                                       Nothing -> do { addErr (unknownSubordinateErr doc lbl)
                                                     ; return (Right []) }
                                       Just r  -> return r }
-                          else fmap Left $ lookupSubBndrOcc True NoParent doc lbl
+                          else fmap Left $ lookupSubBndrOcc True Nothing doc lbl
            ; arg' <- if pun
                      then do { checkErr pun_ok (badPun (L loc lbl))
                              ; return (L loc (HsVar lbl)) }