compiler/coreSyn/MkCore.lhs

   1 \begin{code}
   2 -- | Handy functions for creating much Core syntax
   3 module MkCore (
   4         -- * Constructing normal syntax
   5         mkCoreLet, mkCoreLets,
   6         mkCoreApp, mkCoreApps, mkCoreConApps,
   7         mkCoreLams,
   8
   9         -- * Constructing boxed literals
  10         mkWordExpr,
  11         mkIntExpr, mkIntegerExpr,
  12         mkFloatExpr, mkDoubleExpr,
  13         mkCharExpr, mkStringExpr, mkStringExprFS,
  14
  15         -- * Constructing general big tuples
  16         -- $big_tuples
  17         mkChunkified,
  18
  19         -- * Constructing small tuples
  20         mkCoreVarTup, mkCoreVarTupTy,
  21         mkCoreTup, mkCoreTupTy,
  22
  23         -- * Constructing big tuples
  24         mkBigCoreVarTup, mkBigCoreVarTupTy,
  25         mkBigCoreTup, mkBigCoreTupTy,
  26
  27         -- * Deconstructing small tuples
  28         mkSmallTupleSelector, mkSmallTupleCase,
  29
  30         -- * Deconstructing big tuples
  31         mkTupleSelector, mkTupleCase,
  32
  33         -- * Constructing list expressions
  34         mkNilExpr, mkConsExpr, mkListExpr,
  35         mkFoldrExpr, mkBuildExpr
  36     ) where
  37
  38 #include "HsVersions.h"
  39
  40 import Id
  41 import Var      ( setTyVarUnique )
  42
  43 import CoreSyn
  44 import CoreUtils        ( exprType, needsCaseBinding, bindNonRec )
  45 import Literal
  46 import HscTypes
  47
  48 import TysWiredIn
  49 import PrelNames
  50 import MkId             ( seqId )
  51
  52 import Type
  53 import TypeRep
  54 import TysPrim          ( alphaTyVar )
  55 import DataCon          ( DataCon, dataConWorkId )
  56
  57 import FastString
  58 import UniqSupply
  59 import BasicTypes
  60 import Util             ( notNull, zipEqual )
  61 import Panic
  62 import Constants
  63
  64 import Data.Char        ( ord )
  65 import Data.Word
  66
  67 infixl 4 `mkCoreApp`, `mkCoreApps`
  68 \end{code}
  69
  70 %************************************************************************
  71 %*                                                                      *
  72 \subsection{Basic CoreSyn construction}
  73 %*                                                                      *
  74 %************************************************************************
  75
  76 \begin{code}
  77 -- | Bind a binding group over an expression, using a @let@ or @case@ as
  78 -- appropriate (see "CoreSyn#let_app_invariant")
  79 mkCoreLet :: CoreBind -> CoreExpr -> CoreExpr
  80 mkCoreLet (NonRec bndr rhs) body        -- See Note [CoreSyn let/app invariant]
  81   | needsCaseBinding (idType bndr) rhs
  82   = Case rhs bndr (exprType body) [(DEFAULT,[],body)]
  83 mkCoreLet bind body
  84   = Let bind body
  85
  86 -- | Bind a list of binding groups over an expression. The leftmost binding
  87 -- group becomes the outermost group in the resulting expression
  88 mkCoreLets :: [CoreBind] -> CoreExpr -> CoreExpr
  89 mkCoreLets binds body = foldr mkCoreLet body binds
  90
  91 -- | Construct an expression which represents the application of one expression
  92 -- to the other
  93 mkCoreApp :: CoreExpr -> CoreExpr -> CoreExpr
  94 -- Check the invariant that the arg of an App is ok-for-speculation if unlifted
  95 -- See CoreSyn Note [CoreSyn let/app invariant]
  96 mkCoreApp fun (Type ty) = App fun (Type ty)
  97 mkCoreApp fun arg       = mk_val_app fun arg arg_ty res_ty
  98                       where
  99                         (arg_ty, res_ty) = splitFunTy (exprType fun)
 100
 101 -- | Construct an expression which represents the application of a number of
 102 -- expressions to another. The leftmost expression in the list is applied first
 103 mkCoreApps :: CoreExpr -> [CoreExpr] -> CoreExpr
 104 -- Slightly more efficient version of (foldl mkCoreApp)
 105 mkCoreApps fun args
 106   = go fun (exprType fun) args
 107   where
 108     go fun _      []               = fun
 109     go fun fun_ty (Type ty : args) = go (App fun (Type ty)) (applyTy fun_ty ty) args
 110     go fun fun_ty (arg     : args) = go (mk_val_app fun arg arg_ty res_ty) res_ty args
 111                                    where
 112                                      (arg_ty, res_ty) = splitFunTy fun_ty
 113
 114 -- | Construct an expression which represents the application of a number of
 115 -- expressions to that of a data constructor expression. The leftmost expression
 116 -- in the list is applied first
 117 mkCoreConApps :: DataCon -> [CoreExpr] -> CoreExpr
 118 mkCoreConApps con args = mkCoreApps (Var (dataConWorkId con)) args
 119
 120 -----------
 121 mk_val_app :: CoreExpr -> CoreExpr -> Type -> Type -> CoreExpr
 122 mk_val_app (Var f `App` Type ty1 `App` Type _ `App` arg1) arg2 _ res_ty
 123   | f == seqId                -- Note [Desugaring seq (1), (2)]
 124   = Case arg1 case_bndr res_ty [(DEFAULT,[],arg2)]
 125   where
 126     case_bndr = case arg1 of
 127                    Var v1 | isLocalId v1 -> v1        -- Note [Desugaring seq (2) and (3)]
 128                    _                            -> mkWildId ty1
 129
 130 mk_val_app fun arg arg_ty _        -- See Note [CoreSyn let/app invariant]
 131   | not (needsCaseBinding arg_ty arg)
 132   = App fun arg                -- The vastly common case
 133
 134 mk_val_app fun arg arg_ty res_ty
 135   = Case arg (mkWildId arg_ty) res_ty [(DEFAULT,[],App fun (Var arg_id))]
 136   where
 137     arg_id = mkWildId arg_ty        -- Lots of shadowing, but it doesn't matter,
 138                                 -- because 'fun ' should not have a free wild-id
 139 \end{code}
 140
 141 Note [Desugaring seq (1)]  cf Trac #1031
 142 ~~~~~~~~~~~~~~~~~~~~~~~~~
 143    f x y = x `seq` (y `seq` (# x,y #))
 144
 145 The [CoreSyn let/app invariant] means that, other things being equal, because
 146 the argument to the outer 'seq' has an unlifted type, we'll use call-by-value thus:
 147
 148    f x y = case (y `seq` (# x,y #)) of v -> x `seq` v
 149
 150 But that is bad for two reasons:
 151   (a) we now evaluate y before x, and
 152   (b) we can't bind v to an unboxed pair
 153
 154 Seq is very, very special!  So we recognise it right here, and desugar to
 155         case x of _ -> case y of _ -> (# x,y #)
 156
 157 Note [Desugaring seq (2)]  cf Trac #2231
 158 ~~~~~~~~~~~~~~~~~~~~~~~~~
 159 Consider
 160    let chp = case b of { True -> fst x; False -> 0 }
 161    in chp `seq` ...chp...
 162 Here the seq is designed to plug the space leak of retaining (snd x)
 163 for too long.
 164
 165 If we rely on the ordinary inlining of seq, we'll get
 166    let chp = case b of { True -> fst x; False -> 0 }
 167    case chp of _ { I# -> ...chp... }
 168
 169 But since chp is cheap, and the case is an alluring contet, we'll
 170 inline chp into the case scrutinee.  Now there is only one use of chp,
 171 so we'll inline a second copy.  Alas, we've now ruined the purpose of
 172 the seq, by re-introducing the space leak:
 173     case (case b of {True -> fst x; False -> 0}) of
 174       I# _ -> ...case b of {True -> fst x; False -> 0}...
 175
 176 We can try to avoid doing this by ensuring that the binder-swap in the
 177 case happens, so we get his at an early stage:
 178    case chp of chp2 { I# -> ...chp2... }
 179 But this is fragile.  The real culprit is the source program.  Perhaps we
 180 should have said explicitly
 181    let !chp2 = chp in ...chp2...
 182
 183 But that's painful.  So the code here does a little hack to make seq
 184 more robust: a saturated application of 'seq' is turned *directly* into
 185 the case expression. So we desugar to:
 186    let chp = case b of { True -> fst x; False -> 0 }
 187    case chp of chp { I# -> ...chp... }
 188 Notice the shadowing of the case binder! And now all is well.
 189
 190 The reason it's a hack is because if you define mySeq=seq, the hack
 191 won't work on mySeq.
 192
 193 Note [Desugaring seq (3)] cf Trac #2409
 194 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 195 The isLocalId ensures that we don't turn
 196         True `seq` e
 197 into
 198         case True of True { ... }
 199 which stupidly tries to bind the datacon 'True'.
 200 \begin{code}
 201 -- The functions from this point don't really do anything cleverer than
 202 -- their counterparts in CoreSyn, but they are here for consistency
 203
 204 -- | Create a lambda where the given expression has a number of variables
 205 -- bound over it. The leftmost binder is that bound by the outermost
 206 -- lambda in the result
 207 mkCoreLams :: [CoreBndr] -> CoreExpr -> CoreExpr
 208 mkCoreLams = mkLams
 209 \end{code}
 210
 211 %************************************************************************
 212 %*                                                                      *
 213 \subsection{Making literals}
 214 %*                                                                      *
 215 %************************************************************************
 216
 217 \begin{code}
 218 -- | Create a 'CoreExpr' which will evaluate to the given @Int@
 219 mkIntExpr      :: Int        -> CoreExpr            -- Result = I# i :: Int
 220 mkIntExpr  i = mkConApp intDataCon  [mkIntLitInt i]
 221
 222 -- | Create a 'CoreExpr' which will evaluate to the given @Word@
 223 mkWordExpr     :: Word       -> CoreExpr
 224 mkWordExpr w = mkConApp wordDataCon [mkWordLitWord w]
 225
 226 -- | Create a 'CoreExpr' which will evaluate to the given @Integer@
 227 mkIntegerExpr  :: MonadThings m => Integer    -> m CoreExpr  -- Result :: Integer
 228 mkIntegerExpr i
 229   | inIntRange i        -- Small enough, so start from an Int
 230     = do integer_id <- lookupId smallIntegerName
 231          return (mkSmallIntegerLit integer_id i)
 232
 233 -- Special case for integral literals with a large magnitude:
 234 -- They are transformed into an expression involving only smaller
 235 -- integral literals. This improves constant folding.
 236
 237   | otherwise = do       -- Big, so start from a string
 238       plus_id <- lookupId plusIntegerName
 239       times_id <- lookupId timesIntegerName
 240       integer_id <- lookupId smallIntegerName
 241       let
 242            lit i = mkSmallIntegerLit integer_id i
 243            plus a b  = Var plus_id  `App` a `App` b
 244            times a b = Var times_id `App` a `App` b
 245
 246            -- Transform i into (x1 + (x2 + (x3 + (...) * b) * b) * b) with abs xi <= b
 247            horner :: Integer -> Integer -> CoreExpr
 248            horner b i | abs q <= 1 = if r == 0 || r == i
 249                                      then lit i
 250                                      else lit r `plus` lit (i-r)
 251                       | r == 0     =               horner b q `times` lit b
 252                       | otherwise  = lit r `plus` (horner b q `times` lit b)
 253                       where
 254                         (q,r) = i `quotRem` b
 255
 256       return (horner tARGET_MAX_INT i)
 257   where
 258     mkSmallIntegerLit :: Id -> Integer -> CoreExpr
 259     mkSmallIntegerLit small_integer i = mkApps (Var small_integer) [mkIntLit i]
 260
 261
 262 -- | Create a 'CoreExpr' which will evaluate to the given @Float@
 263 mkFloatExpr :: Float -> CoreExpr
 264 mkFloatExpr f = mkConApp floatDataCon [mkFloatLitFloat f]
 265
 266 -- | Create a 'CoreExpr' which will evaluate to the given @Double@
 267 mkDoubleExpr :: Double -> CoreExpr
 268 mkDoubleExpr d = mkConApp doubleDataCon [mkDoubleLitDouble d]
 269
 270
 271 -- | Create a 'CoreExpr' which will evaluate to the given @Char@
 272 mkCharExpr     :: Char             -> CoreExpr      -- Result = C# c :: Int
 273 mkCharExpr c = mkConApp charDataCon [mkCharLit c]
 274
 275 -- | Create a 'CoreExpr' which will evaluate to the given @String@
 276 mkStringExpr   :: MonadThings m => String     -> m CoreExpr  -- Result :: String
 277 -- | Create a 'CoreExpr' which will evaluate to a string morally equivalent to the given @FastString@
 278 mkStringExprFS :: MonadThings m => FastString -> m CoreExpr  -- Result :: String
 279
 280 mkStringExpr str = mkStringExprFS (mkFastString str)
 281
 282 mkStringExprFS str
 283   | nullFS str
 284   = return (mkNilExpr charTy)
 285
 286   | lengthFS str == 1
 287   = do let the_char = mkCharExpr (headFS str)
 288        return (mkConsExpr charTy the_char (mkNilExpr charTy))
 289
 290   | all safeChar chars
 291   = do unpack_id <- lookupId unpackCStringName
 292        return (App (Var unpack_id) (Lit (MachStr str)))
 293
 294   | otherwise
 295   = do unpack_id <- lookupId unpackCStringUtf8Name
 296        return (App (Var unpack_id) (Lit (MachStr str)))
 297
 298   where
 299     chars = unpackFS str
 300     safeChar c = ord c >= 1 && ord c <= 0x7F
 301 \end{code}
 302
 303 %************************************************************************
 304 %*                                                                      *
 305 \subsection{Tuple constructors}
 306 %*                                                                      *
 307 %************************************************************************
 308
 309 \begin{code}
 310
 311 -- $big_tuples
 312 -- #big_tuples#
 313 --
 314 -- GHCs built in tuples can only go up to 'mAX_TUPLE_SIZE' in arity, but
 315 -- we might concievably want to build such a massive tuple as part of the
 316 -- output of a desugaring stage (notably that for list comprehensions).
 317 --
 318 -- We call tuples above this size \"big tuples\", and emulate them by
 319 -- creating and pattern matching on >nested< tuples that are expressible
 320 -- by GHC.
 321 --
 322 -- Nesting policy: it's better to have a 2-tuple of 10-tuples (3 objects)
 323 -- than a 10-tuple of 2-tuples (11 objects), so we want the leaves of any
 324 -- construction to be big.
 325 --
 326 -- If you just use the 'mkBigCoreTup', 'mkBigCoreVarTupTy', 'mkTupleSelector'
 327 -- and 'mkTupleCase' functions to do all your work with tuples you should be
 328 -- fine, and not have to worry about the arity limitation at all.
 329
 330 -- | Lifts a \"small\" constructor into a \"big\" constructor by recursive decompositon
 331 mkChunkified :: ([a] -> a)      -- ^ \"Small\" constructor function, of maximum input arity 'mAX_TUPLE_SIZE'
 332              -> [a]             -- ^ Possible \"big\" list of things to construct from
 333              -> a               -- ^ Constructed thing made possible by recursive decomposition
 334 mkChunkified small_tuple as = mk_big_tuple (chunkify as)
 335   where
 336         -- Each sub-list is short enough to fit in a tuple
 337     mk_big_tuple [as] = small_tuple as
 338     mk_big_tuple as_s = mk_big_tuple (chunkify (map small_tuple as_s))
 339
 340 chunkify :: [a] -> [[a]]
 341 -- ^ Split a list into lists that are small enough to have a corresponding
 342 -- tuple arity. The sub-lists of the result all have length <= 'mAX_TUPLE_SIZE'
 343 -- But there may be more than 'mAX_TUPLE_SIZE' sub-lists
 344 chunkify xs
 345   | n_xs <= mAX_TUPLE_SIZE = [xs]
 346   | otherwise              = split xs
 347   where
 348     n_xs     = length xs
 349     split [] = []
 350     split xs = take mAX_TUPLE_SIZE xs : split (drop mAX_TUPLE_SIZE xs)
 351
 352 \end{code}
 353
 354 Creating tuples and their types for Core expressions
 355
 356 @mkBigCoreVarTup@ builds a tuple; the inverse to @mkTupleSelector@.
 357
 358 * If it has only one element, it is the identity function.
 359
 360 * If there are more elements than a big tuple can have, it nests
 361   the tuples.
 362
 363 \begin{code}
 364
 365 -- | Build a small tuple holding the specified variables
 366 mkCoreVarTup :: [Id] -> CoreExpr
 367 mkCoreVarTup ids = mkCoreTup (map Var ids)
 368
 369 -- | Bulid the type of a small tuple that holds the specified variables
 370 mkCoreVarTupTy :: [Id] -> Type
 371 mkCoreVarTupTy ids = mkCoreTupTy (map idType ids)
 372
 373 -- | Build a small tuple holding the specified expressions
 374 mkCoreTup :: [CoreExpr] -> CoreExpr
 375 mkCoreTup []  = Var unitDataConId
 376 mkCoreTup [c] = c
 377 mkCoreTup cs  = mkConApp (tupleCon Boxed (length cs))
 378                          (map (Type . exprType) cs ++ cs)
 379
 380 -- | Build the type of a small tuple that holds the specified type of thing
 381 mkCoreTupTy :: [Type] -> Type
 382 mkCoreTupTy [ty] = ty
 383 mkCoreTupTy tys  = mkTupleTy Boxed (length tys) tys
 384
 385
 386 -- | Build a big tuple holding the specified variables
 387 mkBigCoreVarTup :: [Id] -> CoreExpr
 388 mkBigCoreVarTup ids = mkBigCoreTup (map Var ids)
 389
 390 -- | Build the type of a big tuple that holds the specified variables
 391 mkBigCoreVarTupTy :: [Id] -> Type
 392 mkBigCoreVarTupTy ids = mkBigCoreTupTy (map idType ids)
 393
 394 -- | Build a big tuple holding the specified expressions
 395 mkBigCoreTup :: [CoreExpr] -> CoreExpr
 396 mkBigCoreTup = mkChunkified mkCoreTup
 397
 398 -- | Build the type of a big tuple that holds the specified type of thing
 399 mkBigCoreTupTy :: [Type] -> Type
 400 mkBigCoreTupTy = mkChunkified mkCoreTupTy
 401 \end{code}
 402
 403 %************************************************************************
 404 %*                                                                      *
 405 \subsection{Tuple destructors}
 406 %*                                                                      *
 407 %************************************************************************
 408
 409 \begin{code}
 410 -- | Builds a selector which scrutises the given
 411 -- expression and extracts the one name from the list given.
 412 -- If you want the no-shadowing rule to apply, the caller
 413 -- is responsible for making sure that none of these names
 414 -- are in scope.
 415 --
 416 -- If there is just one 'Id' in the tuple, then the selector is
 417 -- just the identity.
 418 --
 419 -- If necessary, we pattern match on a \"big\" tuple.
 420 mkTupleSelector :: [Id]         -- ^ The 'Id's to pattern match the tuple against
 421                 -> Id           -- ^ The 'Id' to select
 422                 -> Id           -- ^ A variable of the same type as the scrutinee
 423                 -> CoreExpr     -- ^ Scrutinee
 424                 -> CoreExpr     -- ^ Selector expression
 425
 426 -- mkTupleSelector [a,b,c,d] b v e
 427 --          = case e of v {
 428 --                (p,q) -> case p of p {
 429 --                           (a,b) -> b }}
 430 -- We use 'tpl' vars for the p,q, since shadowing does not matter.
 431 --
 432 -- In fact, it's more convenient to generate it innermost first, getting
 433 --
 434 --        case (case e of v
 435 --                (p,q) -> p) of p
 436 --          (a,b) -> b
 437 mkTupleSelector vars the_var scrut_var scrut
 438   = mk_tup_sel (chunkify vars) the_var
 439   where
 440     mk_tup_sel [vars] the_var = mkSmallTupleSelector vars the_var scrut_var scrut
 441     mk_tup_sel vars_s the_var = mkSmallTupleSelector group the_var tpl_v $
 442                                 mk_tup_sel (chunkify tpl_vs) tpl_v
 443         where
 444           tpl_tys = [mkCoreTupTy (map idType gp) | gp <- vars_s]
 445           tpl_vs  = mkTemplateLocals tpl_tys
 446           [(tpl_v, group)] = [(tpl,gp) | (tpl,gp) <- zipEqual "mkTupleSelector" tpl_vs vars_s,
 447                                          the_var `elem` gp ]
 448 \end{code}
 449
 450 \begin{code}
 451 -- | Like 'mkTupleSelector' but for tuples that are guaranteed
 452 -- never to be \"big\".
 453 --
 454 -- > mkSmallTupleSelector [x] x v e = [| e |]
 455 -- > mkSmallTupleSelector [x,y,z] x v e = [| case e of v { (x,y,z) -> x } |]
 456 mkSmallTupleSelector :: [Id]        -- The tuple args
 457           -> Id         -- The selected one
 458           -> Id         -- A variable of the same type as the scrutinee
 459           -> CoreExpr        -- Scrutinee
 460           -> CoreExpr
 461 mkSmallTupleSelector [var] should_be_the_same_var _ scrut
 462   = ASSERT(var == should_be_the_same_var)
 463     scrut
 464 mkSmallTupleSelector vars the_var scrut_var scrut
 465   = ASSERT( notNull vars )
 466     Case scrut scrut_var (idType the_var)
 467          [(DataAlt (tupleCon Boxed (length vars)), vars, Var the_var)]
 468 \end{code}
 469
 470 \begin{code}
 471 -- | A generalization of 'mkTupleSelector', allowing the body
 472 -- of the case to be an arbitrary expression.
 473 --
 474 -- To avoid shadowing, we use uniques to invent new variables.
 475 --
 476 -- If necessary we pattern match on a \"big\" tuple.
 477 mkTupleCase :: UniqSupply       -- ^ For inventing names of intermediate variables
 478             -> [Id]             -- ^ The tuple identifiers to pattern match on
 479             -> CoreExpr         -- ^ Body of the case
 480             -> Id               -- ^ A variable of the same type as the scrutinee
 481             -> CoreExpr         -- ^ Scrutinee
 482             -> CoreExpr
 483 -- ToDo: eliminate cases where none of the variables are needed.
 484 --
 485 --         mkTupleCase uniqs [a,b,c,d] body v e
 486 --           = case e of v { (p,q) ->
 487 --             case p of p { (a,b) ->
 488 --             case q of q { (c,d) ->
 489 --             body }}}
 490 mkTupleCase uniqs vars body scrut_var scrut
 491   = mk_tuple_case uniqs (chunkify vars) body
 492   where
 493     -- This is the case where don't need any nesting
 494     mk_tuple_case _ [vars] body
 495       = mkSmallTupleCase vars body scrut_var scrut
 496
 497     -- This is the case where we must make nest tuples at least once
 498     mk_tuple_case us vars_s body
 499       = let (us', vars', body') = foldr one_tuple_case (us, [], body) vars_s
 500             in mk_tuple_case us' (chunkify vars') body'
 501
 502     one_tuple_case chunk_vars (us, vs, body)
 503       = let (us1, us2) = splitUniqSupply us
 504             scrut_var = mkSysLocal (fsLit "ds") (uniqFromSupply us1)
 505               (mkCoreTupTy (map idType chunk_vars))
 506             body' = mkSmallTupleCase chunk_vars body scrut_var (Var scrut_var)
 507         in (us2, scrut_var:vs, body')
 508 \end{code}
 509
 510 \begin{code}
 511 -- | As 'mkTupleCase', but for a tuple that is small enough to be guaranteed
 512 -- not to need nesting.
 513 mkSmallTupleCase
 514         :: [Id]         -- ^ The tuple args
 515         -> CoreExpr     -- ^ Body of the case
 516         -> Id           -- ^ A variable of the same type as the scrutinee
 517         -> CoreExpr     -- ^ Scrutinee
 518         -> CoreExpr
 519
 520 mkSmallTupleCase [var] body _scrut_var scrut
 521   = bindNonRec var scrut body
 522 mkSmallTupleCase vars body scrut_var scrut
 523 -- One branch no refinement?
 524   = Case scrut scrut_var (exprType body) [(DataAlt (tupleCon Boxed (length vars)), vars, body)]
 525 \end{code}
 526
 527 %************************************************************************
 528 %*                                                                      *
 529 \subsection{Common list manipulation expressions}
 530 %*                                                                      *
 531 %************************************************************************
 532
 533 Call the constructor Ids when building explicit lists, so that they
 534 interact well with rules.
 535
 536 \begin{code}
 537 -- | Makes a list @[]@ for lists of the specified type
 538 mkNilExpr :: Type -> CoreExpr
 539 mkNilExpr ty = mkConApp nilDataCon [Type ty]
 540
 541 -- | Makes a list @(:)@ for lists of the specified type
 542 mkConsExpr :: Type -> CoreExpr -> CoreExpr -> CoreExpr
 543 mkConsExpr ty hd tl = mkConApp consDataCon [Type ty, hd, tl]
 544
 545 -- | Make a list containing the given expressions, where the list has the given type
 546 mkListExpr :: Type -> [CoreExpr] -> CoreExpr
 547 mkListExpr ty xs = foldr (mkConsExpr ty) (mkNilExpr ty) xs
 548
 549 -- | Make a fully applied 'foldr' expression
 550 mkFoldrExpr :: MonadThings m
 551             => Type             -- ^ Element type of the list
 552             -> Type             -- ^ Fold result type
 553             -> CoreExpr         -- ^ "Cons" function expression for the fold
 554             -> CoreExpr         -- ^ "Nil" expression for the fold
 555             -> CoreExpr         -- ^ List expression being folded acress
 556             -> m CoreExpr
 557 mkFoldrExpr elt_ty result_ty c n list = do
 558     foldr_id <- lookupId foldrName
 559     return (Var foldr_id `App` Type elt_ty
 560            `App` Type result_ty
 561            `App` c
 562            `App` n
 563            `App` list)
 564
 565 -- | Make a 'build' expression applied to a locally-bound worker function
 566 mkBuildExpr :: (MonadThings m, MonadUnique m)
 567             => Type                                     -- ^ Type of list elements to be built
 568             -> ((Id, Type) -> (Id, Type) -> m CoreExpr) -- ^ Function that, given information about the 'Id's
 569                                                         -- of the binders for the build worker function, returns
 570                                                         -- the body of that worker
 571             -> m CoreExpr
 572 mkBuildExpr elt_ty mk_build_inside = do
 573     [n_tyvar] <- newTyVars [alphaTyVar]
 574     let n_ty = mkTyVarTy n_tyvar
 575         c_ty = mkFunTys [elt_ty, n_ty] n_ty
 576     [c, n] <- sequence [mkSysLocalM (fsLit "c") c_ty, mkSysLocalM (fsLit "n") n_ty]
 577
 578     build_inside <- mk_build_inside (c, c_ty) (n, n_ty)
 579
 580     build_id <- lookupId buildName
 581     return $ Var build_id `App` Type elt_ty `App` mkLams [n_tyvar, c, n] build_inside
 582   where
 583     newTyVars tyvar_tmpls = do
 584       uniqs <- getUniquesM
 585       return (zipWith setTyVarUnique tyvar_tmpls uniqs)
 586 \end{code}