-tcVarPat :: (Name -> Maybe TcId) -- Info about signatures; gives the *monomorphic*
- -- Id for variables with a type signature
- -> Name
-
- -> TcType -- Expected type, derived from the context
- -- In the case of a function with a rank-2 signature,
- -- this type might be a forall type.
- -- INVARIANT: if it is, the foralls will always be visible,
- -- not hidden inside a mutable type variable
-
- -> TcM s TcId -- The monomorphic Id; this is put in the pattern itself
-
-tcVarPat sig_fn binder_name pat_ty
- = case sig_fn binder_name of
- Nothing -> -- Need to make a new, monomorphic, Id
- -- The binder_name is already being used for the polymorphic Id
- newLocalId (getOccName binder_name) pat_ty loc `thenNF_Tc` \ bndr_id ->
- returnTc bndr_id
-
- Just bndr_id -> tcAddSrcLoc loc $
- unifyTauTy (idType bndr_id) pat_ty `thenTc_`
- returnTc bndr_id
- where
- loc = getSrcLoc binder_name
+type BinderChecker = Name -> TcSigmaType -> TcM (PatCoFn, LIE, TcId)
+ -- How to construct a suitable (monomorphic)
+ -- Id for variables found in the pattern
+ -- The TcSigmaType is the expected type
+ -- from the pattern context
+
+-- The Id may have a sigma type (e.g. f (x::forall a. a->a))
+-- so we want to *create* it during pattern type checking.
+-- We don't want to make Ids first with a type-variable type
+-- and then unify... becuase we can't unify a sigma type with a type variable.
+
+tcMonoPatBndr :: BinderChecker
+ -- This is the right function to pass to tcPat when
+ -- we're looking at a lambda-bound pattern,
+ -- so there's no polymorphic guy to worry about
+
+tcMonoPatBndr binder_name pat_ty
+ | Just tv <- tcGetTyVar_maybe pat_ty,
+ isHoleTyVar tv
+ -- If there are *no constraints* on the pattern type, we
+ -- revert to good old H-M typechecking, making
+ -- the type of the binder into an *ordinary*
+ -- type variable. We find out if there are no constraints
+ -- by seeing if we are given an "open hole" as our info.
+ -- What we are trying to avoid here is giving a binder
+ -- a type that is a 'hole'. The only place holes should
+ -- appear is as an argument to tcPat and tcExpr/tcMonoExpr.
+ = getTcTyVar tv `thenNF_Tc` \ maybe_ty ->
+ case maybe_ty of
+ Just ty -> tcMonoPatBndr binder_name ty
+ Nothing -> newTyVarTy openTypeKind `thenNF_Tc` \ ty ->
+ putTcTyVar tv ty `thenNF_Tc_`
+ returnTc (idCoercion, emptyLIE, mkLocalId binder_name ty)
+ | otherwise
+ = returnTc (idCoercion, emptyLIE, mkLocalId binder_name pat_ty)