X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FDesugar.lhs;h=6842e9d6d624ac49846b191e7b96fda240d13bf7;hb=05535340ae496c57ff218e016da6649ca1640754;hp=e3874a7017d0c6c43f2265f7f9aea2b032edf4d9;hpb=d74b100eaa9e782710b752805ac148e91e5c6850;p=ghc-hetmet.git diff --git a/compiler/deSugar/Desugar.lhs b/compiler/deSugar/Desugar.lhs index e3874a7..6842e9d 100644 --- a/compiler/deSugar/Desugar.lhs +++ b/compiler/deSugar/Desugar.lhs @@ -8,8 +8,6 @@ The Desugarer: turning HsSyn into Core. \begin{code} module Desugar ( deSugar, deSugarExpr ) where -#include "HsVersions.h" - import DynFlags import StaticFlags import HscTypes @@ -40,7 +38,9 @@ import SrcLoc import Maybes import FastString import Coverage + import Data.IORef +import Data.Char \end{code} %************************************************************************ @@ -151,13 +151,15 @@ mkAutoScc mod exports | not opt_SccProfilingOn -- No profiling = NoSccs | opt_AutoSccsOnAllToplevs -- Add auto-scc on all top-level things - = AddSccs mod (\_ -> True) + = AddSccs mod (\id -> not $ isDerivedOccName $ getOccName id) + -- See #1641. This is pretty yucky, but I can't see a better way + -- to identify compiler-generated Ids, and at least this should + -- catch them all. | opt_AutoSccsOnExportedToplevs -- Only on exported things = AddSccs mod (\id -> idName id `elemNameSet` exports) | otherwise = NoSccs - deSugarExpr :: HscEnv -> Module -> GlobalRdrEnv -> TypeEnv -> LHsExpr Id @@ -273,6 +275,6 @@ dsRule (L loc (HsRule name act vars lhs _tv_lhs rhs _fv_rhs)) ; return (Just rule) } } } where - msg = hang (ptext SLIT("RULE left-hand side too complicated to desugar; ignored")) + msg = hang (ptext (sLit "RULE left-hand side too complicated to desugar; ignored")) 2 (ppr lhs) \end{code}