Commit 4d5f83a8 authored by Austin Seipp's avatar Austin Seipp

compiler: de-lhs deSugar/

Signed-off-by: default avatarAustin Seipp <austin@well-typed.com>
parent b57ff272
% {-
% (c) The University of Glasgow 2006 (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1997-1998 (c) The GRASP/AQUA Project, Glasgow University, 1997-1998
%
% Author: Juan J. Quintela <quintela@krilin.dc.fi.udc.es> Author: Juan J. Quintela <quintela@krilin.dc.fi.udc.es>
-}
\begin{code}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
module Check ( check , ExhaustivePat ) where module Check ( check , ExhaustivePat ) where
...@@ -29,8 +29,8 @@ import Util ...@@ -29,8 +29,8 @@ import Util
import BasicTypes import BasicTypes
import Outputable import Outputable
import FastString import FastString
\end{code}
{-
This module performs checks about if one list of equations are: This module performs checks about if one list of equations are:
\begin{itemize} \begin{itemize}
\item Overlapped \item Overlapped
...@@ -95,8 +95,8 @@ Then we need to use InPats. ...@@ -95,8 +95,8 @@ Then we need to use InPats.
Juan Quintela 5 JUL 1998\\ Juan Quintela 5 JUL 1998\\
User-friendliness and compiler writers are no friends. User-friendliness and compiler writers are no friends.
\end{quotation} \end{quotation}
-}
\begin{code}
type WarningPat = InPat Name type WarningPat = InPat Name
type ExhaustivePat = ([WarningPat], [(Name, [HsLit])]) type ExhaustivePat = ([WarningPat], [(Name, [HsLit])])
type EqnNo = Int type EqnNo = Int
...@@ -122,11 +122,8 @@ untidy_exhaustive (pats, messages) = ...@@ -122,11 +122,8 @@ untidy_exhaustive (pats, messages) =
untidy_message :: (Name, [HsLit]) -> (Name, [HsLit]) untidy_message :: (Name, [HsLit]) -> (Name, [HsLit])
untidy_message (string, lits) = (string, map untidy_lit lits) untidy_message (string, lits) = (string, map untidy_lit lits)
\end{code}
The function @untidy@ does the reverse work of the @tidy_pat@ function.
\begin{code} -- The function @untidy@ does the reverse work of the @tidy_pat@ function.
type NeedPars = Bool type NeedPars = Bool
...@@ -144,9 +141,9 @@ untidy b (L loc p) = L loc (untidy' b p) ...@@ -144,9 +141,9 @@ untidy b (L loc p) = L loc (untidy' b p)
untidy' _ (LitPat lit) = LitPat (untidy_lit lit) untidy' _ (LitPat lit) = LitPat (untidy_lit lit)
untidy' _ p@(ConPatIn _ (PrefixCon [])) = p untidy' _ p@(ConPatIn _ (PrefixCon [])) = p
untidy' b (ConPatIn name ps) = pars b (L loc (ConPatIn name (untidy_con ps))) untidy' b (ConPatIn name ps) = pars b (L loc (ConPatIn name (untidy_con ps)))
untidy' _ (ListPat pats ty Nothing) = ListPat (map untidy_no_pars pats) ty Nothing untidy' _ (ListPat pats ty Nothing) = ListPat (map untidy_no_pars pats) ty Nothing
untidy' _ (TuplePat pats box tys) = TuplePat (map untidy_no_pars pats) box tys untidy' _ (TuplePat pats box tys) = TuplePat (map untidy_no_pars pats) box tys
untidy' _ (ListPat _ _ (Just _)) = panic "Check.untidy: Overloaded ListPat" untidy' _ (ListPat _ _ (Just _)) = panic "Check.untidy: Overloaded ListPat"
untidy' _ (PArrPat _ _) = panic "Check.untidy: Shouldn't get a parallel array here!" untidy' _ (PArrPat _ _) = panic "Check.untidy: Shouldn't get a parallel array here!"
untidy' _ (SigPatIn _ _) = panic "Check.untidy: SigPat" untidy' _ (SigPatIn _ _) = panic "Check.untidy: SigPat"
untidy' _ (LazyPat {}) = panic "Check.untidy: LazyPat" untidy' _ (LazyPat {}) = panic "Check.untidy: LazyPat"
...@@ -177,8 +174,8 @@ pars _ p = unLoc p ...@@ -177,8 +174,8 @@ pars _ p = unLoc p
untidy_lit :: HsLit -> HsLit untidy_lit :: HsLit -> HsLit
untidy_lit (HsCharPrim src c) = HsChar src c untidy_lit (HsCharPrim src c) = HsChar src c
untidy_lit lit = lit untidy_lit lit = lit
\end{code}
{-
This equation is the same that check, the only difference is that the This equation is the same that check, the only difference is that the
boring work is done, that work needs to be done only once, this is boring work is done, that work needs to be done only once, this is
the reason top have two functions, check is the external interface, the reason top have two functions, check is the external interface,
...@@ -203,9 +200,7 @@ There are several cases: ...@@ -203,9 +200,7 @@ There are several cases:
vars in the first column, we actuate in consequence. vars in the first column, we actuate in consequence.
\end{itemize} \end{itemize}
-}
\begin{code}
check' :: [(EqnNo, EquationInfo)] check' :: [(EqnNo, EquationInfo)]
-> ([ExhaustivePat], -- Pattern scheme that might not be matched at all -> ([ExhaustivePat], -- Pattern scheme that might not be matched at all
...@@ -213,7 +208,7 @@ check' :: [(EqnNo, EquationInfo)] ...@@ -213,7 +208,7 @@ check' :: [(EqnNo, EquationInfo)]
check' [] = ([],emptyUniqSet) check' [] = ([],emptyUniqSet)
-- Was ([([],[])], emptyUniqSet) -- Was ([([],[])], emptyUniqSet)
-- But that (a) seems weird, and (b) triggered Trac #7669 -- But that (a) seems weird, and (b) triggered Trac #7669
-- So now I'm just doing the simple obvious thing -- So now I'm just doing the simple obvious thing
check' ((n, EqnInfo { eqn_pats = ps, eqn_rhs = MatchResult can_fail _ }) : rs) check' ((n, EqnInfo { eqn_pats = ps, eqn_rhs = MatchResult can_fail _ }) : rs)
...@@ -242,36 +237,34 @@ check' qs ...@@ -242,36 +237,34 @@ check' qs
some_constructors = any is_con first_pats some_constructors = any is_con first_pats
some_literals = any is_lit first_pats some_literals = any is_lit first_pats
only_vars = all is_var first_pats only_vars = all is_var first_pats
\end{code}
{-
Here begins the code to deal with literals, we need to split the matrix Here begins the code to deal with literals, we need to split the matrix
in different matrix beginning by each literal and a last matrix with the in different matrix beginning by each literal and a last matrix with the
rest of values. rest of values.
-}
\begin{code}
split_by_literals :: [(EqnNo, EquationInfo)] -> ([ExhaustivePat], EqnSet) split_by_literals :: [(EqnNo, EquationInfo)] -> ([ExhaustivePat], EqnSet)
split_by_literals qs = process_literals used_lits qs split_by_literals qs = process_literals used_lits qs
where where
used_lits = get_used_lits qs used_lits = get_used_lits qs
\end{code}
{-
@process_explicit_literals@ is a function that process each literal that appears @process_explicit_literals@ is a function that process each literal that appears
in the column of the matrix. in the column of the matrix.
-}
\begin{code}
process_explicit_literals :: [HsLit] -> [(EqnNo, EquationInfo)] -> ([ExhaustivePat],EqnSet) process_explicit_literals :: [HsLit] -> [(EqnNo, EquationInfo)] -> ([ExhaustivePat],EqnSet)
process_explicit_literals lits qs = (concat pats, unionManyUniqSets indexs) process_explicit_literals lits qs = (concat pats, unionManyUniqSets indexs)
where where
pats_indexs = map (\x -> construct_literal_matrix x qs) lits pats_indexs = map (\x -> construct_literal_matrix x qs) lits
(pats,indexs) = unzip pats_indexs (pats,indexs) = unzip pats_indexs
\end{code}
{-
@process_literals@ calls @process_explicit_literals@ to deal with the literals @process_literals@ calls @process_explicit_literals@ to deal with the literals
that appears in the matrix and deal also with the rest of the cases. It that appears in the matrix and deal also with the rest of the cases. It
must be one Variable to be complete. must be one Variable to be complete.
-}
\begin{code}
process_literals :: [HsLit] -> [(EqnNo, EquationInfo)] -> ([ExhaustivePat],EqnSet) process_literals :: [HsLit] -> [(EqnNo, EquationInfo)] -> ([ExhaustivePat],EqnSet)
process_literals used_lits qs process_literals used_lits qs
...@@ -285,12 +278,12 @@ process_literals used_lits qs ...@@ -285,12 +278,12 @@ process_literals used_lits qs
pats_default = [(nlWildPatName:ps,constraints) | pats_default = [(nlWildPatName:ps,constraints) |
(ps,constraints) <- (pats')] ++ pats (ps,constraints) <- (pats')] ++ pats
indexs_default = unionUniqSets indexs' indexs indexs_default = unionUniqSets indexs' indexs
\end{code}
{-
Here we have selected the literal and we will select all the equations that Here we have selected the literal and we will select all the equations that
begins for that literal and create a new matrix. begins for that literal and create a new matrix.
-}
\begin{code}
construct_literal_matrix :: HsLit -> [(EqnNo, EquationInfo)] -> ([ExhaustivePat],EqnSet) construct_literal_matrix :: HsLit -> [(EqnNo, EquationInfo)] -> ([ExhaustivePat],EqnSet)
construct_literal_matrix lit qs = construct_literal_matrix lit qs =
(map (\ (xs,ys) -> (new_lit:xs,ys)) pats,indexs) (map (\ (xs,ys) -> (new_lit:xs,ys)) pats,indexs)
...@@ -307,12 +300,12 @@ remove_first_column_lit lit qs ...@@ -307,12 +300,12 @@ remove_first_column_lit lit qs
where where
shift_pat eqn@(EqnInfo { eqn_pats = _:ps}) = eqn { eqn_pats = ps } shift_pat eqn@(EqnInfo { eqn_pats = _:ps}) = eqn { eqn_pats = ps }
shift_pat _ = panic "Check.shift_var: no patterns" shift_pat _ = panic "Check.shift_var: no patterns"
\end{code}
{-
This function splits the equations @qs@ in groups that deal with the This function splits the equations @qs@ in groups that deal with the
same constructor. same constructor.
-}
\begin{code}
split_by_constructor :: [(EqnNo, EquationInfo)] -> ([ExhaustivePat], EqnSet) split_by_constructor :: [(EqnNo, EquationInfo)] -> ([ExhaustivePat], EqnSet)
split_by_constructor qs split_by_constructor qs
| null used_cons = ([], mkUniqSet $ map fst qs) | null used_cons = ([], mkUniqSet $ map fst qs)
...@@ -321,19 +314,19 @@ split_by_constructor qs ...@@ -321,19 +314,19 @@ split_by_constructor qs
where where
used_cons = get_used_cons qs used_cons = get_used_cons qs
unused_cons = get_unused_cons used_cons unused_cons = get_unused_cons used_cons
\end{code}
{-
The first column of the patterns matrix only have vars, then there is The first column of the patterns matrix only have vars, then there is
nothing to do. nothing to do.
-}
\begin{code}
first_column_only_vars :: [(EqnNo, EquationInfo)] -> ([ExhaustivePat],EqnSet) first_column_only_vars :: [(EqnNo, EquationInfo)] -> ([ExhaustivePat],EqnSet)
first_column_only_vars qs first_column_only_vars qs
= (map (\ (xs,ys) -> (nlWildPatName:xs,ys)) pats,indexs) = (map (\ (xs,ys) -> (nlWildPatName:xs,ys)) pats,indexs)
where where
(pats, indexs) = check' (map remove_var qs) (pats, indexs) = check' (map remove_var qs)
\end{code}
{-
This equation takes a matrix of patterns and split the equations by This equation takes a matrix of patterns and split the equations by
constructor, using all the constructors that appears in the first column constructor, using all the constructors that appears in the first column
of the pattern matching. of the pattern matching.
...@@ -341,8 +334,8 @@ of the pattern matching. ...@@ -341,8 +334,8 @@ of the pattern matching.
We can need a default clause or not ...., it depends if we used all the We can need a default clause or not ...., it depends if we used all the
constructors or not explicitly. The reasoning is similar to @process_literals@, constructors or not explicitly. The reasoning is similar to @process_literals@,
the difference is that here the default case is not always needed. the difference is that here the default case is not always needed.
-}
\begin{code}
no_need_default_case :: [Pat Id] -> [(EqnNo, EquationInfo)] -> ([ExhaustivePat],EqnSet) no_need_default_case :: [Pat Id] -> [(EqnNo, EquationInfo)] -> ([ExhaustivePat],EqnSet)
no_need_default_case cons qs = (concat pats, unionManyUniqSets indexs) no_need_default_case cons qs = (concat pats, unionManyUniqSets indexs)
where where
...@@ -369,8 +362,8 @@ construct_matrix con qs = ...@@ -369,8 +362,8 @@ construct_matrix con qs =
(map (make_con con) pats,indexs) (map (make_con con) pats,indexs)
where where
(pats,indexs) = (check' (remove_first_column con qs)) (pats,indexs) = (check' (remove_first_column con qs))
\end{code}
{-
Here remove first column is more difficult that with literals due to the fact Here remove first column is more difficult that with literals due to the fact
that constructors can have arguments. that constructors can have arguments.
...@@ -384,8 +377,8 @@ is transformed in: ...@@ -384,8 +377,8 @@ is transformed in:
x xs y x xs y
_ _ y _ _ y
\end{verbatim} \end{verbatim}
-}
\begin{code}
remove_first_column :: Pat Id -- Constructor remove_first_column :: Pat Id -- Constructor
-> [(EqnNo, EquationInfo)] -> [(EqnNo, EquationInfo)]
-> [(EqnNo, EquationInfo)] -> [(EqnNo, EquationInfo)]
...@@ -536,8 +529,8 @@ is_var_lit _ (WildPat _) = True ...@@ -536,8 +529,8 @@ is_var_lit _ (WildPat _) = True
is_var_lit lit pat is_var_lit lit pat
| Just lit' <- get_lit pat = lit == lit' | Just lit' <- get_lit pat = lit == lit'
| otherwise = False | otherwise = False
\end{code}
{-
The difference beteewn @make_con@ and @make_whole_con@ is that The difference beteewn @make_con@ and @make_whole_con@ is that
@make_wole_con@ creates a new constructor with all their arguments, and @make_wole_con@ creates a new constructor with all their arguments, and
@make_con@ takes a list of argumntes, creates the contructor getting their @make_con@ takes a list of argumntes, creates the contructor getting their
...@@ -570,12 +563,12 @@ In particular: ...@@ -570,12 +563,12 @@ In particular:
\\ @((:) x xs)@ & returns to be & @(x:xs)@ \\ @((:) x xs)@ & returns to be & @(x:xs)@
\\ @(x:(...:[])@ & returns to be & @[x,...]@ \\ @(x:(...:[])@ & returns to be & @[x,...]@
\end{tabular} \end{tabular}
%
The difficult case is the third one becouse we need to follow all the The difficult case is the third one becouse we need to follow all the
contructors until the @[]@ to know that we need to use the second case, contructors until the @[]@ to know that we need to use the second case,
not the second. \fbox{\ ???\ } not the second. \fbox{\ ???\ }
% -}
\begin{code}
isInfixCon :: DataCon -> Bool isInfixCon :: DataCon -> Bool
isInfixCon con = isDataSymOcc (getOccName con) isInfixCon con = isDataSymOcc (getOccName con)
...@@ -629,8 +622,8 @@ make_whole_con con | isInfixCon con = nlInfixConPat name ...@@ -629,8 +622,8 @@ make_whole_con con | isInfixCon con = nlInfixConPat name
where where
name = getName con name = getName con
pats = [nlWildPatName | _ <- dataConOrigArgTys con] pats = [nlWildPatName | _ <- dataConOrigArgTys con]
\end{code}
{-
------------------------------------------------------------------------ ------------------------------------------------------------------------
Tidying equations Tidying equations
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -640,8 +633,8 @@ that is, it removes syntactic sugar, reducing the number of cases that ...@@ -640,8 +633,8 @@ that is, it removes syntactic sugar, reducing the number of cases that
must be handled by the main checking algorithm. One difference is must be handled by the main checking algorithm. One difference is
that here we can do *all* the tidying at once (recursively), rather that here we can do *all* the tidying at once (recursively), rather
than doing it incrementally. than doing it incrementally.
-}
\begin{code}
tidy_eqn :: EquationInfo -> EquationInfo tidy_eqn :: EquationInfo -> EquationInfo
tidy_eqn eqn = eqn { eqn_pats = map tidy_pat (eqn_pats eqn), tidy_eqn eqn = eqn { eqn_pats = map tidy_pat (eqn_pats eqn),
eqn_rhs = tidy_rhs (eqn_rhs eqn) } eqn_rhs = tidy_rhs (eqn_rhs eqn) }
...@@ -778,4 +771,3 @@ tidy_con con (RecCon (HsRecFields fs _)) ...@@ -778,4 +771,3 @@ tidy_con con (RecCon (HsRecFields fs _))
insertNm nm p (x@(n,_):xs) insertNm nm p (x@(n,_):xs)
| nm == n = (nm,p):xs | nm == n = (nm,p):xs
| otherwise = x : insertNm nm p xs | otherwise = x : insertNm nm p xs
\end{code}
% {-
% (c) Galois, 2006 (c) Galois, 2006
% (c) University of Glasgow, 2007 (c) University of Glasgow, 2007
% -}
\begin{code}
{-# LANGUAGE NondecreasingIndentation #-} {-# LANGUAGE NondecreasingIndentation #-}
module Coverage (addTicksToBinds, hpcInitCode) where module Coverage (addTicksToBinds, hpcInitCode) where
...@@ -43,16 +43,15 @@ import Trace.Hpc.Util ...@@ -43,16 +43,15 @@ import Trace.Hpc.Util
import BreakArray import BreakArray
import Data.Map (Map) import Data.Map (Map)
import qualified Data.Map as Map import qualified Data.Map as Map
\end{code}
{-
************************************************************************
* *
* The main function: addTicksToBinds
* *
************************************************************************
-}
%************************************************************************
%* *
%* The main function: addTicksToBinds
%* *
%************************************************************************
\begin{code}
addTicksToBinds addTicksToBinds
:: DynFlags :: DynFlags
-> Module -> Module
...@@ -526,7 +525,7 @@ addTickHsExpr (ExplicitList ty wit es) = ...@@ -526,7 +525,7 @@ addTickHsExpr (ExplicitList ty wit es) =
liftM3 ExplicitList liftM3 ExplicitList
(return ty) (return ty)
(addTickWit wit) (addTickWit wit)
(mapM (addTickLHsExpr) es) (mapM (addTickLHsExpr) es)
where addTickWit Nothing = return Nothing where addTickWit Nothing = return Nothing
addTickWit (Just fln) = do fln' <- addTickHsExpr fln addTickWit (Just fln) = do fln' <- addTickHsExpr fln
return (Just fln') return (Just fln')
...@@ -808,7 +807,7 @@ addTickHsCmd (HsCmdArrForm e fix cmdtop) = ...@@ -808,7 +807,7 @@ addTickHsCmd (HsCmdArrForm e fix cmdtop) =
(return fix) (return fix)
(mapM (liftL (addTickHsCmdTop)) cmdtop) (mapM (liftL (addTickHsCmdTop)) cmdtop)
addTickHsCmd (HsCmdCast co cmd) addTickHsCmd (HsCmdCast co cmd)
= liftM2 HsCmdCast (return co) (addTickHsCmd cmd) = liftM2 HsCmdCast (return co) (addTickHsCmd cmd)
-- Others should never happen in a command context. -- Others should never happen in a command context.
...@@ -918,9 +917,7 @@ liftL :: (Monad m) => (a -> m a) -> Located a -> m (Located a) ...@@ -918,9 +917,7 @@ liftL :: (Monad m) => (a -> m a) -> Located a -> m (Located a)
liftL f (L loc a) = do liftL f (L loc a) = do
a' <- f a a' <- f a
return $ L loc a' return $ L loc a'
\end{code}
\begin{code}
data TickTransState = TT { tickBoxCount:: Int data TickTransState = TT { tickBoxCount:: Int
, mixEntries :: [MixEntry_] , mixEntries :: [MixEntry_]
} }
...@@ -1164,18 +1161,12 @@ mkHpcPos _ = panic "bad source span; expected such spans to be filtered out" ...@@ -1164,18 +1161,12 @@ mkHpcPos _ = panic "bad source span; expected such spans to be filtered out"
hpcSrcSpan :: SrcSpan hpcSrcSpan :: SrcSpan
hpcSrcSpan = mkGeneralSrcSpan (fsLit "Haskell Program Coverage internals") hpcSrcSpan = mkGeneralSrcSpan (fsLit "Haskell Program Coverage internals")
\end{code}
\begin{code}
matchesOneOfMany :: [LMatch Id body] -> Bool matchesOneOfMany :: [LMatch Id body] -> Bool
matchesOneOfMany lmatches = sum (map matchCount lmatches) > 1 matchesOneOfMany lmatches = sum (map matchCount lmatches) > 1
where where
matchCount (L _ (Match _pats _ty (GRHSs grhss _binds))) = length grhss matchCount (L _ (Match _pats _ty (GRHSs grhss _binds))) = length grhss
\end{code}
\begin{code}
type MixEntry_ = (SrcSpan, [String], [OccName], BoxLabel) type MixEntry_ = (SrcSpan, [String], [OccName], BoxLabel)
-- For the hash value, we hash everything: the file name, -- For the hash value, we hash everything: the file name,
...@@ -1187,13 +1178,13 @@ type MixEntry_ = (SrcSpan, [String], [OccName], BoxLabel) ...@@ -1187,13 +1178,13 @@ type MixEntry_ = (SrcSpan, [String], [OccName], BoxLabel)
mixHash :: FilePath -> UTCTime -> Int -> [MixEntry] -> Int mixHash :: FilePath -> UTCTime -> Int -> [MixEntry] -> Int
mixHash file tm tabstop entries = fromIntegral $ hashString mixHash file tm tabstop entries = fromIntegral $ hashString
(show $ Mix file tm 0 tabstop entries) (show $ Mix file tm 0 tabstop entries)
\end{code}
%************************************************************************ {-
%* * ************************************************************************
%* initialisation * *
%* * * initialisation
%************************************************************************ * *
************************************************************************
Each module compiled with -fhpc declares an initialisation function of Each module compiled with -fhpc declares an initialisation function of
the form `hpc_init_<module>()`, which is emitted into the _stub.c file the form `hpc_init_<module>()`, which is emitted into the _stub.c file
...@@ -1207,8 +1198,8 @@ static void hpc_init_Main(void) __attribute__((constructor)); ...@@ -1207,8 +1198,8 @@ static void hpc_init_Main(void) __attribute__((constructor));
static void hpc_init_Main(void) static void hpc_init_Main(void)
{extern StgWord64 _hpc_tickboxes_Main_hpc[]; {extern StgWord64 _hpc_tickboxes_Main_hpc[];
hs_hpc_module("Main",8,1150288664,_hpc_tickboxes_Main_hpc);} hs_hpc_module("Main",8,1150288664,_hpc_tickboxes_Main_hpc);}
-}
\begin{code}
hpcInitCode :: Module -> HpcInfo -> SDoc hpcInitCode :: Module -> HpcInfo -> SDoc
hpcInitCode _ (NoHpcInfo {}) = Outputable.empty hpcInitCode _ (NoHpcInfo {}) = Outputable.empty
hpcInitCode this_mod (HpcInfo tickCount hashNo) hpcInitCode this_mod (HpcInfo tickCount hashNo)
...@@ -1240,4 +1231,3 @@ hpcInitCode this_mod (HpcInfo tickCount hashNo) ...@@ -1240,4 +1231,3 @@ hpcInitCode this_mod (HpcInfo tickCount hashNo)
= module_name = module_name
| otherwise | otherwise
= package_name <> char '/' <> module_name = package_name <> char '/' <> module_name
\end{code}
% {-
% (c) The University of Glasgow 2006 (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
The Desugarer: turning HsSyn into Core. The Desugarer: turning HsSyn into Core.
-}
\begin{code}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
module Desugar ( deSugar, deSugarExpr ) where module Desugar ( deSugar, deSugarExpr ) where
...@@ -52,15 +52,15 @@ import OrdList ...@@ -52,15 +52,15 @@ import OrdList
import Data.List import Data.List
import Data.IORef import Data.IORef
import Control.Monad( when ) import Control.Monad( when )
\end{code}
%************************************************************************ {-
%* * ************************************************************************
%* The main function: deSugar * *
%* * * The main function: deSugar
%************************************************************************ * *
************************************************************************
-}
\begin{code}
-- | Main entry point to the desugarer. -- | Main entry point to the desugarer.
deSugar :: HscEnv -> ModLocation -> TcGblEnv -> IO (Messages, Maybe ModGuts) deSugar :: HscEnv -> ModLocation -> TcGblEnv -> IO (Messages, Maybe ModGuts)
-- Can modify PCS by faulting in more declarations -- Can modify PCS by faulting in more declarations
...@@ -212,8 +212,8 @@ combineEvBinds (NonRec b r : bs) val_prs ...@@ -212,8 +212,8 @@ combineEvBinds (NonRec b r : bs) val_prs
| otherwise = NonRec b r : combineEvBinds bs val_prs | otherwise = NonRec b r : combineEvBinds bs val_prs
combineEvBinds (Rec prs : bs) val_prs combineEvBinds (Rec prs : bs) val_prs
= combineEvBinds bs (prs ++ val_prs) = combineEvBinds bs (prs ++ val_prs)
\end{code}
{-
Note [Top-level evidence] Note [Top-level evidence]
~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~
Top-level evidence bindings may be mutually recursive with the top-level value Top-level evidence bindings may be mutually recursive with the top-level value
...@@ -223,9 +223,8 @@ when computing dependencies. ...@@ -223,9 +223,8 @@ when computing dependencies.
So we pull out the type/coercion variables (which are in dependency