[project @ 2000-11-10 15:12:50 by simonpj]

1.	Outputable.PprStyle now carries a bit more information
	In particular, the printing style tells whether to print
	a name in unqualified form.  This used to be embedded in
	a Name, but since Names now outlive a single compilation unit,
	that's no longer appropriate.

	So now the print-unqualified predicate is passed in the printing
	style, not embedded in the Name.

   2.	I tidied up HscMain a little.  Many of the showPass messages
	have migraged into the repective pass drivers

ghc/compiler/basicTypes/Name.lhs

@@ -43,8 +43,7 @@ module Name (
 #include "HsVersions.h"
 
 import OccName		-- All of it
-import Module		( Module, moduleName, mkVanillaModule, 
-			  printModulePrefix, isModuleInThisPackage )
+import Module		( Module, moduleName, mkVanillaModule, isModuleInThisPackage )
 import RdrName		( RdrName, mkRdrOrig, mkRdrUnqual, rdrNameOcc, rdrNameModule )
 import CmdLineOpts	( opt_Static, opt_OmitInterfacePragmas, opt_EnsureSplittableC )
 import SrcLoc		( builtinSrcLoc, noSrcLoc, SrcLoc )
@@ -456,10 +455,10 @@ instance Outputable Name where
 	-- When printing interfaces, all Locals have been given nice print-names
     ppr name = pprName name
 
-pprName (Name {n_sort = sort, n_uniq = uniq, n_occ = occ})
+pprName name@(Name {n_sort = sort, n_uniq = uniq, n_occ = occ})
   = getPprStyle $ \ sty ->
     case sort of
-      Global mod -> pprGlobal sty uniq mod occ
+      Global mod -> pprGlobal sty name uniq mod occ
       System     -> pprSysLocal sty uniq occ
       Local      -> pprLocal sty uniq occ empty
       Exported   -> pprLocal sty uniq occ (char 'x')
@@ -470,16 +469,14 @@ pprLocal sty uniq occ pp_export
 		     text "{-" <> pp_export <+> pprUnique10 uniq <> text "-}"
   | otherwise      = pprOccName occ
 
-pprGlobal sty uniq mod occ
-  |  codeStyle sty        = ppr (moduleName mod) <> char '_' <> pprOccName occ
+pprGlobal sty name uniq mod occ
+  | codeStyle sty        = ppr (moduleName mod) <> char '_' <> pprOccName occ
 
-  | debugStyle sty        = ppr (moduleName mod) <> dot <> pprOccName occ <> 
+  | debugStyle sty       = ppr (moduleName mod) <> dot <> pprOccName occ <> 
 			    text "{-" <> pprUnique10 uniq <> text "-}"
 
-  | ifaceStyle sty	
-  || printModulePrefix mod = ppr (moduleName mod) <> dot <> pprOccName occ
-
-  | otherwise              = pprOccName occ
+  | unqualStyle sty name = pprOccName occ
+  | otherwise		 = ppr (moduleName mod) <> dot <> pprOccName occ
 
 pprSysLocal sty uniq occ
   | codeStyle sty  = pprUnique uniq

ghc/compiler/codeGen/CgCase.lhs

 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgCase.lhs,v 1.48 2000/11/07 15:21:39 simonmar Exp $
+% $Id: CgCase.lhs,v 1.49 2000/11/10 15:12:51 simonpj Exp $
 %
 %********************************************************
 %*							*
@@ -402,7 +402,7 @@ getPrimAppResultAmodes uniq (StgAlgAlts ty alts some_default)
 		[ CTemp (getUnique arg) (idPrimRep arg) | arg <- args ]
 	    _ -> panic "getPrimAppResultAmodes: case of unboxed tuple has multiple branches"
 
-  | otherwise = panic ("getPrimAppResultAmodes: case of primop has strange type: " ++ showSDoc (ppr ty))
+  | otherwise = pprPanic "getPrimAppResultAmodes: case of primop has strange type:" (ppr ty)
 
   where (tycon, _, _) = splitAlgTyConApp ty
 

ghc/compiler/codeGen/CodeGen.lhs

@@ -40,7 +40,7 @@ import PrimRep		( PrimRep(..) )
 import TyCon            ( TyCon, isDataTyCon )
 import BasicTypes	( TopLevelFlag(..) )
 import UniqSupply	( mkSplitUniqSupply )
-import ErrUtils		( dumpIfSet_dyn )
+import ErrUtils		( dumpIfSet_dyn, showPass )
 import Panic		( assertPanic )
 \end{code}
 
@@ -60,26 +60,28 @@ codeGen :: DynFlags
 
 codeGen dflags mod_name imported_modules cost_centre_info fe_binders
 	tycons stg_binds
-  = mkSplitUniqSupply 'f'	>>= \ fl_uniqs  -> -- absC flattener
-    let
-	datatype_stuff 	  = genStaticConBits cinfo data_tycons
-	code_stuff     	  = initC cinfo (cgTopBindings maybe_split stg_binds)
-	init_stuff        = mkModuleInit fe_binders mod_name imported_modules 
-					 cost_centre_info
-
-	abstractC = mkAbstractCs [ maybe_split,
-				   init_stuff, 
-				   code_stuff,
-				   datatype_stuff]
+  = do	{ showPass dflags "CodeGen"
+
+	; fl_uniqs <- mkSplitUniqSupply 'f'
+	; let
+	    datatype_stuff = genStaticConBits cinfo data_tycons
+	    code_stuff     = initC cinfo (cgTopBindings maybe_split stg_binds)
+	    init_stuff     = mkModuleInit fe_binders mod_name imported_modules 
+					  cost_centre_info
+
+	    abstractC = mkAbstractCs [ maybe_split,
+				       init_stuff, 
+				       code_stuff,
+				       datatype_stuff]
 		-- Put datatype_stuff after code_stuff, because the
 		-- datatype closure table (for enumeration types)
 		-- to (say) PrelBase_True_closure, which is defined in code_stuff
 
-	flat_abstractC = flattenAbsC fl_uniqs abstractC
-    in
-    dumpIfSet_dyn dflags Opt_D_dump_absC "Abstract C" (dumpRealC abstractC)	>>
-    return flat_abstractC
+	    flat_abstractC = flattenAbsC fl_uniqs abstractC
 
+	; dumpIfSet_dyn dflags Opt_D_dump_absC "Abstract C" (dumpRealC abstractC)
+	; return flat_abstractC
+	}
   where
     data_tycons = filter isDataTyCon tycons
 

ghc/compiler/coreSyn/CoreLint.lhs

@@ -7,7 +7,7 @@
 module CoreLint (
 	lintCoreBindings,
 	lintUnfolding, 
-	beginPass, endPass, endPassWithRules
+	showPass, endPass, endPassWithRules
     ) where
 
 #include "HsVersions.h"
@@ -27,7 +27,7 @@ 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 )
@@ -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  

