module DsUtils (
EquationInfo(..),
firstPat, shiftEqns,
-
+
mkDsLet, mkDsLets,
MatchResult(..), CanItFail(..),
mkSelectorBinds, mkTupleExpr, mkTupleSelector,
mkTupleType, mkTupleCase, mkBigCoreTup,
- mkCoreTup, mkCoreTupTy,
+ mkCoreTup, mkCoreTupTy, seqVar,
dsSyntaxTable, lookupEvidence,
- selectSimpleMatchVarL, selectMatchVars
+ selectSimpleMatchVarL, selectMatchVars, selectMatchVar
) where
#include "HsVersions.h"
lengthPName, indexPName )
import Outputable
import SrcLoc ( Located(..), unLoc )
-import Util ( isSingleton, notNull, zipEqual, sortWith )
+import Util ( isSingleton, zipEqual, sortWith )
import ListSetOps ( assocDefault )
import FastString
-
import Data.Char ( ord )
+
+#ifdef DEBUG
+import Util ( notNull ) -- Used in an assertion
+#endif
\end{code}
; vs <- selectMatchVars ps tys
; return (v:vs) }
+selectMatchVar (BangPat pat) pat_ty = selectMatchVar (unLoc pat) pat_ty
selectMatchVar (LazyPat pat) pat_ty = selectMatchVar (unLoc pat) pat_ty
selectMatchVar (VarPat var) pat_ty = try_for var pat_ty
selectMatchVar (AsPat var pat) pat_ty = try_for (unLoc var) pat_ty
| isTyVar new = App (Lam new body) (Type (mkTyVarTy old))
| otherwise = Let (NonRec new (Var old)) body
+seqVar :: Var -> CoreExpr -> CoreExpr
+seqVar var body = Case (Var var) var (exprType body)
+ [(DEFAULT, [], body)]
+
mkCoLetMatchResult :: CoreBind -> MatchResult -> MatchResult
mkCoLetMatchResult bind match_result
= adjustMatchResult (mkDsLet bind) match_result
is_simple_lpat p = is_simple_pat (unLoc p)
- is_simple_pat (TuplePat ps Boxed) = all is_triv_lpat ps
+ is_simple_pat (TuplePat ps Boxed _) = all is_triv_lpat ps
is_simple_pat (ConPatOut _ _ _ _ ps _) = all is_triv_lpat (hsConArgs ps)
is_simple_pat (VarPat _) = True
is_simple_pat (ParPat p) = is_simple_lpat p