2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[DsUtils]{Utilities for desugaring}
6 This module exports some utility functions of no great interest.
10 CanItFail(..), EquationInfo(..), MatchResult(..),
17 cantFailMatchResult, extractMatchResult,
19 adjustMatchResult, adjustMatchResultDs,
20 mkCoLetsMatchResult, mkGuardedMatchResult,
21 mkCoPrimCaseMatchResult, mkCoAlgCaseMatchResult,
23 mkErrorAppDs, mkNilExpr, mkConsExpr, mkListExpr,
24 mkIntExpr, mkCharExpr,
25 mkStringLit, mkStringLitFS, mkIntegerExpr,
27 mkSelectorBinds, mkTupleExpr, mkTupleSelector, mkCoreTup,
32 #include "HsVersions.h"
34 import {-# SOURCE #-} Match ( matchSimply )
37 import TcHsSyn ( TypecheckedPat, hsPatType )
42 import CoreUtils ( exprType, mkIfThenElse, mkCoerce )
43 import MkId ( iRREFUT_PAT_ERROR_ID, mkReboxingAlt, mkNewTypeBody )
44 import Id ( idType, Id, mkWildId )
45 import Literal ( Literal(..), inIntRange, tARGET_MAX_INT )
46 import TyCon ( isNewTyCon, tyConDataCons )
47 import DataCon ( DataCon, dataConSourceArity )
48 import Type ( mkFunTy, isUnLiftedType, Type, splitTyConApp )
49 import TcType ( tcTyConAppTyCon, isIntTy, isFloatTy, isDoubleTy )
50 import TysPrim ( intPrimTy )
51 import TysWiredIn ( nilDataCon, consDataCon,
53 unitDataConId, unitTy,
55 intTy, intDataCon, smallIntegerDataCon,
58 stringTy, isPArrFakeCon )
59 import BasicTypes ( Boxity(..) )
60 import UniqSet ( mkUniqSet, minusUniqSet, isEmptyUniqSet, UniqSet )
61 import PrelNames ( unpackCStringName, unpackCStringUtf8Name,
62 plusIntegerName, timesIntegerName,
63 lengthPName, indexPName )
65 import UnicodeUtil ( intsToUtf8, stringToUtf8 )
66 import Util ( isSingleton, notNull )
72 %************************************************************************
74 \subsection{Tidying lit pats}
76 %************************************************************************
79 tidyLitPat :: HsLit -> TypecheckedPat -> TypecheckedPat
80 tidyLitPat (HsChar c) pat = mkCharLitPat c
81 tidyLitPat lit pat = pat
83 tidyNPat :: HsLit -> Type -> TypecheckedPat -> TypecheckedPat
84 tidyNPat (HsString s) _ pat
85 | lengthFS s <= 1 -- Short string literals only
86 = foldr (\c pat -> mkPrefixConPat consDataCon [mkCharLitPat c,pat] stringTy)
87 (mkNilPat stringTy) (unpackIntFS s)
88 -- The stringTy is the type of the whole pattern, not
89 -- the type to instantiate (:) or [] with!
92 tidyNPat lit lit_ty default_pat
93 | isIntTy lit_ty = mkPrefixConPat intDataCon [LitPat (mk_int lit)] lit_ty
94 | isFloatTy lit_ty = mkPrefixConPat floatDataCon [LitPat (mk_float lit)] lit_ty
95 | isDoubleTy lit_ty = mkPrefixConPat doubleDataCon [LitPat (mk_double lit)] lit_ty
96 | otherwise = default_pat
99 mk_int (HsInteger i) = HsIntPrim i
101 mk_float (HsInteger i) = HsFloatPrim (fromInteger i)
102 mk_float (HsRat f _) = HsFloatPrim f
104 mk_double (HsInteger i) = HsDoublePrim (fromInteger i)
105 mk_double (HsRat f _) = HsDoublePrim f
109 %************************************************************************
111 \subsection{Building lets}
113 %************************************************************************
115 Use case, not let for unlifted types. The simplifier will turn some
119 mkDsLet :: CoreBind -> CoreExpr -> CoreExpr
120 mkDsLet (NonRec bndr rhs) body
121 | isUnLiftedType (idType bndr) = Case rhs bndr [(DEFAULT,[],body)]
125 mkDsLets :: [CoreBind] -> CoreExpr -> CoreExpr
126 mkDsLets binds body = foldr mkDsLet body binds
130 %************************************************************************
132 \subsection{ Selecting match variables}
134 %************************************************************************
136 We're about to match against some patterns. We want to make some
137 @Ids@ to use as match variables. If a pattern has an @Id@ readily at
138 hand, which should indeed be bound to the pattern as a whole, then use it;
139 otherwise, make one up.
142 selectMatchVar :: TypecheckedPat -> DsM Id
143 selectMatchVar (VarPat var) = returnDs var
144 selectMatchVar (AsPat var pat) = returnDs var
145 selectMatchVar (LazyPat pat) = selectMatchVar pat
146 selectMatchVar other_pat = newSysLocalDs (hsPatType other_pat) -- OK, better make up one...
150 %************************************************************************
152 %* type synonym EquationInfo and access functions for its pieces *
154 %************************************************************************
155 \subsection[EquationInfo-synonym]{@EquationInfo@: a useful synonym}
157 The ``equation info'' used by @match@ is relatively complicated and
158 worthy of a type synonym and a few handy functions.
163 type EqnSet = UniqSet EqnNo
167 EqnNo -- The number of the equation
169 DsMatchContext -- The context info is used when producing warnings
170 -- about shadowed patterns. It's the context
171 -- of the *first* thing matched in this group.
172 -- Should perhaps be a list of them all!
174 [TypecheckedPat] -- The patterns for an eqn
176 MatchResult -- Encapsulates the guards and bindings
182 CanItFail -- Tells whether the failure expression is used
183 (CoreExpr -> DsM CoreExpr)
184 -- Takes a expression to plug in at the
185 -- failure point(s). The expression should
188 data CanItFail = CanFail | CantFail
190 orFail CantFail CantFail = CantFail
194 Functions on MatchResults
197 cantFailMatchResult :: CoreExpr -> MatchResult
198 cantFailMatchResult expr = MatchResult CantFail (\ ignore -> returnDs expr)
200 extractMatchResult :: MatchResult -> CoreExpr -> DsM CoreExpr
201 extractMatchResult (MatchResult CantFail match_fn) fail_expr
202 = match_fn (error "It can't fail!")
204 extractMatchResult (MatchResult CanFail match_fn) fail_expr
205 = mkFailurePair fail_expr `thenDs` \ (fail_bind, if_it_fails) ->
206 match_fn if_it_fails `thenDs` \ body ->
207 returnDs (mkDsLet fail_bind body)
210 combineMatchResults :: MatchResult -> MatchResult -> MatchResult
211 combineMatchResults (MatchResult CanFail body_fn1)
212 (MatchResult can_it_fail2 body_fn2)
213 = MatchResult can_it_fail2 body_fn
215 body_fn fail = body_fn2 fail `thenDs` \ body2 ->
216 mkFailurePair body2 `thenDs` \ (fail_bind, duplicatable_expr) ->
217 body_fn1 duplicatable_expr `thenDs` \ body1 ->
218 returnDs (Let fail_bind body1)
220 combineMatchResults match_result1@(MatchResult CantFail body_fn1) match_result2
224 adjustMatchResult :: (CoreExpr -> CoreExpr) -> MatchResult -> MatchResult
225 adjustMatchResult encl_fn (MatchResult can_it_fail body_fn)
226 = MatchResult can_it_fail (\fail -> body_fn fail `thenDs` \ body ->
227 returnDs (encl_fn body))
229 adjustMatchResultDs :: (CoreExpr -> DsM CoreExpr) -> MatchResult -> MatchResult
230 adjustMatchResultDs encl_fn (MatchResult can_it_fail body_fn)
231 = MatchResult can_it_fail (\fail -> body_fn fail `thenDs` \ body ->
235 mkCoLetsMatchResult :: [CoreBind] -> MatchResult -> MatchResult
236 mkCoLetsMatchResult binds match_result
237 = adjustMatchResult (mkDsLets binds) match_result
240 mkGuardedMatchResult :: CoreExpr -> MatchResult -> MatchResult
241 mkGuardedMatchResult pred_expr (MatchResult can_it_fail body_fn)
242 = MatchResult CanFail (\fail -> body_fn fail `thenDs` \ body ->
243 returnDs (mkIfThenElse pred_expr body fail))
245 mkCoPrimCaseMatchResult :: Id -- Scrutinee
246 -> [(Literal, MatchResult)] -- Alternatives
248 mkCoPrimCaseMatchResult var match_alts
249 = MatchResult CanFail mk_case
252 = mapDs (mk_alt fail) match_alts `thenDs` \ alts ->
253 returnDs (Case (Var var) var ((DEFAULT, [], fail) : alts))
255 mk_alt fail (lit, MatchResult _ body_fn) = body_fn fail `thenDs` \ body ->
256 returnDs (LitAlt lit, [], body)
259 mkCoAlgCaseMatchResult :: Id -- Scrutinee
260 -> [(DataCon, [CoreBndr], MatchResult)] -- Alternatives
263 mkCoAlgCaseMatchResult var match_alts
264 | isNewTyCon tycon -- Newtype case; use a let
265 = ASSERT( null (tail match_alts) && null (tail arg_ids) )
266 mkCoLetsMatchResult [NonRec arg_id newtype_rhs] match_result
268 | isPArrFakeAlts match_alts -- Sugared parallel array; use a literal case
269 = MatchResult CanFail mk_parrCase
271 | otherwise -- Datatype case; use a case
272 = MatchResult fail_flag mk_case
275 scrut_ty = idType var
276 tycon = tcTyConAppTyCon scrut_ty -- Newtypes must be opaque here
279 (_, arg_ids, match_result) = head match_alts
280 arg_id = head arg_ids
281 newtype_rhs = mkNewTypeBody tycon (idType arg_id) (Var var)
283 -- Stuff for data types
284 data_cons = tyConDataCons tycon
285 match_results = [match_result | (_,_,match_result) <- match_alts]
287 fail_flag | exhaustive_case
288 = foldr1 orFail [can_it_fail | MatchResult can_it_fail _ <- match_results]
292 wild_var = mkWildId (idType var)
293 mk_case fail = mapDs (mk_alt fail) match_alts `thenDs` \ alts ->
294 returnDs (Case (Var var) wild_var (mk_default fail ++ alts))
296 mk_alt fail (con, args, MatchResult _ body_fn)
297 = body_fn fail `thenDs` \ body ->
298 getUniquesDs `thenDs` \ us ->
299 returnDs (mkReboxingAlt us con args body)
301 mk_default fail | exhaustive_case = []
302 | otherwise = [(DEFAULT, [], fail)]
304 un_mentioned_constructors
305 = mkUniqSet data_cons `minusUniqSet` mkUniqSet [ con | (con, _, _) <- match_alts]
306 exhaustive_case = isEmptyUniqSet un_mentioned_constructors
308 -- Stuff for parallel arrays
310 -- * the following is to desugar cases over fake constructors for
311 -- parallel arrays, which are introduced by `tidy1' in the `PArrPat'
314 -- Concerning `isPArrFakeAlts':
316 -- * it is *not* sufficient to just check the type of the type
317 -- constructor, as we have to be careful not to confuse the real
318 -- representation of parallel arrays with the fake constructors;
319 -- moreover, a list of alternatives must not mix fake and real
320 -- constructors (this is checked earlier on)
322 -- FIXME: We actually go through the whole list and make sure that
323 -- either all or none of the constructors are fake parallel
324 -- array constructors. This is to spot equations that mix fake
325 -- constructors with the real representation defined in
326 -- `PrelPArr'. It would be nicer to spot this situation
327 -- earlier and raise a proper error message, but it can really
328 -- only happen in `PrelPArr' anyway.
330 isPArrFakeAlts [(dcon, _, _)] = isPArrFakeCon dcon
331 isPArrFakeAlts ((dcon, _, _):alts) =
332 case (isPArrFakeCon dcon, isPArrFakeAlts alts) of
333 (True , True ) -> True
334 (False, False) -> False
336 panic "DsUtils: You may not mix `[:...:]' with `PArr' patterns"
339 dsLookupGlobalId lengthPName `thenDs` \lengthP ->
340 unboxAlt `thenDs` \alt ->
341 returnDs (Case (len lengthP) (mkWildId intTy) [alt])
343 elemTy = case splitTyConApp (idType var) of
344 (_, [elemTy]) -> elemTy
346 panicMsg = "DsUtils.mkCoAlgCaseMatchResult: not a parallel array?"
347 len lengthP = mkApps (Var lengthP) [Type elemTy, Var var]
350 newSysLocalDs intPrimTy `thenDs` \l ->
351 dsLookupGlobalId indexPName `thenDs` \indexP ->
352 mapDs (mkAlt indexP) match_alts `thenDs` \alts ->
353 returnDs (DataAlt intDataCon, [l], (Case (Var l) wild (dft : alts)))
355 wild = mkWildId intPrimTy
356 dft = (DEFAULT, [], fail)
358 -- each alternative matches one array length (corresponding to one
359 -- fake array constructor), so the match is on a literal; each
360 -- alternative's body is extended by a local binding for each
361 -- constructor argument, which are bound to array elements starting
364 mkAlt indexP (con, args, MatchResult _ bodyFun) =
365 bodyFun fail `thenDs` \body ->
366 returnDs (LitAlt lit, [], mkDsLets binds body)
368 lit = MachInt $ toInteger (dataConSourceArity con)
369 binds = [NonRec arg (indexExpr i) | (i, arg) <- zip [1..] args]
371 indexExpr i = mkApps (Var indexP) [Type elemTy, Var var, mkIntExpr i]
375 %************************************************************************
377 \subsection{Desugarer's versions of some Core functions}
379 %************************************************************************
382 mkErrorAppDs :: Id -- The error function
383 -> Type -- Type to which it should be applied
384 -> String -- The error message string to pass
387 mkErrorAppDs err_id ty msg
388 = getSrcLocDs `thenDs` \ src_loc ->
390 full_msg = showSDoc (hcat [ppr src_loc, text "|", text msg])
391 core_msg = Lit (MachStr (mkFastString (stringToUtf8 full_msg)))
393 returnDs (mkApps (Var err_id) [Type ty, core_msg])
397 *************************************************************
399 \subsection{Making literals}
401 %************************************************************************
404 mkCharExpr :: Int -> CoreExpr -- Returns C# c :: Int
405 mkIntExpr :: Integer -> CoreExpr -- Returns I# i :: Int
406 mkIntegerExpr :: Integer -> DsM CoreExpr -- Result :: Integer
407 mkStringLit :: String -> DsM CoreExpr -- Result :: String
408 mkStringLitFS :: FastString -> DsM CoreExpr -- Result :: String
410 mkIntExpr i = mkConApp intDataCon [mkIntLit i]
411 mkCharExpr c = mkConApp charDataCon [mkLit (MachChar c)]
414 | inIntRange i -- Small enough, so start from an Int
415 = returnDs (mkSmallIntegerLit i)
417 -- Special case for integral literals with a large magnitude:
418 -- They are transformed into an expression involving only smaller
419 -- integral literals. This improves constant folding.
421 | otherwise -- Big, so start from a string
422 = dsLookupGlobalId plusIntegerName `thenDs` \ plus_id ->
423 dsLookupGlobalId timesIntegerName `thenDs` \ times_id ->
425 plus a b = Var plus_id `App` a `App` b
426 times a b = Var times_id `App` a `App` b
428 -- Transform i into (x1 + (x2 + (x3 + (...) * b) * b) * b) with abs xi <= b
429 horner :: Integer -> Integer -> CoreExpr
430 horner b i | abs q <= 1 = if r == 0 || r == i
431 then mkSmallIntegerLit i
432 else mkSmallIntegerLit r `plus` mkSmallIntegerLit (i-r)
433 | r == 0 = horner b q `times` mkSmallIntegerLit b
434 | otherwise = mkSmallIntegerLit r `plus` (horner b q `times` mkSmallIntegerLit b)
436 (q,r) = i `quotRem` b
439 returnDs (horner tARGET_MAX_INT i)
441 mkSmallIntegerLit i = mkConApp smallIntegerDataCon [mkIntLit i]
443 mkStringLit str = mkStringLitFS (mkFastString str)
447 = returnDs (mkNilExpr charTy)
451 the_char = mkCharExpr (headIntFS str)
453 returnDs (mkConsExpr charTy the_char (mkNilExpr charTy))
455 | all safeChar int_chars
456 = dsLookupGlobalId unpackCStringName `thenDs` \ unpack_id ->
457 returnDs (App (Var unpack_id) (Lit (MachStr str)))
460 = dsLookupGlobalId unpackCStringUtf8Name `thenDs` \ unpack_id ->
461 returnDs (App (Var unpack_id) (Lit (MachStr (mkFastString (intsToUtf8 int_chars)))))
464 int_chars = unpackIntFS str
465 safeChar c = c >= 1 && c <= 0xFF
469 %************************************************************************
471 \subsection[mkSelectorBind]{Make a selector bind}
473 %************************************************************************
475 This is used in various places to do with lazy patterns.
476 For each binder $b$ in the pattern, we create a binding:
478 b = case v of pat' -> b'
480 where @pat'@ is @pat@ with each binder @b@ cloned into @b'@.
482 ToDo: making these bindings should really depend on whether there's
483 much work to be done per binding. If the pattern is complex, it
484 should be de-mangled once, into a tuple (and then selected from).
485 Otherwise the demangling can be in-line in the bindings (as here).
487 Boring! Boring! One error message per binder. The above ToDo is
488 even more helpful. Something very similar happens for pattern-bound
492 mkSelectorBinds :: TypecheckedPat -- The pattern
493 -> CoreExpr -- Expression to which the pattern is bound
494 -> DsM [(Id,CoreExpr)]
496 mkSelectorBinds (VarPat v) val_expr
497 = returnDs [(v, val_expr)]
499 mkSelectorBinds pat val_expr
500 | isSingleton binders || is_simple_pat pat
501 = -- Given p = e, where p binds x,y
502 -- we are going to make
503 -- v = p (where v is fresh)
504 -- x = case v of p -> x
505 -- y = case v of p -> x
508 -- NB: give it the type of *pattern* p, not the type of the *rhs* e.
509 -- This does not matter after desugaring, but there's a subtle
510 -- issue with implicit parameters. Consider
512 -- Then, ?i is given type {?i :: Int}, a SourceType, which is opaque
513 -- to the desugarer. (Why opaque? Because newtypes have to be. Why
514 -- does it get that type? So that when we abstract over it we get the
515 -- right top-level type (?i::Int) => ...)
517 -- So to get the type of 'v', use the pattern not the rhs. Often more
519 newSysLocalDs (hsPatType pat) `thenDs` \ val_var ->
521 -- For the error message we make one error-app, to avoid duplication.
522 -- But we need it at different types... so we use coerce for that
523 mkErrorAppDs iRREFUT_PAT_ERROR_ID
524 unitTy (showSDoc (ppr pat)) `thenDs` \ err_expr ->
525 newSysLocalDs unitTy `thenDs` \ err_var ->
526 mapDs (mk_bind val_var err_var) binders `thenDs` \ binds ->
527 returnDs ( (val_var, val_expr) :
528 (err_var, err_expr) :
533 = mkErrorAppDs iRREFUT_PAT_ERROR_ID
534 tuple_ty (showSDoc (ppr pat)) `thenDs` \ error_expr ->
535 matchSimply val_expr PatBindRhs pat local_tuple error_expr `thenDs` \ tuple_expr ->
536 newSysLocalDs tuple_ty `thenDs` \ tuple_var ->
539 = (binder, mkTupleSelector binders binder tuple_var (Var tuple_var))
541 returnDs ( (tuple_var, tuple_expr) : map mk_tup_bind binders )
543 binders = collectPatBinders pat
544 local_tuple = mkTupleExpr binders
545 tuple_ty = exprType local_tuple
547 mk_bind scrut_var err_var bndr_var
548 -- (mk_bind sv err_var) generates
549 -- bv = case sv of { pat -> bv; other -> coerce (type-of-bv) err_var }
550 -- Remember, pat binds bv
551 = matchSimply (Var scrut_var) PatBindRhs pat
552 (Var bndr_var) error_expr `thenDs` \ rhs_expr ->
553 returnDs (bndr_var, rhs_expr)
555 error_expr = mkCoerce (idType bndr_var) (Var err_var)
557 is_simple_pat (TuplePat ps Boxed) = all is_triv_pat ps
558 is_simple_pat (ConPatOut _ ps _ _ _) = all is_triv_pat (hsConArgs ps)
559 is_simple_pat (VarPat _) = True
560 is_simple_pat (ParPat p) = is_simple_pat p
561 is_simple_pat other = False
563 is_triv_pat (VarPat v) = True
564 is_triv_pat (WildPat _) = True
565 is_triv_pat (ParPat p) = is_triv_pat p
566 is_triv_pat other = False
570 @mkTupleExpr@ builds a tuple; the inverse to @mkTupleSelector@. If it
571 has only one element, it is the identity function.
574 mkTupleExpr :: [Id] -> CoreExpr
576 {- This code has been replaced by mkCoreTup below
577 mkTupleExpr [] = Var unitDataConId
578 mkTupleExpr [id] = Var id
579 mkTupleExpr ids = mkConApp (tupleCon Boxed (length ids))
580 (map (Type . idType) ids ++ [ Var i | i <-ids])
583 mkTupleExpr ids = mkCoreTup(map Var ids)
585 mkCoreTup :: [CoreExpr] -> CoreExpr
586 mkCoreTup [] = Var unitDataConId
588 mkCoreTup cs = mkConApp (tupleCon Boxed (length cs))
589 (map (Type . exprType) cs ++ cs)
594 @mkTupleSelector@ builds a selector which scrutises the given
595 expression and extracts the one name from the list given.
596 If you want the no-shadowing rule to apply, the caller
597 is responsible for making sure that none of these names
600 If there is just one id in the ``tuple'', then the selector is
604 mkTupleSelector :: [Id] -- The tuple args
605 -> Id -- The selected one
606 -> Id -- A variable of the same type as the scrutinee
607 -> CoreExpr -- Scrutinee
610 mkTupleSelector [var] should_be_the_same_var scrut_var scrut
611 = ASSERT(var == should_be_the_same_var)
614 mkTupleSelector vars the_var scrut_var scrut
615 = ASSERT( notNull vars )
616 Case scrut scrut_var [(DataAlt (tupleCon Boxed (length vars)), vars, Var the_var)]
620 %************************************************************************
622 \subsection[mkFailurePair]{Code for pattern-matching and other failures}
624 %************************************************************************
626 Call the constructor Ids when building explicit lists, so that they
627 interact well with rules.
630 mkNilExpr :: Type -> CoreExpr
631 mkNilExpr ty = mkConApp nilDataCon [Type ty]
633 mkConsExpr :: Type -> CoreExpr -> CoreExpr -> CoreExpr
634 mkConsExpr ty hd tl = mkConApp consDataCon [Type ty, hd, tl]
636 mkListExpr :: Type -> [CoreExpr] -> CoreExpr
637 mkListExpr ty xs = foldr (mkConsExpr ty) (mkNilExpr ty) xs
642 %************************************************************************
644 \subsection[mkFailurePair]{Code for pattern-matching and other failures}
646 %************************************************************************
648 Generally, we handle pattern matching failure like this: let-bind a
649 fail-variable, and use that variable if the thing fails:
651 let fail.33 = error "Help"
662 If the case can't fail, then there'll be no mention of @fail.33@, and the
663 simplifier will later discard it.
666 If it can fail in only one way, then the simplifier will inline it.
669 Only if it is used more than once will the let-binding remain.
672 There's a problem when the result of the case expression is of
673 unboxed type. Then the type of @fail.33@ is unboxed too, and
674 there is every chance that someone will change the let into a case:
680 which is of course utterly wrong. Rather than drop the condition that
681 only boxed types can be let-bound, we just turn the fail into a function
682 for the primitive case:
684 let fail.33 :: Void -> Int#
685 fail.33 = \_ -> error "Help"
694 Now @fail.33@ is a function, so it can be let-bound.
697 mkFailurePair :: CoreExpr -- Result type of the whole case expression
698 -> DsM (CoreBind, -- Binds the newly-created fail variable
699 -- to either the expression or \ _ -> expression
700 CoreExpr) -- Either the fail variable, or fail variable
701 -- applied to unit tuple
704 = newFailLocalDs (unitTy `mkFunTy` ty) `thenDs` \ fail_fun_var ->
705 newSysLocalDs unitTy `thenDs` \ fail_fun_arg ->
706 returnDs (NonRec fail_fun_var (Lam fail_fun_arg expr),
707 App (Var fail_fun_var) (Var unitDataConId))
710 = newFailLocalDs ty `thenDs` \ fail_var ->
711 returnDs (NonRec fail_var expr, Var fail_var)