Result type signatures are no longer supported (partial)

[ghc-hetmet.git] / compiler / typecheck / TcUnify.lhs

diff --git a/compiler/typecheck/TcUnify.lhs b/compiler/typecheck/TcUnify.lhs
index e8fb134..bb97f8d 100644 (file)
--- a/compiler/typecheck/TcUnify.lhs
+++ b/compiler/typecheck/TcUnify.lhs
@@ -48,9 +48,9 @@ import TcType         ( TcKind, TcType, TcTyVar, BoxyTyVar, TcTauType,
                          tcSplitForAllTys, tcSplitAppTy_maybe, tcSplitFunTys, mkTyVarTys,
                          tcSplitSigmaTy, tyVarsOfType, mkPhiTy, mkTyVarTy, mkPredTy, 
                          typeKind, mkForAllTys, mkAppTy, isBoxyTyVar,
-                         exactTyVarsOfType, 
+                         tcView, exactTyVarsOfType, 
                          tidyOpenType, tidyOpenTyVar, tidyOpenTyVars,
-                         pprType, tidyKind, tidySkolemTyVar, isSkolemTyVar, tcView, 
+                         pprType, tidyKind, tidySkolemTyVar, isSkolemTyVar, isSigTyVar,
                          TvSubst, mkTvSubst, zipTyEnv, zipOpenTvSubst, emptyTvSubst, 
                          substTy, substTheta, 
                          lookupTyVar, extendTvSubst )
@@ -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
@@ -1501,8 +1506,8 @@ ppr_ty env ty
             simple_result  = (env1, quotes (ppr tidy_ty), empty)
        ; case tidy_ty of
           TyVarTy tv 
-               | isSkolemTyVar tv -> return (env2, pp_rigid tv',
-                                             pprSkolTvBinding tv')
+               | isSkolemTyVar tv || isSigTyVar tv
+               -> return (env2, pp_rigid tv', pprSkolTvBinding tv')
                | otherwise -> return simple_result
                where
                  (env2, tv') = tidySkolemTyVar env1 tv
@@ -1515,7 +1520,7 @@ notMonoType ty
   = do { ty' <- zonkTcType ty
        ; env0 <- tcInitTidyEnv
        ; let (env1, tidy_ty) = tidyOpenType env0 ty'
-             msg = ptext SLIT("Cannot match a monotype with") <+> ppr tidy_ty
+             msg = ptext SLIT("Cannot match a monotype with") <+> quotes (ppr tidy_ty)
        ; failWithTcM (env1, msg) }
 
 occurCheck tyvar ty