- -- The expression has type: spec_ty -> expected_ty
-
-tcGen expected_ty extra_tvs thing_inside -- We expect expected_ty to be a forall-type
- -- If not, the call is a no-op
- = do { traceTc (text "tcGen")
- -- We want the GenSkol info in the skolemised type variables to
- -- mention the *instantiated* tyvar names, so that we get a
- -- good error message "Rigid variable 'a' is bound by (forall a. a->a)"
- -- Hence the tiresome but innocuous fixM
- ; ((tvs', theta', rho'), skol_info) <- fixM (\ ~(_, skol_info) ->
- do { (forall_tvs, theta, rho_ty) <- tcInstSkolType skol_info expected_ty
- -- Get loation from monad, not from expected_ty
- ; let skol_info = GenSkol forall_tvs (mkPhiTy theta rho_ty)
- ; return ((forall_tvs, theta, rho_ty), skol_info) })
-
-#ifdef DEBUG
- ; traceTc (text "tcGen" <+> vcat [text "extra_tvs" <+> ppr extra_tvs,
- text "expected_ty" <+> ppr expected_ty,
- text "inst ty" <+> ppr tvs' <+> ppr theta' <+> ppr rho',
- text "free_tvs" <+> ppr free_tvs])
-#endif
-
- -- Type-check the arg and unify with poly type
- ; (result, lie) <- getLIE (thing_inside tvs' rho')
-
- -- Check that the "forall_tvs" havn't been constrained
- -- The interesting bit here is that we must include the free variables
- -- of the expected_ty. Here's an example:
- -- runST (newVar True)
- -- Here, if we don't make a check, we'll get a type (ST s (MutVar s Bool))
- -- for (newVar True), with s fresh. Then we unify with the runST's arg type
- -- forall s'. ST s' a. That unifies s' with s, and a with MutVar s Bool.
- -- So now s' isn't unconstrained because it's linked to a.
- -- Conclusion: include the free vars of the expected_ty in the
- -- list of "free vars" for the signature check.
-
- ; loc <- getInstLoc (SigOrigin skol_info)
- ; dicts <- newDictBndrs loc theta'
- ; inst_binds <- tcSimplifyCheck loc tvs' dicts lie
-
- ; checkSigTyVarsWrt free_tvs tvs'
- ; traceTc (text "tcGen:done")
-
- ; let
- -- The WpLet binds any Insts which came out of the simplification.
- dict_vars = map instToVar dicts
- co_fn = mkWpTyLams tvs' <.> mkWpLams dict_vars <.> WpLet inst_binds
- ; returnM (co_fn, result) }
+ -- The expression has type: spec_ty -> expected_ty
+
+tcGen expected_ty extra_tvs thing_inside -- We expect expected_ty to be a forall-type
+ -- If not, the call is a no-op
+ = do { traceTc (text "tcGen")
+ -- We want the GenSkol info in the skolemised type variables to
+ -- mention the *instantiated* tyvar names, so that we get a
+ -- good error message "Rigid variable 'a' is bound by (forall a. a->a)"
+ -- Hence the tiresome but innocuous fixM
+ ; ((tvs', theta', rho'), skol_info) <- fixM (\ ~(_, skol_info) ->
+ do { (forall_tvs, theta, rho_ty) <- tcInstSkolType skol_info expected_ty
+ -- Get loation from monad, not from expected_ty
+ ; let skol_info = GenSkol forall_tvs (mkPhiTy theta rho_ty)
+ ; return ((forall_tvs, theta, rho_ty), skol_info) })
+
+ ; when debugIsOn $
+ traceTc (text "tcGen" <+> vcat [
+ text "extra_tvs" <+> ppr extra_tvs,
+ text "expected_ty" <+> ppr expected_ty,
+ text "inst ty" <+> ppr tvs' <+> ppr theta'
+ <+> ppr rho',
+ text "free_tvs" <+> ppr free_tvs])
+
+ -- Type-check the arg and unify with poly type
+ ; (result, lie) <- getLIE (thing_inside tvs' rho')
+
+ -- Check that the "forall_tvs" havn't been constrained
+ -- The interesting bit here is that we must include the free variables
+ -- of the expected_ty. Here's an example:
+ -- runST (newVar True)
+ -- Here, if we don't make a check, we'll get a type (ST s (MutVar s Bool))
+ -- for (newVar True), with s fresh. Then we unify with the runST's arg type
+ -- forall s'. ST s' a. That unifies s' with s, and a with MutVar s Bool.
+ -- So now s' isn't unconstrained because it's linked to a.
+ -- Conclusion: include the free vars of the expected_ty in the
+ -- list of "free vars" for the signature check.
+
+ ; loc <- getInstLoc (SigOrigin skol_info)
+ ; dicts <- newDictBndrs loc theta' -- Includes equalities
+ ; inst_binds <- tcSimplifyCheck loc tvs' dicts lie
+
+ ; checkSigTyVarsWrt free_tvs tvs'
+ ; traceTc (text "tcGen:done")
+
+ ; let
+ -- The WpLet binds any Insts which came out of the simplification.
+ dict_vars = map instToVar dicts
+ co_fn = mkWpTyLams tvs' <.> mkWpLams dict_vars <.> WpLet inst_binds
+ ; return (co_fn, result) }