From c829d0a14695af85d867d2739c77b70295744bc7 Mon Sep 17 00:00:00 2001
From: Alejandro Serrano <trupill@gmail.com>
Date: Fri, 1 Nov 2019 11:35:40 +0100
Subject: [PATCH] Fix warnings for validate
---
compiler/typecheck/Inst.hs | 7 +++++--
compiler/typecheck/TcExpr.hs | 11 +++++------
compiler/typecheck/TcUnify.hs | 2 ++
3 files changed, 12 insertions(+), 8 deletions(-)
diff --git a/compiler/typecheck/Inst.hs b/compiler/typecheck/Inst.hs
index 1a667bce59f..3b65622861e 100644
--- a/compiler/typecheck/Inst.hs
+++ b/compiler/typecheck/Inst.hs
@@ -38,7 +38,7 @@ import {-# SOURCE #-} TcExpr( tcPolyExpr, tcSyntaxOp )
import {-# SOURCE #-} TcUnify( unifyType, unifyKind )
import BasicTypes ( IntegralLit(..), SourceText(..) )
-import FastString
+-- import FastString
import GHC.Hs
import TcHsSyn
import TcRnMonad
@@ -142,6 +142,7 @@ ToDo: this eta-abstraction plays fast and loose with termination,
fix this
-}
+{-
deeplySkolemise :: TcSigmaType
-> TcM ( HsWrapper
, [(Name,TyVar)] -- All skolemised variables
@@ -173,6 +174,7 @@ deeplySkolemise ty
| otherwise
= return (idHsWrapper, [], [], substTy subst ty)
-- substTy is a quick no-op on an empty substitution
+-}
topSkolemise :: TcSigmaType
-> TcM ( HsWrapper
@@ -277,6 +279,7 @@ top_instantiate inst_all orig ty
| inst_all = True
| otherwise = binderArgFlag bndr == Inferred
+{-
deeplyInstantiate :: CtOrigin -> TcSigmaType -> TcM (HsWrapper, TcRhoType)
-- Int -> forall a. a -> a ==> (\x:Int. [] x alpha) :: Int -> alpha
-- In general if
@@ -329,7 +332,7 @@ deeply_instantiate orig subst ty
, text "new type:" <+> ppr ty'
, text "subst:" <+> ppr subst ])
; return (idHsWrapper, ty') }
-
+-}
instTyVarsWith :: CtOrigin -> [TyVar] -> [TcType] -> TcM TCvSubst
-- Use this when you want to instantiate (forall a b c. ty) with
diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs
index f0cd5d8df1d..ee31a2f921f 100644
--- a/compiler/typecheck/TcExpr.hs
+++ b/compiler/typecheck/TcExpr.hs
@@ -379,7 +379,7 @@ tcExpr expr@(OpApp fix arg1 op arg2) res_ty
; let doc = text "The first argument of ($) takes"
orig1 = lexprCtOrigin arg1
; (wrap_arg1, [arg2_sigma], op_res_ty) <-
- matchActualFunTysPart doc orig1 (Just (unLoc arg1)) 1 arg1_ty [] 1
+ matchActualFunTys doc orig1 (Just (unLoc arg1)) 1 arg1_ty
-- have a quick look
; (op_res_ty', res_ty', [arg2_sigma'])
@@ -443,7 +443,7 @@ tcExpr expr@(OpApp fix arg1 op arg2) res_ty
tcExpr expr@(SectionR x op arg2) res_ty
= do { (op', op_ty) <- tcInferFun op
; (wrap_fun, [arg1_ty, arg2_ty], op_res_ty)
- <- matchActualFunTysPart (mk_op_msg op) fn_orig (Just (unLoc op)) 2 op_ty [] 2
+ <- matchActualFunTys (mk_op_msg op) fn_orig (Just (unLoc op)) 2 op_ty
; let fun_ty = mkVisFunTy arg1_ty op_res_ty
; (fun_ty', res_ty', [arg2_ty'])
<- tcPerformQuickLook tcQuickLookExprs fn_orig
@@ -466,8 +466,8 @@ tcExpr expr@(SectionL x arg1 op) res_ty
| otherwise = 2
; (wrap_fn, (arg1_ty:arg_tys), op_res_ty)
- <- matchActualFunTysPart (mk_op_msg op) fn_orig (Just (unLoc op))
- n_reqd_args op_ty [] n_reqd_args
+ <- matchActualFunTys (mk_op_msg op) fn_orig (Just (unLoc op))
+ n_reqd_args op_ty
; let fun_ty = mkVisFunTys arg_tys op_res_ty
; (fun_ty', res_ty', [arg1_ty'])
<- tcPerformQuickLook tcQuickLookExprs fn_orig
@@ -1884,8 +1884,7 @@ tcSynArgA :: CtOrigin
-- and a wrapper to be applied to the overall expression
tcSynArgA orig sigma_ty arg_shapes res_shape thing_inside
= do { (match_wrapper, arg_tys, res_ty)
- <- matchActualFunTysPart herald orig Nothing (length arg_shapes)
- sigma_ty [] (length arg_shapes)
+ <- matchActualFunTys herald orig Nothing (length arg_shapes) sigma_ty
-- match_wrapper :: sigma_ty "->" (arg_tys -> res_ty)
; ((result, res_wrapper), arg_wrappers)
<- tc_syn_args_e arg_tys arg_shapes $ \ arg_results ->
diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs
index 6aae7983656..fd8469310bf 100644
--- a/compiler/typecheck/TcUnify.hs
+++ b/compiler/typecheck/TcUnify.hs
@@ -139,6 +139,7 @@ passed in.
-}
-- Use this one when you have an "expected" type.
+-- This function skolemises at each polytype.
matchExpectedFunTys :: forall a.
SDoc -- See Note [Herald for matchExpectedFunTys]
-> UserTypeCtxt
@@ -231,6 +232,7 @@ matchExpectedFunTys herald ctx arity orig_ty thing_inside
-- Like 'matchExpectedFunTys', but used when you have an "actual" type,
-- for example in function application
+-- This function instantiates at each poltype.
matchActualFunTys :: SDoc -- See Note [Herald for matchExpectedFunTys]
-> CtOrigin
-> Maybe (HsExpr GhcRn) -- the thing with type TcSigmaType
--
GitLab