[project @ 2005-05-12 16:51:03 by simonpj]

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

diff --git a/ghc/compiler/typecheck/TcExpr.lhs b/ghc/compiler/typecheck/TcExpr.lhs
index c509c67..4cdf5b5 100644 (file)
--- a/ghc/compiler/typecheck/TcExpr.lhs
+++ b/ghc/compiler/typecheck/TcExpr.lhs
@@ -32,7 +32,7 @@ import BasicTypes     ( isMarkedStrict )
 import Inst            ( tcOverloadedLit, newMethodFromName, newIPDict,
                          newDicts, newMethodWithGivenTy, tcInstStupidTheta, tcInstCall )
 import TcBinds         ( tcBindsAndThen )
-import TcEnv           ( tcLookup, tcLookupId, checkProcLevel,
+import TcEnv           ( tcLookup, tcLookupId,
                          tcLookupDataCon, tcLookupGlobalId
                        )
 import TcArrows                ( tcProc )
@@ -49,7 +49,7 @@ import Kind           ( openTypeKind, liftedTypeKind, argTypeKind )
 
 import Id              ( idType, recordSelectorFieldLabel, isRecordSelector )
 import DataCon         ( DataCon, dataConFieldLabels, dataConStrictMarks, 
-                         dataConWrapId, dataConWorkId )
+                         dataConWrapId )
 import Name            ( Name )
 import TyCon           ( TyCon, FieldLabel, tyConTyVars, tyConStupidTheta, 
                          tyConDataCons, tyConFields )
@@ -88,7 +88,7 @@ tcCheckSigma :: LHsExpr Name          -- Expession to type check
                     -> TcM (LHsExpr TcId)      -- Generalised expr with expected type
 
 tcCheckSigma expr expected_ty 
-  = traceTc (text "tcExpr" <+> (ppr expected_ty $$ ppr expr)) `thenM_`
+  = -- traceTc (text "tcExpr" <+> (ppr expected_ty $$ ppr expr)) `thenM_`
     tc_expr' expr expected_ty
 
 tc_expr' expr sigma_ty
@@ -266,7 +266,7 @@ tcExpr in_expr@(OpApp arg1 op fix arg2) res_ty
     tcArg op (arg2, arg2_ty, 2)                        `thenM` \ arg2' ->
     addErrCtxt (exprCtxt in_expr)              $
     tcSubExp res_ty op_res_ty                  `thenM` \ co_fn ->
-    returnM (OpApp arg1' op' fix arg2')
+    returnM (co_fn <$> OpApp arg1' op' fix arg2')
 \end{code}
 
 \begin{code}
@@ -381,7 +381,7 @@ tcExpr expr@(RecordCon con@(L loc con_name) _ rbinds) res_ty
        -- Check for missing fields
     checkMissingFields data_con rbinds         `thenM_` 
 
-    returnM (RecordCon (L loc (dataConWorkId data_con)) con_expr rbinds')
+    returnM (RecordCon (L loc (dataConWrapId data_con)) con_expr rbinds')
 
 -- The main complication with RecordUpd is that we need to explicitly
 -- handle the *non-updated* fields.  Consider:
@@ -787,11 +787,8 @@ tcId orig id_name  -- Look up the Id and instantiate its type
                -- A global cannot possibly be ill-staged
                -- nor does it need the 'lifting' treatment
 
-    ;  ATcId id th_level proc_level 
-         -> do { checkProcLevel id proc_level
-               ; tc_local_id id th_level }
+    ;  ATcId id th_level -> tc_local_id id th_level
 
-       -- THis 
     ;  other -> failWithTc (ppr other <+> ptext SLIT("used where a value identifer was expected"))
     }
   where