X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Frename%2FRnSource.lhs;h=2f769207fa7866835cb4896d31fbf6942cba28ba;hb=e4db45612e3efa59251239e1e0b8a0440783b966;hp=b3fdd2ea167a2140ede2e490f25024c4d96bf589;hpb=a27c5f77da8b3b3f00f9902b69a504460f234e8c;p=ghc-hetmet.git diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs index b3fdd2e..2f76920 100644 --- a/compiler/rename/RnSource.lhs +++ b/compiler/rename/RnSource.lhs @@ -190,15 +190,15 @@ rnSrcDecls shadowP group@(HsGroup {hs_valds = val_decls, -- (I) Compute the results and return let {rn_group = HsGroup { hs_valds = rn_val_decls, - hs_tyclds = rn_tycl_decls, - hs_instds = rn_inst_decls, + hs_tyclds = rn_tycl_decls, + hs_instds = rn_inst_decls, hs_derivds = rn_deriv_decls, - hs_fixds = rn_fix_decls, - hs_depds = [], -- deprecs are returned in the tcg_env (see below) - -- not in the HsGroup - hs_fords = rn_foreign_decls, - hs_defds = rn_default_decls, - hs_ruleds = rn_rule_decls, + hs_fixds = rn_fix_decls, + hs_depds = [], -- deprecs are returned in the tcg_env + -- (see below) not in the HsGroup + hs_fords = rn_foreign_decls, + hs_defds = rn_default_decls, + hs_ruleds = rn_rule_decls, hs_docs = rn_docs } ; other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs6, src_fvs3, @@ -272,6 +272,9 @@ rnSrcFixityDecls :: [LFixitySig RdrName] -> RnM [LFixitySig Name] -- Rename the fixity decls, so we can put -- the renamed decls in the renamed syntax tree -- Errors if the thing being fixed is not defined locally. +-- +-- The returned FixitySigs are not actually used for anything, +-- except perhaps the GHCi API rnSrcFixityDecls fix_decls = do fix_decls <- mapM rn_decl fix_decls return (concat fix_decls) @@ -280,7 +283,7 @@ rnSrcFixityDecls fix_decls -- GHC extension: look up both the tycon and data con -- for con-like things; hence returning a list -- If neither are in scope, report an error; otherwise - -- add both to the fixity env + -- return a fixity sig for each (slightly odd) rn_decl (L loc (FixitySig (L name_loc rdr_name) fixity)) = setSrcSpan name_loc $ -- this lookup will fail if the definition isn't local @@ -326,8 +329,8 @@ rnSrcDeprecDecls decls (map (\ (L loc (Deprecation rdr_name _)) -> L loc rdr_name) decls) dupDeprecDecl (L loc _) rdr_name - = vcat [ptext SLIT("Multiple deprecation declarations for") <+> quotes (ppr rdr_name), - ptext SLIT("also at ") <+> ppr loc] + = vcat [ptext (sLit "Multiple deprecation declarations for") <+> quotes (ppr rdr_name), + ptext (sLit "also at ") <+> ppr loc] \end{code} @@ -365,7 +368,7 @@ rnHsForeignDecl (ForeignExport name ty spec) -- we add it to the free-variable list. It might, for example, -- be imported from another module -fo_decl_msg name = ptext SLIT("In the foreign declaration for") <+> ppr name +fo_decl_msg name = ptext (sLit "In the foreign declaration for") <+> ppr name \end{code} @@ -517,9 +520,9 @@ rnHsRuleDecl (HsRule rule_name act vars lhs fv_lhs rhs fv_rhs) returnM (RuleBndrSig (L loc id) t', fvs) badRuleVar name var - = sep [ptext SLIT("Rule") <+> doubleQuotes (ftext name) <> colon, - ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+> - ptext SLIT("does not appear on left hand side")] + = sep [ptext (sLit "Rule") <+> doubleQuotes (ftext name) <> colon, + ptext (sLit "Forall'd variable") <+> quotes (ppr var) <+> + ptext (sLit "does not appear on left hand side")] \end{code} Note [Rule LHS validity checking] @@ -580,11 +583,11 @@ validRuleLhs foralls lhs -} badRuleLhsErr name lhs bad_e - = sep [ptext SLIT("Rule") <+> ftext name <> colon, - nest 4 (vcat [ptext SLIT("Illegal expression:") <+> ppr bad_e, - ptext SLIT("in left-hand side:") <+> ppr lhs])] + = sep [ptext (sLit "Rule") <+> ftext name <> colon, + nest 4 (vcat [ptext (sLit "Illegal expression:") <+> ppr bad_e, + ptext (sLit "in left-hand side:") <+> ppr lhs])] $$ - ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd") + ptext (sLit "LHS must be of form (f e1 .. en) where f is not forall'd") \end{code} @@ -779,8 +782,8 @@ rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname, at_doc = text "In the associated types for class" <+> ppr cname badGadtStupidTheta tycon - = vcat [ptext SLIT("No context is allowed on a GADT-style data declaration"), - ptext SLIT("(You can put a context on each contructor, though.)")] + = vcat [ptext (sLit "No context is allowed on a GADT-style data declaration"), + ptext (sLit "(You can put a context on each contructor, though.)")] \end{code} %********************************************************* @@ -939,7 +942,7 @@ rnATs ats = mapFvRn (wrapLocFstM rn_at) ats noPatterns = text "Default definition for an associated synonym cannot have" <+> text "type pattern" -repeatedTyVar tv = ptext SLIT("Illegal repeated type variable") <+> +repeatedTyVar tv = ptext (sLit "Illegal repeated type variable") <+> quotes (ppr tv) -- This data decl will parse OK @@ -955,7 +958,7 @@ repeatedTyVar tv = ptext SLIT("Illegal repeated type variable") <+> checkConName name = checkErr (isRdrDataCon name) (badDataCon name) badDataCon name - = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)] + = hsep [ptext (sLit "Illegal data constructor name"), quotes (ppr name)] \end{code} @@ -1062,8 +1065,8 @@ rnSplice (HsSplice n expr) checkTH e what = returnM () -- OK #else checkTH e what -- Raise an error in a stage-1 compiler - = addErr (vcat [ptext SLIT("Template Haskell") <+> text what <+> - ptext SLIT("illegal in a stage-1 compiler"), + = addErr (vcat [ptext (sLit "Template Haskell") <+> text what <+> + ptext (sLit "illegal in a stage-1 compiler"), nest 2 (ppr e)]) #endif \end{code}