fix bugs, add boolean flag to identify coercion variables

[ghc-hetmet.git] / compiler / coreSyn / CoreLint.lhs

diff --git a/compiler/coreSyn/CoreLint.lhs b/compiler/coreSyn/CoreLint.lhs
index 788c4b4..2d5a4fd 100644 (file)
--- a/compiler/coreSyn/CoreLint.lhs
+++ b/compiler/coreSyn/CoreLint.lhs
@@ -396,12 +396,13 @@ lintCoreArg fun_ty a@(Type arg_ty) =
 lintCoreArg fun_ty arg = 
        -- Make sure function type matches argument
   do { arg_ty <- lintCoreExpr arg
-     ; let err = mkAppMsg fun_ty arg_ty arg
+     ; let err1 =  mkAppMsg fun_ty arg_ty arg
+           err2 = mkNonFunAppMsg fun_ty arg_ty arg
      ; case splitFunTy_maybe fun_ty of
         Just (arg,res) -> 
-          do { checkTys arg arg_ty err 
+          do { checkTys arg arg_ty err1
              ; return res }
-        _ -> addErrL err }
+        _ -> addErrL err2 }
 \end{code}
 
 \begin{code}
@@ -819,6 +820,13 @@ mkAppMsg fun_ty arg_ty arg
              hang (ptext SLIT("Arg type:")) 4 (ppr arg_ty),
              hang (ptext SLIT("Arg:")) 4 (ppr arg)]
 
+mkNonFunAppMsg :: Type -> Type -> CoreExpr -> Message
+mkNonFunAppMsg fun_ty arg_ty arg
+  = vcat [ptext SLIT("Non-function type in function position"),
+             hang (ptext SLIT("Fun type:")) 4 (ppr fun_ty),
+             hang (ptext SLIT("Arg type:")) 4 (ppr arg_ty),
+             hang (ptext SLIT("Arg:")) 4 (ppr arg)]
+
 mkKindErrMsg :: TyVar -> Type -> Message
 mkKindErrMsg tyvar arg_ty
   = vcat [ptext SLIT("Kinds don't match in type application:"),