ghc/compiler/coreSyn/CoreTidy.lhs

@@ -14,7 +14,7 @@ module CoreTidy (
 import CmdLineOpts	( DynFlags, DynFlag(..), opt_UsageSPOn, dopt )
 import CoreSyn
 import CoreUnfold	( noUnfolding )
-import CoreLint		( beginPass, endPass )
+import CoreLint		( showPass, endPass )
 import UsageSPInf       ( doUsageSPInf )
 import VarEnv
 import VarSet
@@ -35,6 +35,7 @@ import Type		( tidyTopType, tidyType, tidyTyVar )
 import Module		( Module )
 import UniqSupply	( mkSplitUniqSupply )
 import Unique		( Uniquable(..) )
+import ErrUtils		( showPass )
 import SrcLoc		( noSrcLoc )
 import Util		( mapAccumL )
 \end{code}
@@ -72,7 +73,7 @@ tidyCorePgm dflags module_name binds_in orphans_in
   = do
 	us <- mkSplitUniqSupply 'u'
 
-	beginPass dflags "Tidy Core"
+	showPass dflags "Tidy Core"
 
         binds_in1 <- if opt_UsageSPOn
                      then _scc_ "CoreUsageSPInf"

ghc/compiler/cprAnalysis/CprAnalyse.lhs

@@ -7,7 +7,7 @@ module CprAnalyse ( cprAnalyse ) where
 #include "HsVersions.h"
 
 import CmdLineOpts	( DynFlags, DynFlag(..), dopt )
-import CoreLint		( beginPass, endPass )
+import CoreLint		( showPass, endPass )
 import CoreSyn
 import CoreUtils	( exprIsValue )
 import Id               ( Id, setIdCprInfo, idCprInfo, idArity,
@@ -137,7 +137,7 @@ ids decorated with their CprInfo pragmas.
 cprAnalyse :: DynFlags -> [CoreBind] -> IO [CoreBind]
 cprAnalyse dflags binds
   = do {
-	beginPass dflags "Constructed Product analysis" ;
+	showPass dflags "Constructed Product analysis" ;
 	let { binds_plus_cpr = do_prog binds } ;
 	endPass dflags "Constructed Product analysis" 
 	 	(dopt Opt_D_dump_cpranal dflags || dopt Opt_D_verbose_core2core dflags)

ghc/compiler/deSugar/Desugar.lhs

@@ -28,10 +28,10 @@ import Id		( Id )
 import VarEnv
 import VarSet
 import Bag		( isEmptyBag )
-import CoreLint		( beginPass, endPass )
+import CoreLint		( showPass, endPass )
 import ErrUtils		( doIfSet, pprBagOfWarnings )
 import Outputable
-import UniqSupply	( UniqSupply )
+import UniqSupply	( mkSplitUniqSupply )
 import HscTypes		( HomeSymbolTable )
 \end{code}
 
@@ -46,34 +46,36 @@ start.
 
 \begin{code}
 deSugar :: DynFlags
-	-> Module 
-	-> UniqSupply
+	-> Module -> PrintUnqualified
 	-> HomeSymbolTable
         -> TcResults
 	-> IO ([CoreBind], [(Id,CoreRule)], SDoc, SDoc, [CoreBndr])
 
-deSugar dflags mod_name us hst
+deSugar dflags mod_name unqual hst
         (TcResults {tc_env   = global_val_env,
 		    tc_pcs   = pcs,
 		    tc_binds = all_binds,
 		    tc_rules = rules,
 		    tc_fords = fo_decls})
   = do
-	beginPass dflags "Desugar"
+	showPass dflags "Desugar"
+	us <- mkSplitUniqSupply 'd'
+
 	-- Do desugaring
 	let (result, ds_warns) = 
 		initDs dflags us (hst,pcs,global_val_env) mod_name
 			(dsProgram mod_name all_binds rules fo_decls)    
 	    (ds_binds, ds_rules, _, _, _) = result
 
-	 -- Display any warnings
+	-- Display any warnings
         doIfSet (not (isEmptyBag ds_warns))
-		(printErrs (pprBagOfWarnings ds_warns))
+		(printErrs unqual (pprBagOfWarnings ds_warns))
 
-	 -- Lint result if necessary
+	-- Lint result if necessary
         let do_dump_ds = dopt Opt_D_dump_ds dflags
         endPass dflags "Desugar" do_dump_ds ds_binds
 
+	-- Dump output
 	doIfSet do_dump_ds (printDump (ppr_ds_rules ds_rules))
 
         return result

ghc/compiler/deSugar/Match.lhs

@@ -108,7 +108,7 @@ dsIncompleteWarn ctx@(DsMatchContext kind _ _) pats = dsWarn warn
 	       | otherwise                    = empty
 
 pp_context NoMatchContext msg rest_of_msg_fun
-  = dontAddErrLoc "" (ptext SLIT("Some match(es)") <+> hang msg 8 (rest_of_msg_fun id))
+  = dontAddErrLoc (ptext SLIT("Some match(es)") <+> hang msg 8 (rest_of_msg_fun id))
 
 pp_context (DsMatchContext kind pats loc) msg rest_of_msg_fun
   = case pp_match kind pats of

ghc/compiler/hsSyn/HsBinds.lhs

@@ -74,16 +74,18 @@ instance (Outputable pat, Outputable id) =>
 
 ppr_binds EmptyBinds = empty
 ppr_binds (ThenBinds binds1 binds2)
-     = ($$) (ppr_binds binds1) (ppr_binds binds2)
+    = ppr_binds binds1 $$ ppr_binds binds2
 ppr_binds (MonoBind bind sigs is_rec)
-     = vcat [ifNotPprForUser (ptext rec_str),
+     = vcat [ppr_isrec,
      	     vcat (map ppr sigs),
 	     ppr bind
        ]
      where
-       rec_str = case is_rec of
-		   Recursive    -> SLIT("{- rec -}")
-		   NonRecursive -> SLIT("{- nonrec -}")
+       ppr_isrec = getPprStyle $ \ sty -> 
+		   if userStyle sty then empty else
+		   case is_rec of
+		   	Recursive    -> ptext SLIT("{- rec -}")
+			NonRecursive -> ptext SLIT("{- nonrec -}")
 \end{code}
 
 %************************************************************************

ghc/compiler/hsSyn/HsExpr.lhs

@@ -19,7 +19,7 @@ import HsTypes		( HsType )
 -- others:
 import Name		( Name, isLexSym ) 
 import Outputable	
-import PprType		( pprType, pprParendType )
+import PprType		( pprParendType )
 import Type		( Type )
 import Var		( TyVar )
 import DataCon		( DataCon )
@@ -305,8 +305,7 @@ ppr_expr (HsDoOut do_or_list_comp stmts _ _ _ _ _) = pprDo do_or_list_comp stmts
 ppr_expr (ExplicitList exprs)
   = brackets (fsep (punctuate comma (map ppr_expr exprs)))
 ppr_expr (ExplicitListOut ty exprs)
-  = hcat [ brackets (fsep (punctuate comma (map ppr_expr exprs))),
-	   ifNotPprForUser ((<>) space (parens (pprType ty))) ]
+  = brackets (fsep (punctuate comma (map ppr_expr exprs)))
 
 ppr_expr (ExplicitTuple exprs boxity)
   = tupleParens boxity (sep (punctuate comma (map ppr_expr exprs)))
@@ -394,7 +393,7 @@ pprParendExpr expr
 
 \begin{code}
 isOperator :: Outputable a => a -> Bool
-isOperator v = isLexSym (_PK_ (showSDoc (ppr v)))
+isOperator v = isLexSym (_PK_ (showSDocUnqual (ppr v)))
 	-- We use (showSDoc (ppr v)), rather than isSymOcc (getOccName v) simply so
 	-- that we don't need NamedThing in the context of all these functions.
 	-- Gruesome, but simple.

ghc/compiler/main/CodeOutput.lhs

@@ -27,7 +27,7 @@ import AbsCSyn		( AbstractC )
 import PprAbsC		( dumpRealC, writeRealC )
 import Module		( Module )
 import CmdLineOpts
-import ErrUtils		( dumpIfSet_dyn )
+import ErrUtils		( dumpIfSet_dyn, showPass )
 import Outputable
 import CmdLineOpts	( DynFlags, HscLang(..), dopt_OutName )
 import TmpFiles		( newTempName )
@@ -61,16 +61,18 @@ codeOutput dflags mod_name tycons core_binds stg_binds
 
     -- Dunno if the above comment is still meaningful now.  JRS 001024.
 
-    do let filenm = dopt_OutName dflags 
-       stub_names <- outputForeignStubs dflags c_code h_code
-       case dopt_HscLang dflags of
-          HscInterpreted -> return stub_names
-          HscAsm         -> outputAsm dflags filenm flat_abstractC
-                            >> return stub_names
-          HscC           -> outputC dflags filenm flat_abstractC	
-                            >> return stub_names
-          HscJava        -> outputJava dflags filenm mod_name tycons core_binds
-                            >> return stub_names
+    do	{ showPass dflags "CodeOutput"
+	; let filenm = dopt_OutName dflags 
+	; stub_names <- outputForeignStubs dflags c_code h_code
+	; case dopt_HscLang dflags of
+             HscInterpreted -> return stub_names
+             HscAsm         -> outputAsm dflags filenm flat_abstractC
+          		       >> return stub_names
+             HscC           -> outputC dflags filenm flat_abstractC	
+          		       >> return stub_names
+             HscJava        -> outputJava dflags filenm mod_name tycons core_binds
+          		       >> return stub_names
+	}
 
 doOutput :: String -> (Handle -> IO ()) -> IO ()
 doOutput filenm io_action
@@ -130,7 +132,7 @@ outputAsm dflags filenm flat_absC
 
 \begin{code}
 outputJava dflags filenm mod tycons core_binds
-  = doOutput filenm (\ f -> printForUser f pp_java)
+  = doOutput filenm (\ f -> printForUser f alwaysQualify pp_java)
 	-- User style printing for now to keep indentation
   where
     java_code = javaGen mod [{- Should be imports-}] tycons core_binds

ghc/compiler/main/ErrUtils.lhs

@@ -5,22 +5,24 @@
 
 \begin{code}
 module ErrUtils (
-	ErrMsg, WarnMsg, Message,
+	ErrMsg, WarnMsg, Message, Messages, errorsFound,
+
 	addShortErrLocLine, addShortWarnLocLine,
-	addErrLocHdrLine,
-	dontAddErrLoc,
+	addErrLocHdrLine, dontAddErrLoc,
+
 	printErrorsAndWarnings, pprBagOfErrors, pprBagOfWarnings,
+
 	ghcExit,
-	doIfSet, doIfSet_dyn, dumpIfSet, dumpIfSet_dyn
+	doIfSet, doIfSet_dyn, dumpIfSet, dumpIfSet_dyn, showPass
     ) where
 
 #include "HsVersions.h"
 
 import Bag		( Bag, bagToList, isEmptyBag )
-import SrcLoc		( SrcLoc, noSrcLoc )
+import SrcLoc		( SrcLoc, noSrcLoc, isGoodSrcLoc )
 import Util		( sortLt )
 import Outputable
-import CmdLineOpts	( DynFlags, DynFlag, dopt )
+import CmdLineOpts	( DynFlags, DynFlag(..), dopt )
 
 import System		( ExitCode(..), exitWith )
 import IO		( hPutStr, stderr )
@@ -38,10 +40,9 @@ addErrLocHdrLine    :: SrcLoc -> Message -> Message -> ErrMsg
 addShortWarnLocLine :: SrcLoc -> Message -> WarnMsg
 
 addShortErrLocLine locn rest_of_err_msg
-  = ( locn
-    , hang (ppr locn <> colon) 
-         4 rest_of_err_msg
-    )
+  | isGoodSrcLoc locn = (locn, hang (ppr locn <> colon) 4 
+				    rest_of_err_msg)
+  | otherwise	      = (locn, rest_of_err_msg)
 
 addErrLocHdrLine locn hdr rest_of_err_msg
   = ( locn
@@ -50,23 +51,28 @@ addErrLocHdrLine locn hdr rest_of_err_msg
     )
 
 addShortWarnLocLine locn rest_of_err_msg
-  = ( locn
-    , hang (ppr locn <> colon)
-	 4 (ptext SLIT("Warning:") <+> rest_of_err_msg)
-    )
+  | isGoodSrcLoc locn = (locn, hang (ppr locn <> colon) 4 
+				    (ptext SLIT("Warning:") <+> rest_of_err_msg))
+  | otherwise	      = (locn, rest_of_err_msg)
 
-dontAddErrLoc :: String -> Message -> ErrMsg
-dontAddErrLoc title rest_of_err_msg
- | null title = (noSrcLoc, rest_of_err_msg)
- | otherwise  =
-    ( noSrcLoc, hang (text title <> colon) 4 rest_of_err_msg )
+dontAddErrLoc :: Message -> ErrMsg
+dontAddErrLoc msg = (noSrcLoc, msg)
 
-printErrorsAndWarnings :: (Bag WarnMsg, Bag ErrMsg) -> IO ()
+\end{code}
+
+
+\begin{code}
+type Messages = (Bag WarnMsg, Bag ErrMsg)
+
+errorsFound :: Messages -> Bool
+errorsFound (warns, errs) = not (isEmptyBag errs)
+
+printErrorsAndWarnings :: PrintUnqualified -> Messages -> IO ()
 	-- Don't print any warnings if there are errors
-printErrorsAndWarnings (warns, errs)
+printErrorsAndWarnings unqual (warns, errs)
   | no_errs && no_warns  = return ()
-  | no_errs		 = printErrs (pprBagOfWarnings warns)
-  | otherwise		 = printErrs (pprBagOfErrors   errs)
+  | no_errs		 = printErrs unqual (pprBagOfWarnings warns)
+  | otherwise		 = printErrs unqual (pprBagOfErrors   errs)
   where
     no_warns = isEmptyBag warns
     no_errs  = isEmptyBag errs
@@ -103,6 +109,11 @@ doIfSet_dyn dflags flag action | dopt flag dflags = action
 \end{code}
 
 \begin{code}
+showPass :: DynFlags -> String -> IO ()
+showPass dflags what
+  | dopt Opt_D_show_passes dflags = hPutStr stderr ("*** "++what++":\n")
+  | otherwise			  = return ()
+
 dumpIfSet :: Bool -> String -> SDoc -> IO ()
 dumpIfSet flag hdr doc
   | not flag   = return ()

ghc/compiler/main/HscMain.lhs

@@ -10,7 +10,7 @@ module HscMain ( HscResult(..), hscMain,
 #include "HsVersions.h"
 
 import Maybe		( isJust )
-import IO		( hPutStr, hPutStrLn, stderr )
+import IO		( hPutStrLn, stderr )
 import HsSyn
 
 import StringBuffer	( hGetStringBuffer )
@@ -39,7 +39,7 @@ import CodeOutput	( codeOutput )
 
 import Module		( ModuleName, moduleName, mkModuleInThisPackage )
 import CmdLineOpts
-import ErrUtils		( dumpIfSet_dyn )
+import ErrUtils		( dumpIfSet_dyn, showPass )
 import Util		( unJust )
 import UniqSupply	( mkSplitUniqSupply )
 
@@ -93,10 +93,11 @@ hscMain
 hscMain dflags source_unchanged location maybe_old_iface hst hit pcs
  = do {
       putStrLn "CHECKING OLD IFACE";
-      (pcs_ch, check_errs, (recomp_reqd, maybe_checked_iface))
+      (pcs_ch, errs_found, (recomp_reqd, maybe_checked_iface))
          <- checkOldIface dflags hit hst pcs (unJust (ml_hi_file location) "hscMain")
 			  source_unchanged maybe_old_iface;
-      if check_errs then
+
+      if errs_found then
          return (HscFail pcs_ch)
       else do {
 
@@ -126,8 +127,8 @@ hscNoRecomp dflags location maybe_checked_iface hst hit pcs_ch
       else do {
 
       -- TYPECHECK
-      maybe_tc_result
-         <- typecheckModule dflags this_mod pcs_cl hst old_iface cl_hs_decls;
+      maybe_tc_result <- typecheckModule dflags this_mod pcs_cl hst 
+					 old_iface alwaysQualify cl_hs_decls;
       case maybe_tc_result of {
          Nothing -> return (HscFail pcs_cl);
          Just tc_result -> do {
@@ -149,71 +150,81 @@ hscNoRecomp dflags location maybe_checked_iface hst hit pcs_ch
 
 
 hscRecomp dflags location maybe_checked_iface hst hit pcs_ch
- = do {
-      hPutStrLn stderr "COMPILATION IS REQUIRED";
-
-      -- what target are we shooting for?
-      let toInterp = dopt_HscLang dflags == HscInterpreted
-      ;
-      -- PARSE
-      maybe_parsed 
-         <- myParseModule dflags (unJust (ml_hspp_file location) "hscRecomp:hspp");
-      case maybe_parsed of {
-         Nothing -> return (HscFail pcs_ch);
-         Just rdr_module -> do {
-
-      -- RENAME
-      let this_mod = mkModuleInThisPackage (hsModuleName rdr_module)
-      ;
-      show_pass dflags "Renamer";
-      (pcs_rn, maybe_rn_result) 
-         <- renameModule dflags hit hst pcs_ch this_mod rdr_module;
-      case maybe_rn_result of {
-         Nothing -> return (HscFail pcs_rn);
-         Just (new_iface, rn_hs_decls) -> do {
-
-      -- TYPECHECK
-      show_pass dflags "Typechecker";
-      maybe_tc_result
-         <- typecheckModule dflags this_mod pcs_rn hst new_iface rn_hs_decls;
-      case maybe_tc_result of {
-         Nothing -> do { hPutStrLn stderr "Typechecked failed" 
-		       ; return (HscFail pcs_rn) } ;
-         Just tc_result -> do {
-
-      let pcs_tc        = tc_pcs tc_result
-          env_tc        = tc_env tc_result
-          local_insts   = tc_insts tc_result
-      ;
-      -- DESUGAR, SIMPLIFY, TIDY-CORE
-      -- We grab the the unfoldings at this point.
-      (tidy_binds, orphan_rules, foreign_stuff)
-         <- dsThenSimplThenTidy dflags (pcs_rules pcs_tc) this_mod tc_result hst
-      ;
-      -- CONVERT TO STG
-      (stg_binds, oa_tidy_binds, cost_centre_info, top_level_ids) 
-         <- myCoreToStg dflags this_mod tidy_binds
-      ;
-      -- cook up a new ModDetails now we (finally) have all the bits
-      let new_details = mkModDetails env_tc local_insts tidy_binds 
-			             top_level_ids orphan_rules
-      ;
-      -- and the final interface
-      final_iface 
-         <- mkFinalIface dflags location maybe_checked_iface new_iface new_details
-      ;
-      -- do the rest of code generation/emission
-      (maybe_stub_h_filename, maybe_stub_c_filename, maybe_ibinds)
-         <- restOfCodeGeneration dflags toInterp this_mod
-	       (map ideclName (hsModuleImports rdr_module))
-               cost_centre_info foreign_stuff env_tc stg_binds oa_tidy_binds
-               hit (pcs_PIT pcs_tc)       
-      ;
-      -- and the answer is ...
-      return (HscOK new_details (Just final_iface)
-		    maybe_stub_h_filename maybe_stub_c_filename
-                    maybe_ibinds pcs_tc)
-      }}}}}}}
+ = do	{
+      	; hPutStrLn stderr "COMPILATION IS REQUIRED";
+
+      	  -- what target are we shooting for?
+      	; let toInterp = dopt_HscLang dflags == HscInterpreted
+
+ 	    -------------------
+ 	    -- PARSE
+ 	    -------------------
+	; maybe_parsed <- myParseModule dflags (unJust (ml_hspp_file location) "hscRecomp:hspp")
+	; case maybe_parsed of {
+      	     Nothing -> return (HscFail pcs_ch);
+      	     Just rdr_module -> do {
+	; let this_mod = mkModuleInThisPackage (hsModuleName rdr_module)
+    
+ 	    -------------------
+ 	    -- RENAME
+ 	    -------------------
+	; (pcs_rn, maybe_rn_result) 
+      	     <- renameModule dflags hit hst pcs_ch this_mod rdr_module
+      	; case maybe_rn_result of {
+      	     Nothing -> return (HscFail pcs_rn);
+      	     Just (print_unqualified, new_iface, rn_hs_decls) -> do {
+    
+ 	    -------------------
+ 	    -- TYPECHECK
+ 	    -------------------
+	; maybe_tc_result <- typecheckModule dflags this_mod pcs_rn hst new_iface 
+					     print_unqualified rn_hs_decls
+	; case maybe_tc_result of {
+      	     Nothing -> do { hPutStrLn stderr "Typechecked failed" 
+ 			   ; return (HscFail pcs_rn) } ;
+      	     Just tc_result -> do {
+    
+	; let pcs_tc        = tc_pcs tc_result
+      	      env_tc        = tc_env tc_result
+      	      local_insts   = tc_insts tc_result
+
+ 	    -------------------
+ 	    -- DESUGAR, SIMPLIFY, TIDY-CORE
+ 	    -------------------
+      	  -- We grab the the unfoldings at this point.
+	; simpl_result <- dsThenSimplThenTidy dflags (pcs_rules pcs_tc) this_mod 
+ 					      print_unqualified tc_result hst
+	; let (tidy_binds, orphan_rules, foreign_stuff) = simpl_result
+      	    
+ 	    -------------------
+ 	    -- CONVERT TO STG
+ 	    -------------------
+	; (stg_binds, oa_tidy_binds, cost_centre_info, top_level_ids) 
+      	     <- myCoreToStg dflags this_mod tidy_binds
+
+
+ 	    -------------------
+ 	    -- BUILD THE NEW ModDetails AND ModIface
+ 	    -------------------
+	; let new_details = mkModDetails env_tc local_insts tidy_binds 
+ 					 top_level_ids orphan_rules
+	; final_iface <- mkFinalIface dflags location maybe_checked_iface 
+				      new_iface new_details
+
+ 	    -------------------
+ 	    -- COMPLETE CODE GENERATION
+ 	    -------------------
+	; (maybe_stub_h_filename, maybe_stub_c_filename, maybe_ibinds)
+      	     <- restOfCodeGeneration dflags toInterp this_mod
+ 		   (map ideclName (hsModuleImports rdr_module))
+      		   cost_centre_info foreign_stuff env_tc stg_binds oa_tidy_binds
+      		   hit (pcs_PIT pcs_tc)       
+
+      	  -- and the answer is ...
+	; return (HscOK new_details (Just final_iface)
+ 			maybe_stub_h_filename maybe_stub_c_filename
+      			maybe_ibinds pcs_tc)
+      	  }}}}}}}