[project @ 2002-03-14 16:22:31 by simonmar]

Misc cleanup: remove the iface pretty-printing style, and clean up
bits of StringBuffer that aren't required any more.

ghc/compiler/basicTypes/IdInfo.lhs

@@ -741,10 +741,7 @@ noLBVarInfo = NoLBVarInfo
 -- property of the definition, but a property of the context.
 pprLBVarInfo NoLBVarInfo     = empty
 pprLBVarInfo (LBVarInfo u)   | u `eqUsage` usOnce
-                             = getPprStyle $ \ sty ->
-                               if ifaceStyle sty
-                               then empty
-                               else ptext SLIT("OneShot")
+                             = ptext SLIT("OneShot")
                              | otherwise
                              = empty
 

ghc/compiler/basicTypes/Literal.lhs

@@ -367,7 +367,6 @@ pprLit lit
   = getPprStyle $ \ sty ->
     let
       code_style  = codeStyle  sty
-      iface_style = ifaceStyle sty
     in
     case lit of
       MachChar ch | code_style -> hcat [ptext SLIT("(C_)"), text (show ch)]
@@ -395,8 +394,7 @@ pprLit lit
       MachFloat f | code_style -> ptext SLIT("(StgFloat)") <> rational f
                   | otherwise  -> ptext SLIT("__float") <+> rational f
 
-      MachDouble d | iface_style && d < 0 -> parens (rational d)
-		   | otherwise            -> rational d
+      MachDouble d -> rational d
 
       MachAddr p | code_style -> ptext SLIT("(void*)") <> integer p
 	         | otherwise  -> ptext SLIT("__addr") <+> integer p

ghc/compiler/basicTypes/MkId.lhs

@@ -673,7 +673,7 @@ mkFCallId uniq fcall ty
 	-- when doing substitutions won't substitute over it
     mkGlobalId (FCallId fcall) name ty info
   where
-    occ_str = showSDocIface (braces (ppr fcall <+> ppr ty))
+    occ_str = showSDoc (braces (ppr fcall <+> ppr ty))
 	-- The "occurrence name" of a ccall is the full info about the
 	-- ccall; it is encoded, but may have embedded spaces etc!
 

ghc/compiler/basicTypes/Name.lhs

@@ -315,13 +315,11 @@ pprInternal sty uniq occ
   | codeStyle sty  = pprUnique uniq
   | debugStyle sty = pprOccName occ <> 
 		     text "{-" <> pprUnique uniq <> text "-}"
-  | otherwise      = pprOccName occ	-- User and Iface styles
+  | otherwise      = pprOccName occ	-- User style
 
 -- Like Internal, except that we only omit the unique in Iface style
 pprSystem sty uniq occ
   | codeStyle sty  = pprUnique uniq
-  | ifaceStyle sty = pprOccName occ	-- The tidy phase has ensured 
-					-- that OccNames are enough
   | otherwise	   = pprOccName occ <> char '_' <> pprUnique uniq
 				-- If the tidy phase hasn't run, the OccName
 				-- is unlikely to be informative (like 's'),

ghc/compiler/coreSyn/PprCore.lhs

@@ -260,7 +260,7 @@ ppr_expr add_par pe (Note (SCC cc) expr)
 ppr_expr add_par pe (Note (Coerce to_ty from_ty) expr)
  = add_par $
    getPprStyle $ \ sty ->
-   if debugStyle sty && not (ifaceStyle sty) then
+   if debugStyle sty then
       sep [ptext SLIT("__coerce") <+> sep [pTy pe to_ty, pTy pe from_ty],
 	   ppr_parend_expr pe expr]
    else

ghc/compiler/hsSyn/HsBinds.lhs

@@ -335,12 +335,9 @@ ppr_sig (Sig var ty _)
       = sep [ppr var <+> dcolon, nest 4 (ppr ty)]
 
 ppr_sig (ClassOpSig var dm ty _)
