[project @ 2000-11-15 17:07:34 by simonpj]

[ghc-hetmet.git] / ghc / compiler / coreSyn / CoreLint.lhs

diff --git a/ghc/compiler/coreSyn/CoreLint.lhs b/ghc/compiler/coreSyn/CoreLint.lhs
index 6f7ad36..5a0c140 100644 (file)
--- a/ghc/compiler/coreSyn/CoreLint.lhs
+++ b/ghc/compiler/coreSyn/CoreLint.lhs
@@ -7,7 +7,7 @@
 module CoreLint (
        lintCoreBindings,
        lintUnfolding, 
-       beginPass, endPass, endPassWithRules
+       showPass, endPass, endPassWithRules
     ) where
 
 #include "HsVersions.h"
@@ -27,18 +27,18 @@ import VarSet
 import Subst           ( mkTyVarSubst, substTy )
 import Name            ( getSrcLoc )
 import PprCore
-import ErrUtils                ( doIfSet_dyn, dumpIfSet, ghcExit, Message, 
+import ErrUtils                ( doIfSet_dyn, dumpIfSet, ghcExit, Message, showPass,
                          ErrMsg, addErrLocHdrLine, pprBagOfErrors,
                           WarnMsg, pprBagOfWarnings)
 import SrcLoc          ( SrcLoc, noSrcLoc )
 import Type            ( Type, tyVarsOfType,
                          splitFunTy_maybe, mkTyVarTy,
-                         splitForAllTy_maybe, splitTyConApp_maybe,
+                         splitForAllTy_maybe, splitTyConApp_maybe, splitTyConApp,
                          isUnLiftedType, typeKind, 
                          isUnboxedTupleType,
                          hasMoreBoxityInfo
                        )
-import TyCon           ( TyCon, isPrimTyCon, tyConDataCons )
+import TyCon           ( isPrimTyCon )
 import BasicTypes      ( RecFlag(..), isNonRec )
 import CmdLineOpts
 import Maybe
@@ -58,14 +58,6 @@ place for them.  They print out stuff before and after core passes,
 and do Core Lint when necessary.
 
 \begin{code}
-beginPass :: DynFlags -> String -> IO ()
-beginPass dflags pass_name
-  | dopt Opt_D_show_passes dflags
-  = hPutStrLn stdout ("*** " ++ pass_name)
-  | otherwise
-  = return ()
-
-
 endPass :: DynFlags -> String -> Bool -> [CoreBind] -> IO [CoreBind]
 endPass dflags pass_name dump_flag binds
   = do  
@@ -156,7 +148,7 @@ lintCoreBindings dflags whoDunnit binds
                                  returnL ()
     lint_bind (NonRec bndr rhs) = lintSingleBinding NonRecursive (bndr,rhs)
 
-    done_lint = doIfSet_dyn dflags (dopt Opt_D_show_passes)
+    done_lint = doIfSet_dyn dflags Opt_D_show_passes
                        (hPutStr stdout ("*** Core Linted result of " ++ whoDunnit ++ "\n"))
     warn warnings
       = vcat [
@@ -474,7 +466,7 @@ lintCoreAlt scrut_ty alt@(DataAlt con, args, rhs)
        -- Scrutinee type must be a tycon applicn; checked by caller
        -- This code is remarkably compact considering what it does!
        -- NB: args must be in scope here so that the lintCoreArgs line works.
-    case splitTyConApp_maybe scrut_ty of { Just (tycon, tycon_arg_tys) ->
+    case splitTyConApp scrut_ty of { (tycon, tycon_arg_tys) ->
        lintTyApps (dataConRepType con) tycon_arg_tys   `thenL` \ con_type ->
        lintCoreArgs con_type (map mk_arg args)         `thenL` \ con_result_ty ->
        checkTys con_result_ty scrut_ty (mkBadPatMsg con_result_ty scrut_ty)