foldr k z [x] = ...
We do not want to generate a build invocation on the LHS of this RULE!
+We fix this by disabling rules in rule LHSs, and testing that
+flag here; see Note [Desugaring RULE left hand sides] in Desugar
+
To test this I've added a (static) flag -fsimple-list-literals, which
makes all list literals be generated via the simple route.
; let (dynamic_prefix, static_suffix) = spanTail is_static xs'
; if opt_SimpleListLiterals -- -fsimple-list-literals
|| not (dopt Opt_EnableRewriteRules dflags) -- Rewrite rules off
+ -- Don't generate a build if there are no rules to eliminate it!
+ -- See Note [Desugaring RULE left hand sides] in Desugar
|| null dynamic_prefix -- Avoid build (\c n. foldr c n xs)!
then return $ mkListExpr elt_ty xs'
else mkBuildExpr elt_ty (mkSplitExplicitList dynamic_prefix static_suffix) }
body = noLoc $ HsDo DoExpr rec_stmts return_app body_ty
return_app = nlHsApp (noLoc return_op) (mkLHsTupleExpr rets)
body_ty = mkAppTy m_ty tup_ty
- tup_ty = mkCoreTupTy (map idType tup_ids)
- -- mkCoreTupTy deals with singleton case
+ tup_ty = mkBoxedTupleTy (map idType tup_ids) -- Deals with singleton case
-- In a do expression, pattern-match failure just calls
-- the monadic 'fail' rather than throwing an exception
mfix_pat = noLoc $ LazyPat $ mk_tup_pat rec_tup_pats
body = noLoc $ HsDo ctxt rec_stmts return_app body_ty
body_ty = mkAppTy m_ty tup_ty
- tup_ty = mkCoreTupTy (map idType (later_ids' ++ rec_ids))
- -- mkCoreTupTy deals with singleton case
+ tup_ty = mkBoxedTupleTy (map idType (later_ids' ++ rec_ids)) -- Deals with singleton case
return_app = nlHsApp (nlHsTyApp return_id [tup_ty])
(mkLHsTupleExpr rets)