X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FDsUtils.lhs;h=3f340911e70336da6365ce9b400c83084b1f71ea;hb=fe3321f99f4d9c9ff40429a7ac290f8ef7ca3297;hp=62284dbf0ce9f786ebf7b83e6e03d45dc562df05;hpb=367b0590cc0d8ba3d1561c85b366a183b8a71d24;p=ghc-hetmet.git diff --git a/compiler/deSugar/DsUtils.lhs b/compiler/deSugar/DsUtils.lhs index 62284db..3f34091 100644 --- a/compiler/deSugar/DsUtils.lhs +++ b/compiler/deSugar/DsUtils.lhs @@ -242,7 +242,7 @@ worthy of a type synonym and a few handy functions. \begin{code} firstPat :: EquationInfo -> Pat Id -firstPat eqn = head (eqn_pats eqn) +firstPat eqn = ASSERT( notNull (eqn_pats eqn) ) head (eqn_pats eqn) shiftEqns :: [EquationInfo] -> [EquationInfo] -- Drop the first pattern in each equation @@ -357,8 +357,8 @@ mkCoAlgCaseMatchResult var ty match_alts -- the scrutinised Id to be sufficiently refined to have a TyCon in it] -- Stuff for newtype - (con1, arg_ids1, match_result1) = head match_alts - arg_id1 = head arg_ids1 + (con1, arg_ids1, match_result1) = ASSERT( notNull match_alts ) head match_alts + arg_id1 = ASSERT( notNull arg_ids1 ) head arg_ids1 var_ty = idType var (tc, ty_args) = splitNewTyConApp var_ty newtype_rhs = unwrapNewTypeBody tc ty_args (Var var) @@ -647,7 +647,7 @@ mkSelectorBinds pat val_expr is_simple_lpat p = is_simple_pat (unLoc p) is_simple_pat (TuplePat ps Boxed _) = all is_triv_lpat ps - is_simple_pat (ConPatOut{ pat_args = ps }) = all is_triv_lpat (hsConArgs ps) + is_simple_pat (ConPatOut{ pat_args = ps }) = all is_triv_lpat (hsConPatArgs ps) is_simple_pat (VarPat _) = True is_simple_pat (ParPat p) = is_simple_lpat p is_simple_pat other = False @@ -948,7 +948,7 @@ mkTickBox ix vars e = do | otherwise = mkBreakPointOpId uq mod ix uq2 <- newUnique let occName = mkVarOcc "tick" - let name = mkInternalName uq2 occName noSrcLoc -- use mkSysLocal? + let name = mkInternalName uq2 occName noSrcSpan -- use mkSysLocal? let var = Id.mkLocalId name realWorldStatePrimTy scrut <- if opt_Hpc