never executed always true always false
1
2
3 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
4
5 -- | Handy functions for creating much Core syntax
6 module GHC.Core.Make (
7 -- * Constructing normal syntax
8 mkCoreLet, mkCoreLets,
9 mkCoreApp, mkCoreApps, mkCoreConApps,
10 mkCoreLams, mkWildCase, mkIfThenElse,
11 mkWildValBinder, mkWildEvBinder,
12 mkSingleAltCase,
13 sortQuantVars, castBottomExpr,
14
15 -- * Constructing boxed literals
16 mkLitRubbish,
17 mkWordExpr,
18 mkIntExpr, mkIntExprInt, mkUncheckedIntExpr,
19 mkIntegerExpr, mkNaturalExpr,
20 mkFloatExpr, mkDoubleExpr,
21 mkCharExpr, mkStringExpr, mkStringExprFS, mkStringExprFSWith,
22
23 -- * Floats
24 FloatBind(..), wrapFloat, wrapFloats, floatBindings,
25
26 -- * Constructing small tuples
27 mkCoreVarTupTy, mkCoreTup, mkCoreUbxTup, mkCoreUbxSum,
28 mkCoreTupBoxity, unitExpr,
29
30 -- * Constructing big tuples
31 mkBigCoreVarTup, mkBigCoreVarTup1,
32 mkBigCoreVarTupTy, mkBigCoreTupTy,
33 mkBigCoreTup,
34
35 -- * Deconstructing small tuples
36 mkSmallTupleSelector, mkSmallTupleCase,
37
38 -- * Deconstructing big tuples
39 mkTupleSelector, mkTupleSelector1, mkTupleCase,
40
41 -- * Constructing list expressions
42 mkNilExpr, mkConsExpr, mkListExpr,
43 mkFoldrExpr, mkBuildExpr,
44
45 -- * Constructing Maybe expressions
46 mkNothingExpr, mkJustExpr,
47
48 -- * Error Ids
49 mkRuntimeErrorApp, mkImpossibleExpr, mkAbsentErrorApp, errorIds,
50 rEC_CON_ERROR_ID, rUNTIME_ERROR_ID,
51 nON_EXHAUSTIVE_GUARDS_ERROR_ID, nO_METHOD_BINDING_ERROR_ID,
52 pAT_ERROR_ID, rEC_SEL_ERROR_ID, aBSENT_ERROR_ID,
53 tYPE_ERROR_ID, aBSENT_SUM_FIELD_ERROR_ID
54 ) where
55
56 import GHC.Prelude
57 import GHC.Platform
58
59 import GHC.Types.Id
60 import GHC.Types.Var ( EvVar, setTyVarUnique )
61 import GHC.Types.TyThing
62 import GHC.Types.Id.Info
63 import GHC.Types.Cpr
64 import GHC.Types.Demand
65 import GHC.Types.Name hiding ( varName )
66 import GHC.Types.Literal
67 import GHC.Types.Unique.Supply
68
69 import GHC.Core
70 import GHC.Core.Utils ( exprType, needsCaseBinding, mkSingleAltCase, bindNonRec )
71 import GHC.Core.Type
72 import GHC.Core.Coercion ( isCoVar )
73 import GHC.Core.DataCon ( DataCon, dataConWorkId )
74 import GHC.Core.Multiplicity
75
76 import GHC.Hs.Utils ( mkChunkified, chunkify )
77
78 import GHC.Builtin.Types
79 import GHC.Builtin.Names
80 import GHC.Builtin.Types.Prim
81
82 import GHC.Utils.Outputable
83 import GHC.Utils.Misc
84 import GHC.Utils.Panic
85 import GHC.Utils.Panic.Plain
86
87 import GHC.Data.FastString
88
89 import Data.List ( partition )
90 import Data.Char ( ord )
91
92 infixl 4 `mkCoreApp`, `mkCoreApps`
93
94 {-
95 ************************************************************************
96 * *
97 \subsection{Basic GHC.Core construction}
98 * *
99 ************************************************************************
100 -}
101 -- | Sort the variables, putting type and covars first, in scoped order,
102 -- and then other Ids
103 --
104 -- It is a deterministic sort, meaining it doesn't look at the values of
105 -- Uniques. For explanation why it's important See Note [Unique Determinism]
106 -- in GHC.Types.Unique.
107 sortQuantVars :: [Var] -> [Var]
108 sortQuantVars vs = sorted_tcvs ++ ids
109 where
110 (tcvs, ids) = partition (isTyVar <||> isCoVar) vs
111 sorted_tcvs = scopedSort tcvs
112
113 -- | Bind a binding group over an expression, using a @let@ or @case@ as
114 -- appropriate (see "GHC.Core#let_app_invariant")
115 mkCoreLet :: CoreBind -> CoreExpr -> CoreExpr
116 mkCoreLet (NonRec bndr rhs) body -- See Note [Core let/app invariant]
117 = bindNonRec bndr rhs body
118 mkCoreLet bind body
119 = Let bind body
120
121 -- | Create a lambda where the given expression has a number of variables
122 -- bound over it. The leftmost binder is that bound by the outermost
123 -- lambda in the result
124 mkCoreLams :: [CoreBndr] -> CoreExpr -> CoreExpr
125 mkCoreLams = mkLams
126
127 -- | Bind a list of binding groups over an expression. The leftmost binding
128 -- group becomes the outermost group in the resulting expression
129 mkCoreLets :: [CoreBind] -> CoreExpr -> CoreExpr
130 mkCoreLets binds body = foldr mkCoreLet body binds
131
132 -- | Construct an expression which represents the application of a number of
133 -- expressions to that of a data constructor expression. The leftmost expression
134 -- in the list is applied first
135 mkCoreConApps :: DataCon -> [CoreExpr] -> CoreExpr
136 mkCoreConApps con args = mkCoreApps (Var (dataConWorkId con)) args
137
138 -- | Construct an expression which represents the application of a number of
139 -- expressions to another. The leftmost expression in the list is applied first
140 --
141 -- Respects the let/app invariant by building a case expression where necessary
142 -- See Note [Core let/app invariant] in "GHC.Core"
143 mkCoreApps :: CoreExpr -- ^ function
144 -> [CoreExpr] -- ^ arguments
145 -> CoreExpr
146 mkCoreApps fun args
147 = fst $
148 foldl' (mkCoreAppTyped doc_string) (fun, fun_ty) args
149 where
150 doc_string = ppr fun_ty $$ ppr fun $$ ppr args
151 fun_ty = exprType fun
152
153 -- | Construct an expression which represents the application of one expression
154 -- to the other
155 --
156 -- Respects the let/app invariant by building a case expression where necessary
157 -- See Note [Core let/app invariant] in "GHC.Core"
158 mkCoreApp :: SDoc
159 -> CoreExpr -- ^ function
160 -> CoreExpr -- ^ argument
161 -> CoreExpr
162 mkCoreApp s fun arg
163 = fst $ mkCoreAppTyped s (fun, exprType fun) arg
164
165 -- | Construct an expression which represents the application of one expression
166 -- paired with its type to an argument. The result is paired with its type. This
167 -- function is not exported and used in the definition of 'mkCoreApp' and
168 -- 'mkCoreApps'.
169 --
170 -- Respects the let/app invariant by building a case expression where necessary
171 -- See Note [Core let/app invariant] in "GHC.Core"
172 mkCoreAppTyped :: SDoc -> (CoreExpr, Type) -> CoreExpr -> (CoreExpr, Type)
173 mkCoreAppTyped _ (fun, fun_ty) (Type ty)
174 = (App fun (Type ty), piResultTy fun_ty ty)
175 mkCoreAppTyped _ (fun, fun_ty) (Coercion co)
176 = (App fun (Coercion co), funResultTy fun_ty)
177 mkCoreAppTyped d (fun, fun_ty) arg
178 = assertPpr (isFunTy fun_ty) (ppr fun $$ ppr arg $$ d)
179 (mkValApp fun arg (Scaled mult arg_ty) res_ty, res_ty)
180 where
181 (mult, arg_ty, res_ty) = splitFunTy fun_ty
182
183 -- | Build an application (e1 e2),
184 -- or a strict binding (case e2 of x -> e1 x)
185 -- using the latter when necessary to respect the let/app invariant
186 -- See Note [Core let/app invariant] in GHC.Core
187 mkValApp :: CoreExpr -> CoreExpr -> Scaled Type -> Type -> CoreExpr
188 mkValApp fun arg (Scaled w arg_ty) res_ty
189 | not (needsCaseBinding arg_ty arg)
190 = App fun arg -- The vastly common case
191 | otherwise
192 = mkStrictApp fun arg (Scaled w arg_ty) res_ty
193
194 {- *********************************************************************
195 * *
196 Building case expressions
197 * *
198 ********************************************************************* -}
199
200 mkWildEvBinder :: PredType -> EvVar
201 mkWildEvBinder pred = mkWildValBinder Many pred
202
203 -- | Make a /wildcard binder/. This is typically used when you need a binder
204 -- that you expect to use only at a *binding* site. Do not use it at
205 -- occurrence sites because it has a single, fixed unique, and it's very
206 -- easy to get into difficulties with shadowing. That's why it is used so little.
207 --
208 -- See Note [WildCard binders] in "GHC.Core.Opt.Simplify.Env"
209 mkWildValBinder :: Mult -> Type -> Id
210 mkWildValBinder w ty = mkLocalIdOrCoVar wildCardName w ty
211 -- "OrCoVar" since a coercion can be a scrutinee with -fdefer-type-errors
212 -- (e.g. see test T15695). Ticket #17291 covers fixing this problem.
213
214 -- | Make a case expression whose case binder is unused
215 -- The alts and res_ty should not have any occurrences of WildId
216 mkWildCase :: CoreExpr -- ^ scrutinee
217 -> Scaled Type
218 -> Type -- ^ res_ty
219 -> [CoreAlt] -- ^ alts
220 -> CoreExpr
221 mkWildCase scrut (Scaled w scrut_ty) res_ty alts
222 = Case scrut (mkWildValBinder w scrut_ty) res_ty alts
223
224 -- | Build a strict application (case e2 of x -> e1 x)
225 mkStrictApp :: CoreExpr -> CoreExpr -> Scaled Type -> Type -> CoreExpr
226 mkStrictApp fun arg (Scaled w arg_ty) res_ty
227 = Case arg arg_id res_ty [Alt DEFAULT [] (App fun (Var arg_id))]
228 -- mkDefaultCase looks attractive here, and would be sound.
229 -- But it uses (exprType alt_rhs) to compute the result type,
230 -- whereas here we already know that the result type is res_ty
231 where
232 arg_id = mkWildValBinder w arg_ty
233 -- Lots of shadowing, but it doesn't matter,
234 -- because 'fun' and 'res_ty' should not have a free wild-id
235 --
236 -- This is Dangerous. But this is the only place we play this
237 -- game, mkStrictApp returns an expression that does not have
238 -- a free wild-id. So the only way 'fun' could get a free wild-id
239 -- would be if you take apart this case expression (or some other
240 -- expression that uses mkWildValBinder, of which there are not
241 -- many), and pass a fragment of it as the fun part of a 'mkStrictApp'.
242
243 mkIfThenElse :: CoreExpr -- ^ guard
244 -> CoreExpr -- ^ then
245 -> CoreExpr -- ^ else
246 -> CoreExpr
247 mkIfThenElse guard then_expr else_expr
248 -- Not going to be refining, so okay to take the type of the "then" clause
249 = mkWildCase guard (linear boolTy) (exprType then_expr)
250 [ Alt (DataAlt falseDataCon) [] else_expr, -- Increasing order of tag!
251 Alt (DataAlt trueDataCon) [] then_expr ]
252
253 castBottomExpr :: CoreExpr -> Type -> CoreExpr
254 -- (castBottomExpr e ty), assuming that 'e' diverges,
255 -- return an expression of type 'ty'
256 -- See Note [Empty case alternatives] in GHC.Core
257 castBottomExpr e res_ty
258 | e_ty `eqType` res_ty = e
259 | otherwise = Case e (mkWildValBinder One e_ty) res_ty []
260 where
261 e_ty = exprType e
262
263 mkLitRubbish :: Type -> Maybe CoreExpr
264 -- Make a rubbish-literal CoreExpr of the given type.
265 -- Fail (returning Nothing) if
266 -- * the RuntimeRep of the Type is not monomorphic;
267 -- * the type is (a ~# b), the type of coercion
268 -- See INVARIANT 1 and 2 of item (2) in Note [Rubbish literals]
269 -- in GHC.Types.Literal
270 mkLitRubbish ty
271 | not (noFreeVarsOfType rep)
272 = Nothing -- Satisfy INVARIANT 1
273 | isCoVarType ty
274 = Nothing -- Satisfy INVARIANT 2
275 | otherwise
276 = Just (Lit (LitRubbish rep) `mkTyApps` [ty])
277 where
278 rep = getRuntimeRep ty
279
280 {-
281 ************************************************************************
282 * *
283 \subsection{Making literals}
284 * *
285 ************************************************************************
286 -}
287
288 -- | Create a 'CoreExpr' which will evaluate to the given @Int@
289 mkIntExpr :: Platform -> Integer -> CoreExpr -- Result = I# i :: Int
290 mkIntExpr platform i = mkCoreConApps intDataCon [mkIntLit platform i]
291
292 -- | Create a 'CoreExpr' which will evaluate to the given @Int@. Don't check
293 -- that the number is in the range of the target platform @Int@
294 mkUncheckedIntExpr :: Integer -> CoreExpr -- Result = I# i :: Int
295 mkUncheckedIntExpr i = mkCoreConApps intDataCon [Lit (mkLitIntUnchecked i)]
296
297 -- | Create a 'CoreExpr' which will evaluate to the given @Int@
298 mkIntExprInt :: Platform -> Int -> CoreExpr -- Result = I# i :: Int
299 mkIntExprInt platform i = mkCoreConApps intDataCon [mkIntLit platform (fromIntegral i)]
300
301 -- | Create a 'CoreExpr' which will evaluate to the a @Word@ with the given value
302 mkWordExpr :: Platform -> Integer -> CoreExpr
303 mkWordExpr platform w = mkCoreConApps wordDataCon [mkWordLit platform w]
304
305 -- | Create a 'CoreExpr' which will evaluate to the given @Integer@
306 mkIntegerExpr :: Platform -> Integer -> CoreExpr -- Result :: Integer
307 mkIntegerExpr platform i
308 | platformInIntRange platform i = mkCoreConApps integerISDataCon [mkIntLit platform i]
309 | i < 0 = mkCoreConApps integerINDataCon [Lit (mkLitBigNat (negate i))]
310 | otherwise = mkCoreConApps integerIPDataCon [Lit (mkLitBigNat i)]
311
312 -- | Create a 'CoreExpr' which will evaluate to the given @Natural@
313 mkNaturalExpr :: Platform -> Integer -> CoreExpr
314 mkNaturalExpr platform w
315 | platformInWordRange platform w = mkCoreConApps naturalNSDataCon [mkWordLit platform w]
316 | otherwise = mkCoreConApps naturalNBDataCon [Lit (mkLitBigNat w)]
317
318 -- | Create a 'CoreExpr' which will evaluate to the given @Float@
319 mkFloatExpr :: Float -> CoreExpr
320 mkFloatExpr f = mkCoreConApps floatDataCon [mkFloatLitFloat f]
321
322 -- | Create a 'CoreExpr' which will evaluate to the given @Double@
323 mkDoubleExpr :: Double -> CoreExpr
324 mkDoubleExpr d = mkCoreConApps doubleDataCon [mkDoubleLitDouble d]
325
326
327 -- | Create a 'CoreExpr' which will evaluate to the given @Char@
328 mkCharExpr :: Char -> CoreExpr -- Result = C# c :: Int
329 mkCharExpr c = mkCoreConApps charDataCon [mkCharLit c]
330
331 -- | Create a 'CoreExpr' which will evaluate to the given @String@
332 mkStringExpr :: MonadThings m => String -> m CoreExpr -- Result :: String
333
334 -- | Create a 'CoreExpr' which will evaluate to a string morally equivalent to the given @FastString@
335 mkStringExprFS :: MonadThings m => FastString -> m CoreExpr -- Result :: String
336
337 mkStringExpr str = mkStringExprFS (mkFastString str)
338
339 mkStringExprFS = mkStringExprFSWith lookupId
340
341 mkStringExprFSWith :: Monad m => (Name -> m Id) -> FastString -> m CoreExpr
342 mkStringExprFSWith lookupM str
343 | nullFS str
344 = return (mkNilExpr charTy)
345
346 | all safeChar chars
347 = do unpack_id <- lookupM unpackCStringName
348 return (App (Var unpack_id) lit)
349
350 | otherwise
351 = do unpack_utf8_id <- lookupM unpackCStringUtf8Name
352 return (App (Var unpack_utf8_id) lit)
353
354 where
355 chars = unpackFS str
356 safeChar c = ord c >= 1 && ord c <= 0x7F
357 lit = Lit (LitString (bytesFS str))
358
359 {-
360 ************************************************************************
361 * *
362 \subsection{Tuple constructors}
363 * *
364 ************************************************************************
365 -}
366
367 {-
368 Creating tuples and their types for Core expressions
369
370 @mkBigCoreVarTup@ builds a tuple; the inverse to @mkTupleSelector@.
371
372 * If it has only one element, it is the identity function.
373
374 * If there are more elements than a big tuple can have, it nests
375 the tuples.
376
377 Note [Flattening one-tuples]
378 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
379 This family of functions creates a tuple of variables/expressions/types.
380 mkCoreTup [e1,e2,e3] = (e1,e2,e3)
381 What if there is just one variable/expression/type in the argument?
382 We could do one of two things:
383
384 * Flatten it out, so that
385 mkCoreTup [e1] = e1
386
387 * Build a one-tuple (see Note [One-tuples] in GHC.Builtin.Types)
388 mkCoreTup1 [e1] = Solo e1
389 We use a suffix "1" to indicate this.
390
391 Usually we want the former, but occasionally the latter.
392
393 NB: The logic in tupleDataCon knows about () and Solo and (,), etc.
394
395 Note [Don't flatten tuples from HsSyn]
396 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
397 If we get an explicit 1-tuple from HsSyn somehow (likely: Template Haskell),
398 we should treat it really as a 1-tuple, without flattening. Note that a
399 1-tuple and a flattened value have different performance and laziness
400 characteristics, so should just do what we're asked.
401
402 This arose from discussions in #16881.
403
404 One-tuples that arise internally depend on the circumstance; often flattening
405 is a good idea. Decisions are made on a case-by-case basis.
406
407 -}
408
409 -- | Build the type of a small tuple that holds the specified variables
410 -- One-tuples are flattened; see Note [Flattening one-tuples]
411 mkCoreVarTupTy :: [Id] -> Type
412 mkCoreVarTupTy ids = mkBoxedTupleTy (map idType ids)
413
414 -- | Build a small tuple holding the specified expressions
415 -- One-tuples are flattened; see Note [Flattening one-tuples]
416 mkCoreTup :: [CoreExpr] -> CoreExpr
417 mkCoreTup [c] = c
418 mkCoreTup cs = mkCoreTup1 cs -- non-1-tuples are uniform
419
420 -- | Build a small tuple holding the specified expressions
421 -- One-tuples are *not* flattened; see Note [Flattening one-tuples]
422 -- See also Note [Don't flatten tuples from HsSyn]
423 mkCoreTup1 :: [CoreExpr] -> CoreExpr
424 mkCoreTup1 cs = mkCoreConApps (tupleDataCon Boxed (length cs))
425 (map (Type . exprType) cs ++ cs)
426
427 -- | Build a small unboxed tuple holding the specified expressions,
428 -- with the given types. The types must be the types of the expressions.
429 -- Do not include the RuntimeRep specifiers; this function calculates them
430 -- for you.
431 -- Does /not/ flatten one-tuples; see Note [Flattening one-tuples]
432 mkCoreUbxTup :: [Type] -> [CoreExpr] -> CoreExpr
433 mkCoreUbxTup tys exps
434 = assert (tys `equalLength` exps) $
435 mkCoreConApps (tupleDataCon Unboxed (length tys))
436 (map (Type . getRuntimeRep) tys ++ map Type tys ++ exps)
437
438 -- | Make a core tuple of the given boxity; don't flatten 1-tuples
439 mkCoreTupBoxity :: Boxity -> [CoreExpr] -> CoreExpr
440 mkCoreTupBoxity Boxed exps = mkCoreTup1 exps
441 mkCoreTupBoxity Unboxed exps = mkCoreUbxTup (map exprType exps) exps
442
443 -- | Build an unboxed sum.
444 --
445 -- Alternative number ("alt") starts from 1.
446 mkCoreUbxSum :: Int -> Int -> [Type] -> CoreExpr -> CoreExpr
447 mkCoreUbxSum arity alt tys exp
448 = assert (length tys == arity) $
449 assert (alt <= arity) $
450 mkCoreConApps (sumDataCon alt arity)
451 (map (Type . getRuntimeRep) tys
452 ++ map Type tys
453 ++ [exp])
454
455 -- | Build a big tuple holding the specified variables
456 -- One-tuples are flattened; see Note [Flattening one-tuples]
457 mkBigCoreVarTup :: [Id] -> CoreExpr
458 mkBigCoreVarTup ids = mkBigCoreTup (map Var ids)
459
460 mkBigCoreVarTup1 :: [Id] -> CoreExpr
461 -- Same as mkBigCoreVarTup, but one-tuples are NOT flattened
462 -- see Note [Flattening one-tuples]
463 mkBigCoreVarTup1 [id] = mkCoreConApps (tupleDataCon Boxed 1)
464 [Type (idType id), Var id]
465 mkBigCoreVarTup1 ids = mkBigCoreTup (map Var ids)
466
467 -- | Build the type of a big tuple that holds the specified variables
468 -- One-tuples are flattened; see Note [Flattening one-tuples]
469 mkBigCoreVarTupTy :: [Id] -> Type
470 mkBigCoreVarTupTy ids = mkBigCoreTupTy (map idType ids)
471
472 -- | Build a big tuple holding the specified expressions
473 -- One-tuples are flattened; see Note [Flattening one-tuples]
474 mkBigCoreTup :: [CoreExpr] -> CoreExpr
475 mkBigCoreTup = mkChunkified mkCoreTup
476
477 -- | Build the type of a big tuple that holds the specified type of thing
478 -- One-tuples are flattened; see Note [Flattening one-tuples]
479 mkBigCoreTupTy :: [Type] -> Type
480 mkBigCoreTupTy = mkChunkified mkBoxedTupleTy
481
482 -- | The unit expression
483 unitExpr :: CoreExpr
484 unitExpr = Var unitDataConId
485
486 {-
487 ************************************************************************
488 * *
489 \subsection{Tuple destructors}
490 * *
491 ************************************************************************
492 -}
493
494 -- | Builds a selector which scrutises the given
495 -- expression and extracts the one name from the list given.
496 -- If you want the no-shadowing rule to apply, the caller
497 -- is responsible for making sure that none of these names
498 -- are in scope.
499 --
500 -- If there is just one 'Id' in the tuple, then the selector is
501 -- just the identity.
502 --
503 -- If necessary, we pattern match on a \"big\" tuple.
504 --
505 -- A tuple selector is not linear in its argument. Consequently, the case
506 -- expression built by `mkTupleSelector` must consume its scrutinee 'Many'
507 -- times. And all the argument variables must have multiplicity 'Many'.
508 mkTupleSelector, mkTupleSelector1
509 :: [Id] -- ^ The 'Id's to pattern match the tuple against
510 -> Id -- ^ The 'Id' to select
511 -> Id -- ^ A variable of the same type as the scrutinee
512 -> CoreExpr -- ^ Scrutinee
513 -> CoreExpr -- ^ Selector expression
514
515 -- mkTupleSelector [a,b,c,d] b v e
516 -- = case e of v {
517 -- (p,q) -> case p of p {
518 -- (a,b) -> b }}
519 -- We use 'tpl' vars for the p,q, since shadowing does not matter.
520 --
521 -- In fact, it's more convenient to generate it innermost first, getting
522 --
523 -- case (case e of v
524 -- (p,q) -> p) of p
525 -- (a,b) -> b
526 mkTupleSelector vars the_var scrut_var scrut
527 = mk_tup_sel (chunkify vars) the_var
528 where
529 mk_tup_sel [vars] the_var = mkSmallTupleSelector vars the_var scrut_var scrut
530 mk_tup_sel vars_s the_var = mkSmallTupleSelector group the_var tpl_v $
531 mk_tup_sel (chunkify tpl_vs) tpl_v
532 where
533 tpl_tys = [mkBoxedTupleTy (map idType gp) | gp <- vars_s]
534 tpl_vs = mkTemplateLocals tpl_tys
535 [(tpl_v, group)] = [(tpl,gp) | (tpl,gp) <- zipEqual "mkTupleSelector" tpl_vs vars_s,
536 the_var `elem` gp ]
537 -- ^ 'mkTupleSelector1' is like 'mkTupleSelector'
538 -- but one-tuples are NOT flattened (see Note [Flattening one-tuples])
539 mkTupleSelector1 vars the_var scrut_var scrut
540 | [_] <- vars
541 = mkSmallTupleSelector1 vars the_var scrut_var scrut
542 | otherwise
543 = mkTupleSelector vars the_var scrut_var scrut
544
545 -- | Like 'mkTupleSelector' but for tuples that are guaranteed
546 -- never to be \"big\".
547 --
548 -- > mkSmallTupleSelector [x] x v e = [| e |]
549 -- > mkSmallTupleSelector [x,y,z] x v e = [| case e of v { (x,y,z) -> x } |]
550 mkSmallTupleSelector, mkSmallTupleSelector1
551 :: [Id] -- The tuple args
552 -> Id -- The selected one
553 -> Id -- A variable of the same type as the scrutinee
554 -> CoreExpr -- Scrutinee
555 -> CoreExpr
556 mkSmallTupleSelector [var] should_be_the_same_var _ scrut
557 = assert (var == should_be_the_same_var) $
558 scrut -- Special case for 1-tuples
559 mkSmallTupleSelector vars the_var scrut_var scrut
560 = mkSmallTupleSelector1 vars the_var scrut_var scrut
561
562 -- ^ 'mkSmallTupleSelector1' is like 'mkSmallTupleSelector'
563 -- but one-tuples are NOT flattened (see Note [Flattening one-tuples])
564 mkSmallTupleSelector1 vars the_var scrut_var scrut
565 = assert (notNull vars) $
566 Case scrut scrut_var (idType the_var)
567 [Alt (DataAlt (tupleDataCon Boxed (length vars))) vars (Var the_var)]
568
569 -- | A generalization of 'mkTupleSelector', allowing the body
570 -- of the case to be an arbitrary expression.
571 --
572 -- To avoid shadowing, we use uniques to invent new variables.
573 --
574 -- If necessary we pattern match on a \"big\" tuple.
575 mkTupleCase :: UniqSupply -- ^ For inventing names of intermediate variables
576 -> [Id] -- ^ The tuple identifiers to pattern match on
577 -> CoreExpr -- ^ Body of the case
578 -> Id -- ^ A variable of the same type as the scrutinee
579 -> CoreExpr -- ^ Scrutinee
580 -> CoreExpr
581 -- ToDo: eliminate cases where none of the variables are needed.
582 --
583 -- mkTupleCase uniqs [a,b,c,d] body v e
584 -- = case e of v { (p,q) ->
585 -- case p of p { (a,b) ->
586 -- case q of q { (c,d) ->
587 -- body }}}
588 mkTupleCase uniqs vars body scrut_var scrut
589 = mk_tuple_case uniqs (chunkify vars) body
590 where
591 -- This is the case where don't need any nesting
592 mk_tuple_case _ [vars] body
593 = mkSmallTupleCase vars body scrut_var scrut
594
595 -- This is the case where we must make nest tuples at least once
596 mk_tuple_case us vars_s body
597 = let (us', vars', body') = foldr one_tuple_case (us, [], body) vars_s
598 in mk_tuple_case us' (chunkify vars') body'
599
600 one_tuple_case chunk_vars (us, vs, body)
601 = let (uniq, us') = takeUniqFromSupply us
602 scrut_var = mkSysLocal (fsLit "ds") uniq Many
603 (mkBoxedTupleTy (map idType chunk_vars))
604 body' = mkSmallTupleCase chunk_vars body scrut_var (Var scrut_var)
605 in (us', scrut_var:vs, body')
606
607 -- | As 'mkTupleCase', but for a tuple that is small enough to be guaranteed
608 -- not to need nesting.
609 mkSmallTupleCase
610 :: [Id] -- ^ The tuple args
611 -> CoreExpr -- ^ Body of the case
612 -> Id -- ^ A variable of the same type as the scrutinee
613 -> CoreExpr -- ^ Scrutinee
614 -> CoreExpr
615
616 mkSmallTupleCase [var] body _scrut_var scrut
617 = bindNonRec var scrut body
618 mkSmallTupleCase vars body scrut_var scrut
619 -- One branch no refinement?
620 = Case scrut scrut_var (exprType body)
621 [Alt (DataAlt (tupleDataCon Boxed (length vars))) vars body]
622
623 {-
624 ************************************************************************
625 * *
626 Floats
627 * *
628 ************************************************************************
629 -}
630
631 data FloatBind
632 = FloatLet CoreBind
633 | FloatCase CoreExpr Id AltCon [Var]
634 -- case e of y { C ys -> ... }
635 -- See Note [Floating single-alternative cases] in GHC.Core.Opt.SetLevels
636
637 instance Outputable FloatBind where
638 ppr (FloatLet b) = text "LET" <+> ppr b
639 ppr (FloatCase e b c bs) = hang (text "CASE" <+> ppr e <+> text "of" <+> ppr b)
640 2 (ppr c <+> ppr bs)
641
642 wrapFloat :: FloatBind -> CoreExpr -> CoreExpr
643 wrapFloat (FloatLet defns) body = Let defns body
644 wrapFloat (FloatCase e b con bs) body = mkSingleAltCase e b con bs body
645
646 -- | Applies the floats from right to left. That is @wrapFloats [b1, b2, …, bn]
647 -- u = let b1 in let b2 in … in let bn in u@
648 wrapFloats :: [FloatBind] -> CoreExpr -> CoreExpr
649 wrapFloats floats expr = foldr wrapFloat expr floats
650
651 bindBindings :: CoreBind -> [Var]
652 bindBindings (NonRec b _) = [b]
653 bindBindings (Rec bnds) = map fst bnds
654
655 floatBindings :: FloatBind -> [Var]
656 floatBindings (FloatLet bnd) = bindBindings bnd
657 floatBindings (FloatCase _ b _ bs) = b:bs
658
659 {-
660 ************************************************************************
661 * *
662 \subsection{Common list manipulation expressions}
663 * *
664 ************************************************************************
665
666 Call the constructor Ids when building explicit lists, so that they
667 interact well with rules.
668 -}
669
670 -- | Makes a list @[]@ for lists of the specified type
671 mkNilExpr :: Type -> CoreExpr
672 mkNilExpr ty = mkCoreConApps nilDataCon [Type ty]
673
674 -- | Makes a list @(:)@ for lists of the specified type
675 mkConsExpr :: Type -> CoreExpr -> CoreExpr -> CoreExpr
676 mkConsExpr ty hd tl = mkCoreConApps consDataCon [Type ty, hd, tl]
677
678 -- | Make a list containing the given expressions, where the list has the given type
679 mkListExpr :: Type -> [CoreExpr] -> CoreExpr
680 mkListExpr ty xs = foldr (mkConsExpr ty) (mkNilExpr ty) xs
681
682 -- | Make a fully applied 'foldr' expression
683 mkFoldrExpr :: MonadThings m
684 => Type -- ^ Element type of the list
685 -> Type -- ^ Fold result type
686 -> CoreExpr -- ^ "Cons" function expression for the fold
687 -> CoreExpr -- ^ "Nil" expression for the fold
688 -> CoreExpr -- ^ List expression being folded acress
689 -> m CoreExpr
690 mkFoldrExpr elt_ty result_ty c n list = do
691 foldr_id <- lookupId foldrName
692 return (Var foldr_id `App` Type elt_ty
693 `App` Type result_ty
694 `App` c
695 `App` n
696 `App` list)
697
698 -- | Make a 'build' expression applied to a locally-bound worker function
699 mkBuildExpr :: (MonadFail m, MonadThings m, MonadUnique m)
700 => Type -- ^ Type of list elements to be built
701 -> ((Id, Type) -> (Id, Type) -> m CoreExpr) -- ^ Function that, given information about the 'Id's
702 -- of the binders for the build worker function, returns
703 -- the body of that worker
704 -> m CoreExpr
705 mkBuildExpr elt_ty mk_build_inside = do
706 n_tyvar <- newTyVar alphaTyVar
707 let n_ty = mkTyVarTy n_tyvar
708 c_ty = mkVisFunTysMany [elt_ty, n_ty] n_ty
709 [c, n] <- sequence [mkSysLocalM (fsLit "c") Many c_ty, mkSysLocalM (fsLit "n") Many n_ty]
710
711 build_inside <- mk_build_inside (c, c_ty) (n, n_ty)
712
713 build_id <- lookupId buildName
714 return $ Var build_id `App` Type elt_ty `App` mkLams [n_tyvar, c, n] build_inside
715 where
716 newTyVar tyvar_tmpl = do
717 uniq <- getUniqueM
718 return (setTyVarUnique tyvar_tmpl uniq)
719
720 {-
721 ************************************************************************
722 * *
723 Manipulating Maybe data type
724 * *
725 ************************************************************************
726 -}
727
728
729 -- | Makes a Nothing for the specified type
730 mkNothingExpr :: Type -> CoreExpr
731 mkNothingExpr ty = mkConApp nothingDataCon [Type ty]
732
733 -- | Makes a Just from a value of the specified type
734 mkJustExpr :: Type -> CoreExpr -> CoreExpr
735 mkJustExpr ty val = mkConApp justDataCon [Type ty, val]
736
737
738 {-
739 ************************************************************************
740 * *
741 Error expressions
742 * *
743 ************************************************************************
744 -}
745
746 mkRuntimeErrorApp
747 :: Id -- Should be of type (forall a. Addr# -> a)
748 -- where Addr# points to a UTF8 encoded string
749 -> Type -- The type to instantiate 'a'
750 -> String -- The string to print
751 -> CoreExpr
752
753 mkRuntimeErrorApp err_id res_ty err_msg
754 = mkApps (Var err_id) [ Type (getRuntimeRep res_ty)
755 , Type res_ty, err_string ]
756 where
757 err_string = Lit (mkLitString err_msg)
758
759 mkImpossibleExpr :: Type -> CoreExpr
760 mkImpossibleExpr res_ty
761 = mkRuntimeErrorApp rUNTIME_ERROR_ID res_ty "Impossible case alternative"
762
763 {-
764 ************************************************************************
765 * *
766 Error Ids
767 * *
768 ************************************************************************
769
770 GHC randomly injects these into the code.
771
772 @patError@ is just a version of @error@ for pattern-matching
773 failures. It knows various ``codes'' which expand to longer
774 strings---this saves space!
775
776 @absentErr@ is a thing we put in for ``absent'' arguments. They jolly
777 well shouldn't be yanked on, but if one is, then you will get a
778 friendly message from @absentErr@ (rather than a totally random
779 crash).
780 -}
781
782 errorIds :: [Id]
783 errorIds
784 = [ rUNTIME_ERROR_ID,
785 nON_EXHAUSTIVE_GUARDS_ERROR_ID,
786 nO_METHOD_BINDING_ERROR_ID,
787 pAT_ERROR_ID,
788 rEC_CON_ERROR_ID,
789 rEC_SEL_ERROR_ID,
790 aBSENT_ERROR_ID,
791 aBSENT_SUM_FIELD_ERROR_ID,
792 tYPE_ERROR_ID, -- Used with Opt_DeferTypeErrors, see #10284
793 rAISE_OVERFLOW_ID,
794 rAISE_UNDERFLOW_ID,
795 rAISE_DIVZERO_ID
796 ]
797
798 recSelErrorName, runtimeErrorName, absentErrorName :: Name
799 recConErrorName, patErrorName :: Name
800 nonExhaustiveGuardsErrorName, noMethodBindingErrorName :: Name
801 typeErrorName :: Name
802 absentSumFieldErrorName :: Name
803 raiseOverflowName, raiseUnderflowName, raiseDivZeroName :: Name
804
805 recSelErrorName = err_nm "recSelError" recSelErrorIdKey rEC_SEL_ERROR_ID
806 runtimeErrorName = err_nm "runtimeError" runtimeErrorIdKey rUNTIME_ERROR_ID
807 recConErrorName = err_nm "recConError" recConErrorIdKey rEC_CON_ERROR_ID
808 patErrorName = err_nm "patError" patErrorIdKey pAT_ERROR_ID
809 typeErrorName = err_nm "typeError" typeErrorIdKey tYPE_ERROR_ID
810
811 noMethodBindingErrorName = err_nm "noMethodBindingError"
812 noMethodBindingErrorIdKey nO_METHOD_BINDING_ERROR_ID
813 nonExhaustiveGuardsErrorName = err_nm "nonExhaustiveGuardsError"
814 nonExhaustiveGuardsErrorIdKey nON_EXHAUSTIVE_GUARDS_ERROR_ID
815
816 err_nm :: String -> Unique -> Id -> Name
817 err_nm str uniq id = mkWiredInIdName cONTROL_EXCEPTION_BASE (fsLit str) uniq id
818
819 rEC_SEL_ERROR_ID, rUNTIME_ERROR_ID, rEC_CON_ERROR_ID :: Id
820 pAT_ERROR_ID, nO_METHOD_BINDING_ERROR_ID, nON_EXHAUSTIVE_GUARDS_ERROR_ID :: Id
821 tYPE_ERROR_ID, aBSENT_ERROR_ID, aBSENT_SUM_FIELD_ERROR_ID :: Id
822 rAISE_OVERFLOW_ID, rAISE_UNDERFLOW_ID, rAISE_DIVZERO_ID :: Id
823 rEC_SEL_ERROR_ID = mkRuntimeErrorId recSelErrorName
824 rUNTIME_ERROR_ID = mkRuntimeErrorId runtimeErrorName
825 rEC_CON_ERROR_ID = mkRuntimeErrorId recConErrorName
826 pAT_ERROR_ID = mkRuntimeErrorId patErrorName
827 nO_METHOD_BINDING_ERROR_ID = mkRuntimeErrorId noMethodBindingErrorName
828 nON_EXHAUSTIVE_GUARDS_ERROR_ID = mkRuntimeErrorId nonExhaustiveGuardsErrorName
829 tYPE_ERROR_ID = mkRuntimeErrorId typeErrorName
830
831 -- Note [aBSENT_SUM_FIELD_ERROR_ID]
832 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
833 --
834 -- Unboxed sums are transformed into unboxed tuples in GHC.Stg.Unarise.mkUbxSum
835 -- and fields that can't be reached are filled with rubbish values. It's easy to
836 -- come up with rubbish literal values: we use 0 (ints/words) and 0.0
837 -- (floats/doubles). Coming up with a rubbish pointer value is more delicate:
838 --
839 -- 1. it needs to be a valid closure pointer for the GC (not a NULL pointer)
840 --
841 -- 2. it is never used in Core, only in STG; and even then only for filling a
842 -- GC-ptr slot in an unboxed sum (see GHC.Stg.Unarise.ubxSumRubbishArg).
843 -- So all we need is a pointer, and its levity doesn't matter. Hence we
844 -- can safely give it the (lifted) type:
845 --
846 -- absentSumFieldError :: forall a. a
847 --
848 -- despite the fact that Unarise might instantiate it at non-lifted
849 -- types.
850 --
851 -- 3. it can't take arguments because it's used in unarise and applying an
852 -- argument would require allocating a thunk.
853 --
854 -- 4. it can't be CAFFY because that would mean making some non-CAFFY
855 -- definitions that use unboxed sums CAFFY in unarise.
856 --
857 -- Getting this wrong causes hard-to-debug runtime issues, see #15038.
858 --
859 -- 5. it can't be defined in `base` package.
860 --
861 -- Defining `absentSumFieldError` in `base` package introduces a
862 -- dependency on `base` for any code using unboxed sums. It became an
863 -- issue when we wanted to use unboxed sums in boot libraries used by
864 -- `base`, see #17791.
865 --
866 --
867 -- * Most runtime-error functions throw a proper Haskell exception, which can be
868 -- caught in the usual way. But these functions are defined in
869 -- `base:Control.Exception.Base`, hence, they cannot be directly invoked in
870 -- any library compiled before `base`. Only exceptions that have been wired
871 -- in the RTS can be thrown (indirectly, via a call into the RTS) by libraries
872 -- compiled before `base`.
873 --
874 -- However wiring exceptions in the RTS is a bit annoying because we need to
875 -- explicitly import exception closures via their mangled symbol name (e.g.
876 -- `import CLOSURE base_GHCziIOziException_heapOverflow_closure`) in Cmm files
877 -- and every imported symbol must be indicated to the linker in a few files
878 -- (`package.conf`, `rts.cabal`, `win32/libHSbase.def`, `Prelude.h`...). It
879 -- explains why exceptions are only wired in the RTS when necessary.
880 --
881 -- * `absentSumFieldError` is defined in ghc-prim:GHC.Prim.Panic, hence, it can
882 -- be invoked in libraries compiled before `base`. It does not throw a Haskell
883 -- exception; instead, it calls `stg_panic#`, which immediately halts
884 -- execution. A runtime invocation of `absentSumFieldError` indicates a GHC
885 -- bug. Unlike (say) pattern-match errors, it cannot be caused by a user
886 -- error. That's why it is OK for it to be un-catchable.
887 --
888
889 absentSumFieldErrorName
890 = mkWiredInIdName
891 gHC_PRIM_PANIC
892 (fsLit "absentSumFieldError")
893 absentSumFieldErrorIdKey
894 aBSENT_SUM_FIELD_ERROR_ID
895
896 absentErrorName
897 = mkWiredInIdName
898 gHC_PRIM_PANIC
899 (fsLit "absentError")
900 absentErrorIdKey
901 aBSENT_ERROR_ID
902
903 raiseOverflowName
904 = mkWiredInIdName
905 gHC_PRIM_EXCEPTION
906 (fsLit "raiseOverflow")
907 raiseOverflowIdKey
908 rAISE_OVERFLOW_ID
909
910 raiseUnderflowName
911 = mkWiredInIdName
912 gHC_PRIM_EXCEPTION
913 (fsLit "raiseUnderflow")
914 raiseUnderflowIdKey
915 rAISE_UNDERFLOW_ID
916
917 raiseDivZeroName
918 = mkWiredInIdName
919 gHC_PRIM_EXCEPTION
920 (fsLit "raiseDivZero")
921 raiseDivZeroIdKey
922 rAISE_DIVZERO_ID
923
924 aBSENT_SUM_FIELD_ERROR_ID = mkExceptionId absentSumFieldErrorName
925 rAISE_OVERFLOW_ID = mkExceptionId raiseOverflowName
926 rAISE_UNDERFLOW_ID = mkExceptionId raiseUnderflowName
927 rAISE_DIVZERO_ID = mkExceptionId raiseDivZeroName
928
929 -- | Non-CAFFY Exception with type \"forall a. a\"
930 mkExceptionId :: Name -> Id
931 mkExceptionId name
932 = mkVanillaGlobalWithInfo name
933 (mkSpecForAllTys [alphaTyVar] (mkTyVarTy alphaTyVar)) -- forall a . a
934 (divergingIdInfo [] `setCafInfo` NoCafRefs) -- No CAFs: #15038
935
936 mkRuntimeErrorId :: Name -> Id
937 -- Error function
938 -- with type: forall (r:RuntimeRep) (a:TYPE r). Addr# -> a
939 -- with arity: 1
940 -- which diverges after being given one argument
941 -- The Addr# is expected to be the address of
942 -- a UTF8-encoded error string
943 mkRuntimeErrorId name
944 = mkVanillaGlobalWithInfo name runtimeErrorTy (divergingIdInfo [evalDmd])
945 -- Do *not* mark them as NoCafRefs, because they can indeed have
946 -- CAF refs. For example, pAT_ERROR_ID calls GHC.Err.untangle,
947 -- which has some CAFs
948 -- In due course we may arrange that these error-y things are
949 -- regarded by the GC as permanently live, in which case we
950 -- can give them NoCaf info. As it is, any function that calls
951 -- any pc_bottoming_Id will itself have CafRefs, which bloats
952 -- SRTs.
953
954 runtimeErrorTy :: Type
955 -- forall (rr :: RuntimeRep) (a :: rr). Addr# -> a
956 -- See Note [Error and friends have an "open-tyvar" forall]
957 runtimeErrorTy = mkSpecForAllTys [runtimeRep1TyVar, openAlphaTyVar]
958 (mkVisFunTyMany addrPrimTy openAlphaTy)
959
960 -- | An 'IdInfo' for an Id, such as 'aBSENT_ERROR_ID' or 'raiseOverflow', that
961 -- throws an (imprecise) exception after being supplied one value arg for every
962 -- argument 'Demand' in the list. The demands end up in the demand signature.
963 --
964 -- 1. Sets the demand signature to unleash the given arg dmds 'botDiv'
965 -- 2. Sets the arity info so that it matches the length of arg demands
966 -- 3. Sets a bottoming CPR sig with the correct arity
967 --
968 -- It's important that all 3 agree on the arity, which is what this defn ensures.
969 divergingIdInfo :: [Demand] -> IdInfo
970 divergingIdInfo arg_dmds
971 = vanillaIdInfo `setArityInfo` arity
972 `setDmdSigInfo` mkClosedDmdSig arg_dmds botDiv
973 `setCprSigInfo` mkCprSig arity botCpr
974 where
975 arity = length arg_dmds
976
977 {- Note [Error and friends have an "open-tyvar" forall]
978 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
979 'error' and 'undefined' have types
980 error :: forall (v :: RuntimeRep) (a :: TYPE v). String -> a
981 undefined :: forall (v :: RuntimeRep) (a :: TYPE v). a
982 Notice the runtime-representation polymorphism. This ensures that
983 "error" can be instantiated at unboxed as well as boxed types.
984 This is OK because it never returns, so the return type is irrelevant.
985
986
987 ************************************************************************
988 * *
989 aBSENT_ERROR_ID
990 * *
991 ************************************************************************
992
993 Note [aBSENT_ERROR_ID]
994 ~~~~~~~~~~~~~~~~~~~~~~
995 We use aBSENT_ERROR_ID to build absent fillers for lifted types in workers. E.g.
996
997 f x = (case x of (a,b) -> b) + 1::Int
998
999 The demand analyser figures out that only the second component of x is
1000 used, and does a w/w split thus
1001
1002 f x = case x of (a,b) -> $wf b
1003
1004 $wf b = let a = absentError "blah"
1005 x = (a,b)
1006 in <the original RHS of f>
1007
1008 After some simplification, the (absentError "blah") thunk normally goes away.
1009 See also Note [Absent fillers] in GHC.Core.Opt.WorkWrap.Utils.
1010
1011 Historical Note
1012 ---------------
1013 We used to have exprIsHNF respond True to absentError and *not* mark it as diverging.
1014 Here's the reason for the former. It doesn't apply anymore because we no longer say
1015 that `a` is absent (A). Instead it gets (head strict) demand 1A and we won't
1016 emit the absent error:
1017
1018 #14285 had, roughly
1019
1020 data T a = MkT a !a
1021 {-# INLINABLE f #-}
1022 f x = case x of MkT a b -> g (MkT b a)
1023
1024 It turned out that g didn't use the second component, and hence f doesn't use
1025 the first. But the stable-unfolding for f looks like
1026 \x. case x of MkT a b -> g ($WMkT b a)
1027 where $WMkT is the wrapper for MkT that evaluates its arguments. We
1028 apply the same w/w split to this unfolding (see Note [Worker/wrapper
1029 for INLINEABLE functions] in GHC.Core.Opt.WorkWrap) so the template ends up like
1030 \b. let a = absentError "blah"
1031 x = MkT a b
1032 in case x of MkT a b -> g ($WMkT b a)
1033
1034 After doing case-of-known-constructor, and expanding $WMkT we get
1035 \b -> g (case absentError "blah" of a -> MkT b a)
1036
1037 Yikes! That bogusly appears to evaluate the absentError!
1038
1039 This is extremely tiresome. Another way to think of this is that, in
1040 Core, it is an invariant that a strict data constructor, like MkT, must
1041 be applied only to an argument in HNF. So (absentError "blah") had
1042 better be non-bottom.
1043
1044 So the "solution" is to add a special case for absentError to exprIsHNFlike.
1045 This allows Simplify.rebuildCase, in the Note [Case to let transformation]
1046 branch, to convert the case on absentError into a let. We also make
1047 absentError *not* be diverging, unlike the other error-ids, so that we
1048 can be sure not to remove the case branches before converting the case to
1049 a let.
1050
1051 If, by some bug or bizarre happenstance, we ever call absentError, we should
1052 throw an exception. This should never happen, of course, but we definitely
1053 can't return anything. e.g. if somehow we had
1054 case absentError "foo" of
1055 Nothing -> ...
1056 Just x -> ...
1057 then if we return, the case expression will select a field and continue.
1058 Seg fault city. Better to throw an exception. (Even though we've said
1059 it is in HNF :-)
1060
1061 It might seem a bit surprising that seq on absentError is simply erased
1062
1063 absentError "foo" `seq` x ==> x
1064
1065 but that should be okay; since there's no pattern match we can't really
1066 be relying on anything from it.
1067 -}
1068
1069 aBSENT_ERROR_ID -- See Note [aBSENT_ERROR_ID]
1070 = mkVanillaGlobalWithInfo absentErrorName absent_ty id_info
1071 where
1072 absent_ty = mkSpecForAllTys [alphaTyVar] (mkVisFunTyMany addrPrimTy alphaTy)
1073 -- Not runtime-rep polymorphic. aBSENT_ERROR_ID is only used for
1074 -- lifted-type things; see Note [Absent fillers] in GHC.Core.Opt.WorkWrap.Utils
1075 id_info = divergingIdInfo [evalDmd] -- NB: CAFFY!
1076
1077 mkAbsentErrorApp :: Type -- The type to instantiate 'a'
1078 -> String -- The string to print
1079 -> CoreExpr
1080
1081 mkAbsentErrorApp res_ty err_msg
1082 = mkApps (Var aBSENT_ERROR_ID) [ Type res_ty, err_string ]
1083 where
1084 err_string = Lit (mkLitString err_msg)