-      = getPprStyle $ \ sty ->
-        if ifaceStyle sty 
-	   then sep [ ppr var <+> pp_dm <+> dcolon, nest 4 (ppr ty) ]
-	   else sep [ ppr_var var <+> dcolon, 
-		      nest 4 (ppr ty),
-		      nest 4 (pp_dm_comment) ]
+      = sep [ ppr_var var <+> dcolon, 
+	      nest 4 (ppr ty),
+	      nest 4 (pp_dm_comment) ]
       where
 	pp_dm = case dm of 
 		  DefMeth _  -> equals 	-- Default method indicator

ghc/compiler/hsSyn/HsDecls.lhs

@@ -470,9 +470,7 @@ instance (NamedThing name, Outputable name, Outputable pat)
 
     ppr (IfaceSig {tcdName = var, tcdType = ty, tcdIdInfo = info})
 	= getPprStyle $ \ sty ->
-	   hsep [ if ifaceStyle sty then ppr var else ppr_var var,
-		  dcolon, ppr ty, pprHsIdInfo info
-		]
+	   hsep [ ppr_var var, dcolon, ppr ty, pprHsIdInfo info ]
 
     ppr (ForeignType {tcdName = tycon})
 	= hsep [ptext SLIT("foreign import type dotnet"), ppr tycon]
@@ -504,8 +502,7 @@ instance (NamedThing name, Outputable name, Outputable pat)
         top_matter  = ptext SLIT("class") <+> pp_decl_head context clas tyvars <+> pprFundeps fds
 	ppr_sig sig = ppr sig <> semi
 
-	pp_methods = getPprStyle $ \ sty ->
-        	     if ifaceStyle sty || isNothing methods
+	pp_methods = if isNothing methods
 			then empty
 			else ppr (fromJust methods)
         
@@ -629,9 +626,7 @@ ppr_con_details con (InfixCon ty1 ty2)
 -- we don't distinguish between the two.  Hence when printing these for the
 -- user, we need to parenthesise infix constructor names.
 ppr_con_details con (VanillaCon tys)
-  = getPprStyle $ \ sty ->
-    hsep ((if ifaceStyle sty then ppr con else ppr_var con)
-	  : map (ppr_bang) tys)
+  = hsep (ppr_var con : map (ppr_bang) tys)
 
 ppr_con_details con (RecCon fields)
   = ppr con <+> braces (sep (punctuate comma (map ppr_field fields)))
@@ -677,13 +672,9 @@ instance (Outputable name, Outputable pat)
 	      => Outputable (InstDecl name pat) where
 
     ppr (InstDecl inst_ty binds uprags maybe_dfun_name src_loc)
-      = getPprStyle $ \ sty ->
-        if ifaceStyle sty then
-           hsep [ptext SLIT("instance"), ppr inst_ty, equals, pp_dfun]
-	else
-	   vcat [hsep [ptext SLIT("instance"), ppr inst_ty, ptext SLIT("where")],
-	         nest 4 (ppr uprags),
-	         nest 4 (ppr binds) ]
+      = vcat [hsep [ptext SLIT("instance"), ppr inst_ty, ptext SLIT("where")],
+	      nest 4 (ppr uprags),
+	      nest 4 (ppr binds) ]
       where
 	pp_dfun = case maybe_dfun_name of
 		    Just df -> ppr df

ghc/compiler/main/HscMain.lhs

@@ -425,7 +425,7 @@ myParseModule dflags src_filename
       showPass dflags "Parser"
       _scc_  "Parser" do
 
-      buf <- hGetStringBuffer True{-expand tabs-} src_filename
+      buf <- hGetStringBuffer src_filename
 
       let exts = ExtFlags {glasgowExtsEF = dopt Opt_GlasgowExts dflags,
 			   parrEF	 = dopt Opt_PArr	dflags}

ghc/compiler/main/MkIface.lhs

