[project @ 1996-07-15 16:16:46 by partain]

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

diff --git a/ghc/compiler/typecheck/TcPragmas.lhs b/ghc/compiler/typecheck/TcPragmas.lhs
index cebb20d..0652152 100644 (file)
--- a/ghc/compiler/typecheck/TcPragmas.lhs
+++ b/ghc/compiler/typecheck/TcPragmas.lhs
@@ -13,13 +13,11 @@ module TcPragmas (
        tcGenPragmas
     ) where
 
-import TcMonad         -- typechecking monadic machinery
+import TcMonad         hiding ( rnMtoTcM )
 import HsSyn           -- the stuff being typechecked
 
-import PrelInfo                ( PrimOp(..)    -- to see CCallOp
-                         IF_ATTACK_PRAGMAS(COMMA tagOf_PrimOp)
-                         IF_ATTACK_PRAGMAS(COMMA pprPrimOp)
-                       )
+--import PrelInfo              ( PrimOp(..)    -- to see CCallOp
+--                     )
 import Type
 import CmdLineOpts
 import CostCentre
@@ -28,7 +26,7 @@ import HsPragmas      -- ****** NEED TO SEE CONSTRUCTORS ******
 import Id
 import IdInfo
 --import WwLib         ( mkWwBodies )
-import Maybes          ( assocMaybe, catMaybes, Maybe(..) )
+import Maybes          ( assocMaybe, catMaybes )
 --import CoreLint              ( lintUnfolding )
 import TcMonoType      ( tcMonoType, tcPolyType )
 import Util
@@ -181,7 +179,7 @@ tc_strictness
        -> Maybe Type
        -> Id           -- final Id (do not *touch*)
        -> ImpStrictness Name
-       -> Baby_TcM (StrictnessInfo, UnfoldingDetails)
+       -> Baby_TcM (StrictnessInfo, Unfolding)
 
 tc_strictness e ty_maybe rec_final_id info
   = getSwitchCheckerB_Tc    `thenB_Tc` \ sw_chkr ->
@@ -235,7 +233,7 @@ do_strictness e (Just wrapper_ty) rec_final_id
   = -- Strictness info suggests a worker.  Things could still
     -- go wrong if there's an abstract type involved, mind you.
     let
-       (tv_tmpls, arg_tys, ret_ty) = splitTypeWithDictsAsArgs wrapper_ty
+       (tv_tmpls, arg_tys, ret_ty) = splitFunTyExpandingDicts wrapper_ty
        n_wrapper_args              = length wrap_arg_info
                -- Don't have more args than this, else you risk
                -- losing laziness!!
@@ -253,7 +251,7 @@ do_strictness e (Just wrapper_ty) rec_final_id
        inst_ret_ty  = glueTyArgs dropped_inst_arg_tys
                                  (instantiateTy inst_env ret_ty)
 
-       args         = zipWithEqual mk_arg arg_uniqs    undropped_inst_arg_tys
+       args           = zipWithEqual "do_strictness" mk_arg arg_uniqs undropped_inst_arg_tys
        mk_arg uniq ty = mkSysLocal SLIT("wrap") uniq ty mkUnknownSrcLoc
        -- ASSERT: length args = n_wrapper_args
     in
@@ -361,7 +359,7 @@ tc_unfolding e (ImpUnfolding guidance uf_core)
        -- NB: We cant check the lint result and return noInfo_UF if
        --     lintUnfolding failed as this is too strict
        --     Instead getInfo_UF tests for BadUnfolding and converts
-       --     to NoUnfoldingDetails when the unfolding is accessed
+       --     to NoUnfolding when the unfolding is accessed
 
        maybe_lint_expr = lintUnfolding locn core_expr
 
@@ -485,7 +483,7 @@ tc_unfolding e (ImpUnfolding guidance uf_core)
        in
        mapB_Tc (tc_uf_core new_lve tve) rhss `thenB_Tc` \ new_rhss ->
        tc_uf_core new_lve tve         body `thenB_Tc` \ new_body ->
-       returnB_Tc (Let (Rec (new_binders `zip` new_rhss)) new_body)
+       returnB_Tc (Let (Rec (zipEqual "tc_uf_core" new_binders new_rhss)) new_body)
 
     tc_uf_core lve tve (UfSCC uf_cc body)
       = tc_uf_cc   uf_cc           `thenB_Tc` \ new_cc ->