[project @ 2001-01-03 11:18:51 by simonmar]

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

diff --git a/ghc/compiler/typecheck/TcExpr.lhs b/ghc/compiler/typecheck/TcExpr.lhs
index 64430f8..536a5d3 100644 (file)
--- a/ghc/compiler/typecheck/TcExpr.lhs
+++ b/ghc/compiler/typecheck/TcExpr.lhs
@@ -4,7 +4,7 @@
 \section[TcExpr]{Typecheck an expression}
 
 \begin{code}
-module TcExpr ( tcApp, tcExpr, tcPolyExpr, tcId ) where
+module TcExpr ( tcApp, tcExpr, tcMonoExpr, tcPolyExpr, tcId ) where
 
 #include "HsVersions.h"
 
@@ -47,12 +47,12 @@ import DataCon              ( dataConFieldLabels, dataConSig,
                        )
 import Name            ( Name, getName )
 import Type            ( mkFunTy, mkAppTy, mkTyVarTys, ipName_maybe,
-                         splitFunTy_maybe, splitFunTys, isNotUsgTy,
+                         splitFunTy_maybe, splitFunTys,
                          mkTyConApp, splitSigmaTy, 
                          splitRhoTy,
                          isTauTy, tyVarsOfType, tyVarsOfTypes, 
                          isSigmaTy, splitAlgTyConApp, splitAlgTyConApp_maybe,
-                         boxedTypeKind, openTypeKind, mkArrowKind,
+                         liftedTypeKind, openTypeKind, mkArrowKind,
                          tidyOpenType
                        )
 import TyCon           ( TyCon, tyConTyVars )
@@ -293,10 +293,10 @@ tcMonoExpr (HsCCall lbl args may_gc is_asm ignored_fake_result_ty) res_ty
     newTyVarTys (length tv_idxs) openTypeKind          `thenNF_Tc` \ arg_tys ->
     tcMonoExprs args arg_tys                           `thenTc`    \ (args', args_lie) ->
 
-       -- The argument types can be unboxed or boxed; the result
-       -- type must, however, be boxed since it's an argument to the IO
+       -- The argument types can be unlifted or lifted; the result
+       -- type must, however, be lifted since it's an argument to the IO
        -- type constructor.
-    newTyVarTy boxedTypeKind           `thenNF_Tc` \ result_ty ->
+    newTyVarTy liftedTypeKind                  `thenNF_Tc` \ result_ty ->
     let
        io_result_ty = mkTyConApp ioTyCon [result_ty]
     in
@@ -475,8 +475,7 @@ tcMonoExpr expr@(RecordUpd record_expr rbinds) res_ty
        -- Figure out the tycon and data cons from the first field name
     let
        (Just (AnId sel_id) : _)  = maybe_sel_ids
-       (_, _, tau)               = ASSERT( isNotUsgTy (idType sel_id) )
-                                    splitSigmaTy (idType sel_id)       -- Selectors can be overloaded
+       (_, _, tau)               = splitSigmaTy (idType sel_id)        -- Selectors can be overloaded
                                                                        -- when the data type has a context
        Just (data_ty, _)         = splitFunTy_maybe tau        -- Must succeed since sel_id is a selector
        (tycon, _, data_cons)       = splitAlgTyConApp data_ty
@@ -520,7 +519,7 @@ tcMonoExpr expr@(RecordUpd record_expr rbinds) res_ty
 
        mk_inst_ty (tyvar, result_inst_ty) 
          | tyvar `elemVarSet` common_tyvars = returnNF_Tc result_inst_ty       -- Same as result type
-         | otherwise                               = newTyVarTy boxedTypeKind  -- Fresh type
+         | otherwise                               = newTyVarTy liftedTypeKind -- Fresh type
     in
     mapNF_Tc mk_inst_ty (zip con_tyvars result_inst_tys)       `thenNF_Tc` \ inst_tys ->
 
@@ -792,12 +791,6 @@ tcArg the_fun (arg, expected_arg_ty, arg_no)
 %*                                                                     *
 %************************************************************************
 
-Between the renamer and the first invocation of the UsageSP inference,
-identifiers read from interface files will have usage information in
-their types, whereas other identifiers will not.  The unannotTy here
-in @tcId@ prevents this information from pointlessly propagating
-further prior to the first usage inference.
-
 \begin{code}
 tcId :: Name -> NF_TcM (TcExpr, LIE, TcType)
 
@@ -808,7 +801,6 @@ tcId name
       ATcId tc_id      -> instantiate_it (OccurrenceOf tc_id) tc_id (idType tc_id)
       AGlobal (AnId id) -> tcInstId id                 `thenNF_Tc` \ (tyvars, theta, tau) ->
                           instantiate_it2 (OccurrenceOf id) id tyvars theta tau
-
   where
        -- The instantiate_it loop runs round instantiating the Id.
        -- It has to be a loop because we are now prepared to entertain
@@ -847,8 +839,8 @@ tcDoStmts do_or_lc stmts src_loc res_ty
     ASSERT( not (null stmts) )
     tcAddSrcLoc src_loc        $
 
-    newTyVarTy (mkArrowKind boxedTypeKind boxedTypeKind)       `thenNF_Tc` \ m ->
-    newTyVarTy boxedTypeKind                                   `thenNF_Tc` \ elt_ty ->
+    newTyVarTy (mkArrowKind liftedTypeKind liftedTypeKind)     `thenNF_Tc` \ m ->
+    newTyVarTy liftedTypeKind                                  `thenNF_Tc` \ elt_ty ->
     unifyTauTy res_ty (mkAppTy m elt_ty)                       `thenTc_`
 
        -- If it's a comprehension we're dealing with, 
@@ -858,7 +850,7 @@ tcDoStmts do_or_lc stmts src_loc res_ty
        ListComp -> unifyListTy res_ty `thenTc_` returnTc ()
        _       -> returnTc ())                                 `thenTc_`
 
-    tcStmts do_or_lc (mkAppTy m) stmts elt_ty  `thenTc`   \ (stmts', stmts_lie) ->
+    tcStmts do_or_lc (mkAppTy m) elt_ty src_loc stmts          `thenTc`   \ ((stmts', _), stmts_lie) ->
 
        -- Build the then and zero methods in case we need them
        -- It's important that "then" and "return" appear just once in the final LIE,