@@ -551,17 +551,6 @@ dump_rules rs = vcat [ptext SLIT("{-# RULES"),
 %************************************************************************
 
 \begin{code}
-writeIface :: FilePath -> ModIface -> IO ()
-writeIface hi_path mod_iface
-  = do	{ if_hdl <- openFile hi_path WriteMode
-	; printForIface if_hdl from_this_mod (pprIface mod_iface)
-	; hClose if_hdl
-	}
-  where
-	-- Print names unqualified if they are from this module
-    from_this_mod n = nameModule n == this_mod
-    this_mod = mi_module mod_iface
-
 pprIface :: ModIface -> SDoc
 pprIface iface
  = vcat [ ptext SLIT("__interface")

ghc/compiler/main/ParsePkgConf.y

@@ -80,7 +80,7 @@ happyError buf PState{ loc = loc } = PFailed (srcParseErr buf loc)
 
 loadPackageConfig :: FilePath -> IO [PackageConfig]
 loadPackageConfig conf_filename = do
-   buf <- hGetStringBuffer False conf_filename
+   buf <- hGetStringBuffer conf_filename
    let loc  = mkSrcLoc (_PK_ conf_filename) 1
        exts = ExtFlags {glasgowExtsEF = False,
 			parrEF	      = False}

ghc/compiler/rename/RnHiFiles.lhs

@@ -570,7 +570,7 @@ readIface file_path
   if ".hi-boot" `isSuffixOf` file_path
      || hi_boot_ver `isSuffixOf` file_path then
 
-      ioToRnM (hGetStringBuffer False file_path) `thenRn` \ read_result ->
+      ioToRnM (hGetStringBuffer file_path) `thenRn` \ read_result ->
       case read_result of {
 	Left io_error  -> bale_out (text (show io_error));
 	Right contents -> 

ghc/compiler/types/PprType.lhs

@@ -220,7 +220,7 @@ and when in debug mode.
 pprTyVarBndr :: TyVar -> SDoc
 pprTyVarBndr tyvar
   = getPprStyle $ \ sty ->
-    if (ifaceStyle sty  && not (kind `eqKind` liftedTypeKind)) || debugStyle sty then
+    if debugStyle sty then
         hsep [ppr tyvar, dcolon, pprParendKind kind]
 		-- See comments with ppDcolon in PprCore.lhs
     else

ghc/compiler/utils/Outputable.lhs

@@ -13,7 +13,7 @@ module Outputable (
 
 	PprStyle, CodeStyle(..), PrintUnqualified, alwaysQualify,
 	getPprStyle, withPprStyle, withPprStyleDoc, pprDeeper,
-	codeStyle, ifaceStyle, userStyle, debugStyle, asmStyle,
+	codeStyle, userStyle, debugStyle, asmStyle,
 	ifPprDebug, unqualStyle,
 
 	SDoc, 		-- Abstract
@@ -33,9 +33,9 @@ module Outputable (
 	speakNth, speakNTimes,
 
 	printSDoc, printErrs, printDump,
-	printForC, printForAsm, printForIface, printForUser,
+	printForC, printForAsm, printForUser,
 	pprCode, mkCodeStyle,
-	showSDoc, showSDocForUser, showSDocDebug, showSDocIface, 
+	showSDoc, showSDocForUser, showSDocDebug,
 	showSDocUnqual, showsPrecSDoc,
 	pprHsChar, pprHsString,
 
@@ -151,10 +151,6 @@ asmStyle :: PprStyle -> Bool
 asmStyle (PprCode AsmStyle)  = True
 asmStyle other               = False
 
-ifaceStyle :: PprStyle -> Bool
-ifaceStyle (PprInterface _) = True
-ifaceStyle other	    = False
-
 debugStyle :: PprStyle -> Bool
 debugStyle PprDebug	  = True
 debugStyle other	  = False
@@ -191,12 +187,6 @@ printForUser :: Handle -> PrintUnqualified -> SDoc -> IO ()
 printForUser handle unqual doc 
   = Pretty.printDoc PageMode handle (doc (mkUserStyle unqual AllTheWay))
 
--- printForIface prints all on one line for interface files.
--- It's called repeatedly for successive lines
-printForIface :: Handle -> PrintUnqualified -> SDoc -> IO ()
-printForIface handle unqual doc 
-  = Pretty.printDoc LeftMode handle (doc (PprInterface unqual))
-
 -- printForC, printForAsm do what they sound like
 printForC :: Handle -> SDoc -> IO ()
 printForC handle doc = Pretty.printDoc LeftMode handle (doc (PprCode CStyle))
@@ -226,9 +216,6 @@ showSDocUnqual d = show (d (mkUserStyle neverQualify AllTheWay))
 showsPrecSDoc :: Int -> SDoc -> ShowS
 showsPrecSDoc p d = showsPrec p (d defaultUserStyle)
 
-showSDocIface :: SDoc -> String
-showSDocIface doc = showDocWith OneLineMode (doc (PprInterface alwaysQualify))
-
 showSDocDebug :: SDoc -> String
 showSDocDebug d = show (d PprDebug)
 \end{code}

ghc/compiler/utils/StringBuffer.lhs

@@ -59,12 +59,7 @@ module StringBuffer
 
          -- conversion
         lexemeToString,     -- :: StringBuffer -> String
-        lexemeToByteArray,  -- :: StringBuffer -> _ByteArray Int
         lexemeToFastString, -- :: StringBuffer -> FastString
-        lexemeToBuffer,     -- :: StringBuffer -> StringBuffer
-
-        FastString,
-	ByteArray
        ) where
 
 #include "HsVersions.h"
@@ -92,7 +87,6 @@ import FastString
 import GlaExts
 import Foreign
 import IO		( openFile, isEOFError )
-import IOExts		( slurpFile )
 import Addr
 import Exception	( bracket )
 
@@ -124,17 +118,9 @@ instance Show StringBuffer where
 \end{code}
 
 \begin{code}
-hGetStringBuffer :: Bool -> FilePath -> IO StringBuffer
-hGetStringBuffer expand_tabs fname = do
-   (a, read) <- if expand_tabs 
-				then slurpFileExpandTabs fname 
-#if __GLASGOW_HASKELL__ < 411
-				else slurpFile fname
-#else
-				else do
-				    (Ptr a#, read) <- slurpFile fname
-				    return (A# a#, read)
-#endif
+hGetStringBuffer :: FilePath -> IO StringBuffer
+hGetStringBuffer fname = do
+   (a, read) <- slurpFileExpandTabs fname 
 
 	-- urk! slurpFile gives us a buffer that doesn't have room for
 	-- the sentinel.  Assume it has a final newline for now, and overwrite
@@ -289,9 +275,6 @@ trySlurp handle sz_i chunk =
 	-- and add 1 to allow room for the final sentinel \NUL at
 	-- the end of the file.
   (chunk', rc) <- slurpFile 0# 0# chunk chunk_sz (chunk_sz -# (tAB_SIZE +# 1#))
-#if __GLASGOW_HASKELL__ < 404
-  writeHandle handle handle_
-#endif
   return (chunk', rc+1 {- room for sentinel -})
 
 
@@ -513,32 +496,10 @@ lexemeToString (StringBuffer fo _ start_pos# current#) =
  else
     unpackCStringBA (copySubStr (A# fo) (I# start_pos#) (I# (current# -# start_pos#)))
     
-lexemeToByteArray :: StringBuffer -> ByteArray Int
-lexemeToByteArray (StringBuffer fo _ start_pos# current#) = 
- if start_pos# ==# current# then
-    error "lexemeToByteArray" 
- else
-    copySubStr (A# fo) (I# start_pos#) (I# (current# -# start_pos#))
-
 lexemeToFastString :: StringBuffer -> FastString
 lexemeToFastString (StringBuffer fo l# start_pos# current#) =
  if start_pos# ==# current# then
     mkFastString ""
  else
     mkFastSubString (A# fo) (I# start_pos#) (I# (current# -# start_pos#))
-
-{-
- Create a StringBuffer from the current lexeme, and add a sentinel
- at the end. Know What You're Doing before taking this function
- into use..
--}
-lexemeToBuffer :: StringBuffer -> StringBuffer
-lexemeToBuffer (StringBuffer fo l# start_pos# current#) =
- if start_pos# ==# current# then
-    StringBuffer fo 0# start_pos# current# -- an error, really. 
- else
-    unsafeWriteBuffer (StringBuffer fo (current# -# start_pos#) start_pos# start_pos#)
-		      (current# -# 1#)
-		      '\NUL'#
-
 \end{code}