2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1994
4 \section[DsGRHSs]{Matching guarded right-hand-sides (GRHSs)}
7 #include "HsVersions.h"
9 module DsGRHSs ( dsGuarded, dsGRHSs ) where
12 import DsLoop -- break dsExpr/dsBinds-ish loop
14 import HsSyn ( GRHSsAndBinds(..), GRHS(..),
16 import TcHsSyn ( TypecheckedGRHSsAndBinds(..), TypecheckedGRHS(..),
17 TypecheckedPat(..), TypecheckedHsBinds(..),
18 TypecheckedHsExpr(..) )
19 import CoreSyn ( CoreBinding(..), CoreExpr(..) )
24 import CoreUtils ( escErrorMsg, mkErrorApp )
25 import PrelInfo ( stringTy )
26 import PprStyle ( PprStyle(..) )
27 import Pretty ( ppShow )
28 import SrcLoc ( SrcLoc{-instance-} )
31 mkCoLetsAny = panic "DsGRHSs.mkCoLetsAny"
32 mkCoreIfThenElse = panic "DsGRHSs.mkCoreIfThenElse"
35 @dsGuarded@ is used for both @case@ expressions and pattern bindings.
43 producing an expression with a runtime error in the corner if
44 necessary. The type argument gives the type of the ei.
47 dsGuarded :: TypecheckedGRHSsAndBinds
51 dsGuarded (GRHSsAndBindsOut grhss binds err_ty) err_loc
52 = dsBinds binds `thenDs` \ core_binds ->
53 dsGRHSs err_ty PatBindMatch [] grhss `thenDs` \ (MatchResult can_it_fail _ core_grhss_fn _) ->
55 CantFail -> returnDs (mkCoLetsAny core_binds (core_grhss_fn (panic "It can't fail")))
56 CanFail -> newSysLocalDs stringTy `thenDs` \ str_var -> -- to hold the String
57 returnDs (mkCoLetsAny core_binds (core_grhss_fn (error_expr str_var)))
59 unencoded_part_of_msg = escErrorMsg (ppShow 80 (ppr PprForUser err_loc))
61 error_expr :: Id -> CoreExpr
62 error_expr str_var = mkErrorApp err_ty str_var
63 (unencoded_part_of_msg
64 ++ "%N") --> ": non-exhaustive guards"
67 Desugar a list of (grhs, expr) pairs [grhs = guarded
68 right-hand-side], as in:
75 We supply a @CoreExpr@ for the case in which all of
79 dsGRHSs :: Type -- Type of RHSs
80 -> DsMatchKind -> [TypecheckedPat] -- These are to build a MatchContext from
81 -> [TypecheckedGRHS] -- Guarded RHSs
84 dsGRHSs ty kind pats [grhs] = dsGRHS ty kind pats grhs
86 dsGRHSs ty kind pats (grhs:grhss)
87 = dsGRHS ty kind pats grhs `thenDs` \ match_result1 ->
88 dsGRHSs ty kind pats grhss `thenDs` \ match_result2 ->
89 combineGRHSMatchResults match_result1 match_result2
91 dsGRHS ty kind pats (OtherwiseGRHS expr locn)
93 dsExpr expr `thenDs` \ core_expr ->
95 expr_fn = \ ignore -> core_expr
97 returnDs (MatchResult CantFail ty expr_fn (DsMatchContext kind pats locn))
100 dsGRHS ty kind pats (GRHS guard expr locn)
102 dsExpr guard `thenDs` \ core_guard ->
103 dsExpr expr `thenDs` \ core_expr ->
105 expr_fn = \ fail -> mkCoreIfThenElse core_guard core_expr fail
107 returnDs (MatchResult CanFail ty expr_fn (DsMatchContext kind pats locn))