Commit 1b1e5a46 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com
Browse files

Add HsUtils.unguardedGRHSs, and use it

parent a515009d
...@@ -28,7 +28,6 @@ import RdrName ...@@ -28,7 +28,6 @@ import RdrName
import Var import Var
import Type import Type
import DataCon import DataCon
import OccName
import Name import Name
import BasicTypes import BasicTypes
import SrcLoc import SrcLoc
...@@ -53,16 +52,18 @@ just attach noSrcSpan to everything. ...@@ -53,16 +52,18 @@ just attach noSrcSpan to everything.
mkHsPar :: LHsExpr id -> LHsExpr id mkHsPar :: LHsExpr id -> LHsExpr id
mkHsPar e = L (getLoc e) (HsPar e) mkHsPar e = L (getLoc e) (HsPar e)
-- gaw 2004
mkSimpleMatch :: [LPat id] -> LHsExpr id -> LMatch id mkSimpleMatch :: [LPat id] -> LHsExpr id -> LMatch id
mkSimpleMatch pats rhs mkSimpleMatch pats rhs
= L loc $ = L loc $
Match pats Nothing (GRHSs (unguardedRHS rhs) emptyLocalBinds) Match pats Nothing (unguardedGRHSs rhs)
where where
loc = case pats of loc = case pats of
[] -> getLoc rhs [] -> getLoc rhs
(pat:_) -> combineSrcSpans (getLoc pat) (getLoc rhs) (pat:_) -> combineSrcSpans (getLoc pat) (getLoc rhs)
unguardedGRHSs :: LHsExpr id -> GRHSs id
unguardedGRHSs rhs = GRHSs (unguardedRHS rhs) emptyLocalBinds
unguardedRHS :: LHsExpr id -> [LGRHS id] unguardedRHS :: LHsExpr id -> [LGRHS id]
unguardedRHS rhs@(L loc _) = [L loc (GRHS [] rhs)] unguardedRHS rhs@(L loc _) = [L loc (GRHS [] rhs)]
......
...@@ -1186,8 +1186,8 @@ exp10 :: { LHsExpr RdrName } ...@@ -1186,8 +1186,8 @@ exp10 :: { LHsExpr RdrName }
: '\\' aexp aexps opt_asig '->' exp : '\\' aexp aexps opt_asig '->' exp
{% checkPatterns ($2 : reverse $3) >>= \ ps -> {% checkPatterns ($2 : reverse $3) >>= \ ps ->
return (LL $ HsLam (mkMatchGroup [LL $ Match ps $4 return (LL $ HsLam (mkMatchGroup [LL $ Match ps $4
(GRHSs (unguardedRHS $6) emptyLocalBinds (unguardedGRHSs $6)
)])) } ])) }
| 'let' binds 'in' exp { LL $ HsLet (unLoc $2) $4 } | 'let' binds 'in' exp { LL $ HsLet (unLoc $2) $4 }
| 'if' exp 'then' exp 'else' exp { LL $ HsIf $2 $4 $6 } | 'if' exp 'then' exp 'else' exp { LL $ HsIf $2 $4 $6 }
| 'case' exp 'of' altslist { LL $ HsCase $2 (mkMatchGroup (unLoc $4)) } | 'case' exp 'of' altslist { LL $ HsCase $2 (mkMatchGroup (unLoc $4)) }
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment