Commit 4ae1e172 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com
Browse files

Add more assertions

parent 55710e16
......@@ -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
......
......@@ -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
......
......@@ -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)
......
......@@ -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) }
......
......@@ -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
......
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