[project @ 2004-09-09 07:07:43 by panne]

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

diff --git a/ghc/compiler/typecheck/TcExpr.lhs b/ghc/compiler/typecheck/TcExpr.lhs
index d0328f9..6a3c514 100644 (file)
--- a/ghc/compiler/typecheck/TcExpr.lhs
+++ b/ghc/compiler/typecheck/TcExpr.lhs
@@ -166,8 +166,7 @@ tc_expr in_expr@(ExprWithTySig expr poly_ty) res_ty
  = addErrCtxt (exprCtxt in_expr)                       $
    tcHsSigType ExprSigCtxt poly_ty                     `thenM` \ sig_tc_ty ->
    tcThingWithSig sig_tc_ty (tcCheckRho expr) res_ty   `thenM` \ (co_fn, expr') ->
-   returnM (co_fn <$> unLoc expr')
-       -- ToDo: nasty unLoc
+   returnM (co_fn <$> ExprWithTySigOut expr' poly_ty)
 
 tc_expr (HsType ty) res_ty
   = failWithTc (text "Can't handle type argument:" <+> ppr ty)
@@ -839,9 +838,9 @@ tcId name   -- Look up the Id and instantiate its type
        -- the type of dataConWrapId (see note on "stupid context" in DataCon.lhs
        -- It's dual to TcPat.tcConstructor
     inst_data_con data_con
-      = tcInstDataCon orig data_con    `thenM` \ (ty_args, ex_dicts, arg_tys, result_ty, _) ->
-       extendLIEs ex_dicts             `thenM_`
-       getSrcSpanM                     `thenM` \ loc ->
+      = tcInstDataCon orig VanillaTv data_con  `thenM` \ (ty_args, ex_dicts, arg_tys, result_ty, _) ->
+       extendLIEs ex_dicts                     `thenM_`
+       getSrcSpanM                             `thenM` \ loc ->
        returnM (unLoc (mkHsDictApp (mkHsTyApp (L loc (HsVar (dataConWrapId data_con))) ty_args) 
                             (map instToId ex_dicts)), 
                 mkFunTys arg_tys result_ty)