Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Alex D
GHC
Commits
d16986ac
Commit
d16986ac
authored
Sep 06, 2006
by
simonpj@microsoft.com
Browse files
Pattern-match warning police
parent
b8c98e4e
Changes
2
Hide whitespace changes
Inline
Side-by-side
compiler/typecheck/TcType.lhs
View file @
d16986ac
...
...
@@ -700,9 +700,9 @@ tcSplitFunTysN ty n_args
| otherwise
= ([], ty)
tcFun
Arg
Ty
ty =
case tcSplitFunTy_maybe ty of { Just (arg,res) -> arg }
tcFun
ResultTy
ty =
case
tcSplitFunTy
_maybe ty of { Just (arg,res) -> res }
tc
Split
FunTy ty =
expectJust "tcSplitFunTy" (tcSplitFunTy_maybe ty)
tcFun
ArgTy
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)
...
...
compiler/typecheck/TcUnify.lhs
View file @
d16986ac
...
...
@@ -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
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment