#include "HsVersions.h"
-
import Match
import MatchLit
import DsBinds
import Type
import CoreSyn
import CoreUtils
+import MkCore
+import DynFlags
import CostCentre
import Id
import PrelInfo
= uncurry mkLams <$> matchWrapper LambdaExpr a_Match
dsExpr (HsApp fun arg)
- = mkDsApp <$> dsLExpr fun <*> dsLExpr arg
+ = mkCoreApp <$> dsLExpr fun <*> dsLExpr arg
\end{code}
Operator sections. At first it looks as if we can convert
\begin{code}
dsExpr (OpApp e1 op _ e2)
= -- for the type of y, we need the type of op's 2nd argument
- mkDsApps <$> dsLExpr op <*> mapM dsLExpr [e1, e2]
+ mkCoreApps <$> dsLExpr op <*> mapM dsLExpr [e1, e2]
dsExpr (SectionL expr op) -- Desugar (e !) to ((!) e)
- = mkDsApp <$> dsLExpr op <*> dsLExpr expr
+ = mkCoreApp <$> dsLExpr op <*> dsLExpr expr
-- dsLExpr (SectionR op expr) -- \ x -> op x expr
dsExpr (SectionR op expr) = do
x_id <- newSysLocalDs x_ty
y_id <- newSysLocalDs y_ty
return (bindNonRec y_id y_core $
- Lam x_id (mkDsApps core_op [Var x_id, Var y_id]))
+ Lam x_id (mkCoreApps core_op [Var x_id, Var y_id]))
dsExpr (HsSCC cc expr) = do
mod_name <- getModuleDs
dsExpr (HsCoreAnn fs expr)
= Note (CoreNote $ unpackFS fs) <$> dsLExpr expr
-dsExpr (HsCase discrim matches) = do
- core_discrim <- dsLExpr discrim
- ([discrim_var], matching_code) <- matchWrapper CaseAlt matches
- return (scrungleMatch discrim_var core_discrim matching_code)
+dsExpr (HsCase discrim matches@(MatchGroup _ rhs_ty))
+ | isEmptyMatchGroup matches -- A Core 'case' is always non-empty
+ = -- So desugar empty HsCase to error call
+ mkErrorAppDs pAT_ERROR_ID (funResultTy rhs_ty) "case"
+
+ | otherwise
+ = do { core_discrim <- dsLExpr discrim
+ ; ([discrim_var], matching_code) <- matchWrapper CaseAlt matches
+ ; return (scrungleMatch discrim_var core_discrim matching_code) }
-- Pepe: The binds are in scope in the body but NOT in the binding group
-- This is to avoid silliness in breakpoints
\underline{\bf Various data construction things}
% ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
\begin{code}
-dsExpr (ExplicitList ty xs)
- = go xs
- where
- go [] = return (mkNilExpr ty)
- go (x:xs) = mkConsExpr ty <$> dsLExpr x <*> go xs
+dsExpr (ExplicitList elt_ty xs)
+ = dsExplicitList elt_ty xs
--- we create a list from the array elements and convert them into a list using
--- `PrelPArr.toP'
---
--- * the main disadvantage to this scheme is that `toP' traverses the list
--- twice: once to determine the length and a second time to put to elements
--- into the array; this inefficiency could be avoided by exposing some of
--- the innards of `PrelPArr' to the compiler (ie, have a `PrelPArrBase') so
--- that we can exploit the fact that we already know the length of the array
--- here at compile time
+-- We desugar [:x1, ..., xn:] as
+-- singletonP x1 +:+ ... +:+ singletonP xn
--
+dsExpr (ExplicitPArr ty []) = do
+ emptyP <- dsLookupGlobalId emptyPName
+ return (Var emptyP `App` Type ty)
dsExpr (ExplicitPArr ty xs) = do
- toP <- dsLookupGlobalId toPName
- coreList <- dsExpr (ExplicitList ty xs)
- return (mkApps (Var toP) [Type ty, coreList])
+ singletonP <- dsLookupGlobalId singletonPName
+ appP <- dsLookupGlobalId appPName
+ xs' <- mapM dsLExpr xs
+ return . foldr1 (binary appP) $ map (unary singletonP) xs'
+ where
+ unary fn x = mkApps (Var fn) [Type ty, x]
+ binary fn x y = mkApps (Var fn) [Type ty, x, y]
dsExpr (ExplicitTuple expr_list boxity) = do
core_exprs <- mapM dsLExpr expr_list
\begin{code}
-#ifdef DEBUG
-- HsSyn constructs that just shouldn't be here:
dsExpr (ExprWithTySig _ _) = panic "dsExpr:ExprWithTySig"
-#endif
findField :: [HsRecField Id arg] -> Name -> [arg]
%--------------------------------------------------------------------
+Note [Desugaring explicit lists]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Explicit lists are desugared in a cleverer way to prevent some
+fruitless allocations. Essentially, whenever we see a list literal
+[x_1, ..., x_n] we:
+
+1. Find the tail of the list that can be allocated statically (say
+ [x_k, ..., x_n]) by later stages and ensure we desugar that
+ normally: this makes sure that we don't cause a code size increase
+ by having the cons in that expression fused (see later) and hence
+ being unable to statically allocate any more
+
+2. For the prefix of the list which cannot be allocated statically,
+ say [x_1, ..., x_(k-1)], we turn it into an expression involving
+ build so that if we find any foldrs over it it will fuse away
+ entirely!
+
+ So in this example we will desugar to:
+ build (\c n -> x_1 `c` x_2 `c` .... `c` foldr c n [x_k, ..., x_n]
+
+ If fusion fails to occur then build will get inlined and (since we
+ defined a RULE for foldr (:) []) we will get back exactly the
+ normal desugaring for an explicit list.
+
+This optimisation can be worth a lot: up to 25% of the total
+allocation in some nofib programs. Specifically
+
+ Program Size Allocs Runtime CompTime
+ rewrite +0.0% -26.3% 0.02 -1.8%
+ ansi -0.3% -13.8% 0.00 +0.0%
+ lift +0.0% -8.7% 0.00 -2.3%
+
+Of course, if rules aren't turned on then there is pretty much no
+point doing this fancy stuff, and it may even be harmful.
+\begin{code}
+
+dsExplicitList :: PostTcType -> [LHsExpr Id] -> DsM CoreExpr
+-- See Note [Desugaring explicit lists]
+dsExplicitList elt_ty xs = do
+ dflags <- getDOptsDs
+ xs' <- mapM dsLExpr xs
+ if not (dopt Opt_EnableRewriteRules dflags)
+ then return $ mkListExpr elt_ty xs'
+ else mkBuildExpr elt_ty (mkSplitExplicitList (thisPackage dflags) xs')
+ where
+ mkSplitExplicitList this_package xs' (c, _) (n, n_ty) = do
+ let (dynamic_prefix, static_suffix) = spanTail (rhsIsStatic this_package) xs'
+ static_suffix' = mkListExpr elt_ty static_suffix
+
+ folded_static_suffix <- mkFoldrExpr elt_ty n_ty (Var c) (Var n) static_suffix'
+ let build_body = foldr (App . App (Var c)) folded_static_suffix dynamic_prefix
+ return build_body
+
+spanTail :: (a -> Bool) -> [a] -> ([a], [a])
+spanTail f xs = (reverse rejected, reverse satisfying)
+ where (satisfying, rejected) = span f $ reverse xs
+\end{code}
+
Desugar 'do' and 'mdo' expressions (NOT list comprehensions, they're
handled in DsListComp). Basically does the translation given in the
Haskell 98 report: