Commit 0e8e53db authored by simonmar's avatar simonmar
Browse files

[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.
parent 8c845163
......@@ -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
......
......@@ -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
......
......@@ -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!
......
......@@ -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'),
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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}
......
......@@ -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")
......
......@@ -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}
......
......@@ -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 ->
......
......@@ -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
......
......@@ -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}
......
......@@ -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}
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment