Commit d16986ac authored by simonpj@microsoft.com's avatar simonpj@microsoft.com

Pattern-match warning police

parent b8c98e4e
......@@ -700,9 +700,9 @@ tcSplitFunTysN ty n_args
| otherwise
= ([], ty)
tcFunArgTy ty = case tcSplitFunTy_maybe ty of { Just (arg,res) -> arg }
tcFunResultTy ty = case tcSplitFunTy_maybe ty of { Just (arg,res) -> res }
tcSplitFunTy ty = expectJust "tcSplitFunTy" (tcSplitFunTy_maybe ty)
tcFunArgTy ty = fst (tcSplitFunTy ty)
tcFunResultTy ty = snd (tcSplitFunTy ty)
-----------------------
tcSplitAppTy_maybe :: Type -> Maybe (Type, Type)
......@@ -750,6 +750,7 @@ tcSplitDFunHead :: Type -> (Class, [Type])
tcSplitDFunHead tau
= case tcSplitPredTy_maybe tau of
Just (ClassP clas tys) -> (clas, tys)
other -> panic "tcSplitDFunHead"
tcValidInstHeadTy :: Type -> Bool
-- Used in Haskell-98 mode, for the argument types of an instance head
......@@ -816,6 +817,7 @@ getClassPredTys_maybe _ = Nothing
getClassPredTys :: PredType -> (Class, [Type])
getClassPredTys (ClassP clas tys) = (clas, tys)
getClassPredTys other = panic "getClassPredTys"
mkDictTy :: Class -> [Type] -> Type
mkDictTy clas tys = mkPredTy (ClassP clas tys)
......@@ -869,6 +871,7 @@ dataConsStupidTheta (con1:cons)
| con <- cons
, let Just subst = tcMatchTys tvs1 res_tys1 (dataConResTys con)
, pred <- dataConStupidTheta con ]
dataConsStupidTheta [] = panic "dataConsStupidTheta"
\end{code}
......@@ -1117,12 +1120,14 @@ toDNType :: Type -> DNType
toDNType ty
| isStringTy ty = DNString
| isFFIDotnetObjTy ty = DNObject
| Just (tc,argTys) <- tcSplitTyConApp_maybe ty =
case lookup (getUnique tc) dn_assoc of
| Just (tc,argTys) <- tcSplitTyConApp_maybe ty
= case lookup (getUnique tc) dn_assoc of
Just x -> x
Nothing
| tc `hasKey` ioTyConKey -> toDNType (head argTys)
| otherwise -> pprPanic ("toDNType: unsupported .NET type") (pprType ty <+> parens (hcat (map pprType argTys)) <+> ppr tc)
| otherwise -> pprPanic ("toDNType: unsupported .NET type")
(pprType ty <+> parens (hcat (map pprType argTys)) <+> ppr tc)
| otherwise = panic "toDNType" -- Is this right?
where
dn_assoc :: [ (Unique, DNType) ]
dn_assoc = [ (unitTyConKey, DNUnit)
......
......@@ -180,6 +180,7 @@ subFunTys error_herald n_pats res_ty thing_inside
; return (idCoercion, res) } }
where
mk_res_ty (res_ty' : arg_tys') = mkFunTys arg_tys' res_ty'
mk_res_ty [] = panic "TcUnify.mk_res_ty1"
kinds = openTypeKind : take n (repeat argTypeKind)
-- Note argTypeKind: the args can have an unboxed type,
-- but not an unboxed tuple.
......@@ -268,6 +269,7 @@ boxySplitAppTy orig_ty
; return (fun_ty, arg_ty) } }
where
mk_res_ty [fun_ty', arg_ty'] = mkAppTy fun_ty' arg_ty'
mk_res_ty other = panic "TcUnify.mk_res_ty2"
tv_kind = tyVarKind tv
kinds = [mkArrowKind liftedTypeKind (defaultKind tv_kind),
-- m :: * -> k
......@@ -460,6 +462,8 @@ boxy_match_s tmpl_tvs [] boxy_tvs [] subst
boxy_match_s tmpl_tvs (t_ty:t_tys) boxy_tvs (b_ty:b_tys) subst
= boxy_match tmpl_tvs t_ty boxy_tvs b_ty $
boxy_match_s tmpl_tvs t_tys boxy_tvs b_tys subst
boxy_match_s tmpl_tvs _ boxy_tvs _ subst
= panic "boxy_match_s" -- Lengths do not match
------------
......@@ -689,6 +693,7 @@ tc_sub outer act_sty act_ty@(FunTy act_arg act_res) exp_sty (TyVarTy exp_tv)
; tc_sub_funs act_arg act_res arg_ty res_ty } }
where
mk_res_ty [arg_ty', res_ty'] = mkFunTy arg_ty' res_ty'
mk_res_ty other = panic "TcUnify.mk_res_ty3"
fun_kinds = [argTypeKind, openTypeKind]
-- Everything else: defer to boxy matching
......
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