Add more assertions

diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs
index bcfd33d..403d309 100644 (file)
--- a/compiler/basicTypes/MkId.lhs
+++ b/compiler/basicTypes/MkId.lhs
@@ -279,7 +279,7 @@ mkDataConIds wrap_name wkr_name data_con
                   wrapNewTypeBody tycon res_ty_args
                        (Var id_arg1)
 
-    id_arg1 = mkTemplateLocal 1 (head orig_arg_tys)
+    id_arg1 = ASSERT( not (null orig_arg_tys) ) mkTemplateLocal 1 (head orig_arg_tys)
 
        ----------- Wrapper --------------
        -- We used to include the stupid theta in the wrapper's args
@@ -492,7 +492,7 @@ mkRecordSelId tycon field_label
     data_cons_w_field = filter has_field data_cons     -- Can't be empty!
     has_field con     = field_label `elem` dataConFieldLabels con
 
-    con1       = head data_cons_w_field
+    con1       = ASSERT( not (null data_cons_w_field) ) head data_cons_w_field
     (univ_tvs, _, eq_spec, _, _, data_ty) = dataConFullSig con1
        -- For a data type family, the data_ty (and hence selector_ty) mentions
        -- only the family TyCon, not the instance TyCon

diff --git a/compiler/deSugar/Check.lhs b/compiler/deSugar/Check.lhs
index 359035f..a81123e 100644 (file)
--- a/compiler/deSugar/Check.lhs
+++ b/compiler/deSugar/Check.lhs
@@ -249,7 +249,7 @@ must be one Variable to be complete.
 
 process_literals :: [HsLit] -> [(EqnNo, EquationInfo)] -> ([ExhaustivePat],EqnSet)
 process_literals used_lits qs 
-  | null default_eqns  = ([make_row_vars used_lits (head qs)] ++ pats,indexs)
+  | null default_eqns  = ASSERT( not (null qs) ) ([make_row_vars used_lits (head qs)] ++ pats,indexs)
   | otherwise          = (pats_default,indexs_default)
      where
        (pats,indexs)   = process_explicit_literals used_lits qs
@@ -331,7 +331,7 @@ need_default_case used_cons unused_cons qs
        (pats',indexs') = check' default_eqns 
        pats_default    = [(make_whole_con c:ps,constraints) | 
                           c <- unused_cons, (ps,constraints) <- pats'] ++ pats
-       new_wilds       = make_row_vars_for_constructor (head qs)
+       new_wilds       = ASSERT( not (null qs) ) make_row_vars_for_constructor (head qs)
        pats_default_no_eqns =  [(make_whole_con c:new_wilds,[]) | c <- unused_cons] ++ pats
        indexs_default  = unionUniqSets indexs' indexs
 
@@ -432,7 +432,7 @@ mb_neg Nothing  v = v
 mb_neg (Just _) v = -v
 
 get_unused_cons :: [Pat Id] -> [DataCon]
-get_unused_cons used_cons = unused_cons
+get_unused_cons used_cons = ASSERT( not (null used_cons) ) unused_cons
      where
        (ConPatOut { pat_con = l_con, pat_ty = ty }) = head used_cons
        ty_con         = dataConTyCon (unLoc l_con)     -- Newtype observable

diff --git a/compiler/deSugar/DsUtils.lhs b/compiler/deSugar/DsUtils.lhs
index 62284db..65448cb 100644 (file)
--- 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)

diff --git a/compiler/deSugar/Match.lhs b/compiler/deSugar/Match.lhs
index a31494e..9dc5d3a 100644 (file)
--- a/compiler/deSugar/Match.lhs
+++ b/compiler/deSugar/Match.lhs
@@ -610,7 +610,8 @@ JJQC 30-Nov-1997
 
 \begin{code}
 matchWrapper ctxt (MatchGroup matches match_ty)
-  = do { eqns_info   <- mapM mk_eqn_info matches
+  = ASSERT( notNull matches )
+    do { eqns_info   <- mapM mk_eqn_info matches
        ; new_vars    <- selectMatchVars arg_pats
        ; result_expr <- matchEquations ctxt new_vars eqns_info rhs_ty
        ; return (new_vars, result_expr) }

diff --git a/compiler/deSugar/MatchLit.lhs b/compiler/deSugar/MatchLit.lhs
index 2cdab30..e0a7601 100644 (file)
--- a/compiler/deSugar/MatchLit.lhs
+++ b/compiler/deSugar/MatchLit.lhs
@@ -183,7 +183,8 @@ matchLiterals :: [Id]
              -> DsM MatchResult
 
 matchLiterals (var:vars) ty sub_groups
-  = do {       -- Deal with each group
+  = ASSERT( all notNull sub_groups )
+    do {       -- Deal with each group
        ; alts <- mapM match_group sub_groups
 
                -- Combine results.  For everything except String