Add sensible locations to record-selector bindings
authorSimon Peyton Jones <simonpj@microsoft.com>
Tue, 5 Jun 2012 12:35:07 +0000 (13:35 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Tue, 5 Jun 2012 12:35:07 +0000 (13:35 +0100)
compiler/typecheck/TcTyClsDecls.lhs

index 114140c..3db2423 100644 (file)
@@ -1518,11 +1518,11 @@ mkRecSelBinds tycons
 
 mkRecSelBind :: (TyCon, FieldLabel) -> (LSig Name, LHsBinds Name)
 mkRecSelBind (tycon, sel_name)
-  = (L sel_loc (IdSig sel_id), unitBag (L sel_loc sel_bind))
+  = (L loc (IdSig sel_id), unitBag (L loc sel_bind))
   where
-    sel_loc     = getSrcSpan tycon
-    sel_id     = Var.mkExportedLocalVar rec_details sel_name 
-                                         sel_ty vanillaIdInfo
+    loc    = getSrcSpan sel_name
+    sel_id = Var.mkExportedLocalVar rec_details sel_name 
+                                    sel_ty vanillaIdInfo
     rec_details = RecSelId { sel_tycon = tycon, sel_naughty = is_naughty }
 
     -- Find a representative constructor, con1
@@ -1549,23 +1549,23 @@ mkRecSelBind (tycon, sel_name)
     --    where cons_w_field = [C2,C7]
     sel_bind | is_naughty = mkTopFunBind sel_lname [mkSimpleMatch [] unit_rhs]
              | otherwise  = mkTopFunBind sel_lname (map mk_match cons_w_field ++ deflt)
-    mk_match con = mkSimpleMatch [noLoc (mk_sel_pat con)]
-                                 (noLoc (HsVar field_var))
-    mk_sel_pat con = ConPatIn (noLoc (getName con)) (RecCon rec_fields)
+    mk_match con = mkSimpleMatch [L loc (mk_sel_pat con)]
+                                 (L loc (HsVar field_var))
+    mk_sel_pat con = ConPatIn (L loc (getName con)) (RecCon rec_fields)
     rec_fields = HsRecFields { rec_flds = [rec_field], rec_dotdot = Nothing }
     rec_field  = HsRecField { hsRecFieldId = sel_lname
-                            , hsRecFieldArg = nlVarPat field_var
+                            , hsRecFieldArg = L loc (VarPat field_var)
                             , hsRecPun = False }
-    sel_lname = L sel_loc sel_name
-    field_var = mkInternalName (mkBuiltinUnique 1) (getOccName sel_name) sel_loc
+    sel_lname = L loc sel_name
+    field_var = mkInternalName (mkBuiltinUnique 1) (getOccName sel_name) loc
 
     -- Add catch-all default case unless the case is exhaustive
     -- We do this explicitly so that we get a nice error message that
     -- mentions this particular record selector
     deflt | not (any is_unused all_cons) = []
-         | otherwise = [mkSimpleMatch [nlWildPat
-                           (nlHsApp (nlHsVar (getName rEC_SEL_ERROR_ID))
-                                    (nlHsLit msg_lit))]
+         | otherwise = [mkSimpleMatch [L loc (WildPat placeHolderType)
+                           (mkHsApp (L loc (HsVar (getName rEC_SEL_ERROR_ID)))
+                                    (L loc (HsLit msg_lit)))]
 
        -- Do not add a default case unless there are unmatched
        -- constructors.  We must take account of GADTs, else we