diff options
Diffstat (limited to 'compiler/deSugar/DsUtils.hs')
| -rw-r--r-- | compiler/deSugar/DsUtils.hs | 29 |
1 files changed, 29 insertions, 0 deletions
diff --git a/compiler/deSugar/DsUtils.hs b/compiler/deSugar/DsUtils.hs index 8559e9ae85..52444c13f7 100644 --- a/compiler/deSugar/DsUtils.hs +++ b/compiler/deSugar/DsUtils.hs @@ -37,6 +37,8 @@ module DsUtils ( mkSelectorBinds, + mkPrefixConPat, mkCharLitPat, mkNilPat, + selectSimpleMatchVarL, selectMatchVars, selectMatchVar, mkOptTickBox, mkBinaryTickBox, decideBangHood, addBang, isTrueLHsExpr @@ -777,6 +779,33 @@ mkBigLHsPatTupId = mkChunkified mkLHsPatTup {- ************************************************************************ * * +* Building patterns +* * +************************************************************************ +-} + +mkPrefixConPat :: DataCon -> + [OutPat (GhcPass p)] -> [Type] -> OutPat (GhcPass p) +-- Make a vanilla Prefix constructor pattern +mkPrefixConPat dc pats tys + = noLoc $ ConPatOut { pat_con = noLoc (RealDataCon dc) + , pat_tvs = [] + , pat_dicts = [] + , pat_binds = emptyTcEvBinds + , pat_args = PrefixCon pats + , pat_arg_tys = tys + , pat_wrap = idHsWrapper } + +mkNilPat :: Type -> OutPat (GhcPass p) +mkNilPat ty = mkPrefixConPat nilDataCon [] [ty] + +mkCharLitPat :: SourceText -> Char -> OutPat (GhcPass p) +mkCharLitPat src c = mkPrefixConPat charDataCon + [noLoc $ LitPat noExtField (HsCharPrim src c)] [] + +{- +************************************************************************ +* * Code for pattern-matching and other failures * * ************************************************************************ |