ghc/lib/ghc/CharSeq.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
   3 %
   4 \section[CharSeq]{Characters sequences: the @CSeq@ type}
   5
   6 \begin{code}
   7 #if defined(COMPILING_GHC)
   8 # include "HsVersions.h"
   9 #else
  10 # define FAST_STRING String
  11 # define FAST_INT    Int
  12 # define ILIT(x)     (x)
  13 # define IBOX(x)     (x)
  14 # define _GE_        >=
  15 # define _ADD_       +
  16 # define _SUB_       -
  17 # define FAST_BOOL   Bool
  18 # define _TRUE_      True
  19 # define _FALSE_     False
  20 #endif
  21
  22 module CharSeq (
  23         CSeq,
  24         cNil, cAppend, cIndent, cNL, cStr, cPStr, cCh, cInt,
  25 #if ! defined(COMPILING_GHC)
  26         cLength,
  27         cShows,
  28 #endif
  29         cShow
  30
  31 #if defined(COMPILING_GHC) && __GLASGOW_HASKELL__ >= 22
  32         , cAppendFile
  33    ) where
  34
  35 #if __GLASGOW_HASKELL__ < 26
  36 import PreludePrimIO
  37 #endif
  38 import PreludeGlaST
  39
  40 #else
  41    ) where
  42 #endif
  43 \end{code}
  44
  45 %************************************************
  46 %*                                              *
  47         \subsection{The interface}
  48 %*                                              *
  49 %************************************************
  50
  51 \begin{code}
  52 cShow   :: CSeq -> [Char]
  53
  54 #if ! defined(COMPILING_GHC)
  55 -- not used in GHC
  56 cShows  :: CSeq -> ShowS
  57 cLength :: CSeq -> Int
  58 #endif
  59
  60 cNil    :: CSeq
  61 cAppend :: CSeq -> CSeq -> CSeq
  62 cIndent :: Int -> CSeq -> CSeq
  63 cNL     :: CSeq
  64 cStr    :: [Char] -> CSeq
  65 cPStr   :: FAST_STRING -> CSeq
  66 cCh     :: Char -> CSeq
  67 cInt    :: Int -> CSeq
  68
  69 #if defined(COMPILING_GHC) && __GLASGOW_HASKELL__ >= 22
  70
  71 # if __GLASGOW_HASKELL__ < 23
  72 #  define _FILE _Addr
  73 # endif
  74
  75 cAppendFile :: _FILE -> CSeq -> PrimIO ()
  76 #endif
  77 \end{code}
  78
  79 %************************************************
  80 %*                                              *
  81         \subsection{The representation}
  82 %*                                              *
  83 %************************************************
  84
  85 \begin{code}
  86 data CSeq
  87   = CNil
  88   | CAppend     CSeq CSeq
  89   | CIndent     Int  CSeq
  90   | CNewline                    -- Move to start of next line, unless we're
  91                                 -- already at the start of a line.
  92   | CStr        [Char]
  93   | CCh         Char
  94   | CInt        Int     -- equiv to "CStr (show the_int)"
  95 #if defined(COMPILING_GHC) && __GLASGOW_HASKELL__ >= 23
  96   | CPStr       _PackedString
  97 #endif
  98 \end{code}
  99
 100 The construction functions do pattern matching, to ensure that
 101 redundant CNils are eliminated.  This is bound to have some effect on
 102 evaluation order, but quite what I don't know.
 103
 104 \begin{code}
 105 cNil = CNil
 106 \end{code}
 107
 108 The following special cases were eating our lunch! They make the whole
 109 thing too strict.  A classic strictness bug!
 110 \begin{code}
 111 -- cAppend CNil cs2  = cs2
 112 -- cAppend cs1  CNil = cs1
 113
 114 cAppend cs1 cs2 = CAppend cs1 cs2
 115
 116 cIndent n cs = CIndent n cs
 117
 118 cNL     = CNewline
 119 cStr    = CStr
 120 cCh     = CCh
 121 cInt    = CInt
 122
 123 #if defined(COMPILING_GHC) && __GLASGOW_HASKELL__ >= 23
 124 cPStr   = CPStr
 125 #else
 126 cPStr   = CStr
 127 #endif
 128
 129 cShow  seq      = flatten ILIT(0) _TRUE_ seq []
 130
 131 #if ! defined(COMPILING_GHC)
 132 cShows seq rest = cShow seq ++ rest
 133 cLength seq = length (cShow seq) -- *not* the best way to do this!
 134 #endif
 135
 136 #if defined(COMPILING_GHC) && __GLASGOW_HASKELL__ >= 22
 137 cAppendFile file_star seq
 138   = flattenIO file_star seq
 139 #endif
 140 \end{code}
 141
 142 This code is {\em hammered}.  We are not above doing sleazy
 143 non-standard things.  (WDP 94/10)
 144
 145 \begin{code}
 146 data WorkItem = WI FAST_INT CSeq -- indentation, and sequence
 147
 148 flatten :: FAST_INT     -- Indentation
 149         -> FAST_BOOL    -- True => just had a newline
 150         -> CSeq         -- Current seq to flatten
 151         -> [WorkItem]   -- Work list with indentation
 152         -> String
 153
 154 flatten n nlp CNil seqs = flattenS nlp seqs
 155
 156 flatten n nlp (CAppend seq1 seq2) seqs = flatten n nlp seq1 ((WI n seq2) : seqs)
 157 flatten n nlp (CIndent IBOX(n2) seq) seqs = flatten (n2 _ADD_ n) nlp seq seqs
 158
 159 flatten n _FALSE_ CNewline seqs = '\n' : flattenS _TRUE_ seqs
 160 flatten n _TRUE_  CNewline seqs = flattenS _TRUE_ seqs  -- Already at start of line
 161
 162 flatten n _FALSE_ (CStr s) seqs = s ++ flattenS _FALSE_ seqs
 163 flatten n _FALSE_ (CCh  c) seqs = c :  flattenS _FALSE_ seqs
 164 flatten n _FALSE_ (CInt i) seqs = show i ++ flattenS _FALSE_ seqs
 165 #if defined(COMPILING_GHC) && __GLASGOW_HASKELL__ >= 23
 166 flatten n _FALSE_ (CPStr s) seqs = _unpackPS s ++ flattenS _FALSE_ seqs
 167 #endif
 168
 169 flatten n _TRUE_  (CStr s) seqs = mkIndent n (s ++ flattenS _FALSE_ seqs)
 170 flatten n _TRUE_  (CCh  c) seqs = mkIndent n (c :  flattenS _FALSE_ seqs)
 171 flatten n _TRUE_  (CInt i) seqs = mkIndent n (show i ++ flattenS _FALSE_ seqs)
 172 #if defined(COMPILING_GHC) && __GLASGOW_HASKELL__ >= 23
 173 flatten n _TRUE_ (CPStr s) seqs = mkIndent n (_unpackPS s ++ flattenS _FALSE_ seqs)
 174 #endif
 175 \end{code}
 176
 177 \begin{code}
 178 flattenS :: FAST_BOOL -> [WorkItem] -> String
 179 flattenS nlp [] = ""
 180 flattenS nlp ((WI col seq):seqs) = flatten col nlp seq seqs
 181 \end{code}
 182
 183 \begin{code}
 184 mkIndent :: FAST_INT -> String -> String
 185 mkIndent ILIT(0) s = s
 186 mkIndent n       s
 187   = if (n _GE_ ILIT(8))
 188     then '\t' : mkIndent (n _SUB_ ILIT(8)) s
 189     else ' '  : mkIndent (n _SUB_ ILIT(1)) s
 190     -- Hmm.. a little Unix-y.
 191 \end{code}
 192
 193 Now the I/O version.
 194 This code is massively {\em hammered}.
 195 It {\em ignores} indentation.
 196
 197 \begin{code}
 198 #if defined(COMPILING_GHC) && __GLASGOW_HASKELL__ >= 22
 199
 200 flattenIO :: _FILE      -- file we are writing to
 201           -> CSeq       -- Seq to print
 202           -> PrimIO ()
 203
 204 flattenIO file sq
 205 # if __GLASGOW_HASKELL__ >= 23
 206   | file == ``NULL'' = error "panic:flattenIO" -- really just to force eval :-)
 207   | otherwise
 208 # endif
 209   = flat sq
 210   where
 211     flat CNil = BSCC("flatCNil") returnPrimIO () ESCC
 212
 213     flat (CIndent n2 seq) = BSCC("flatCIndent") flat seq ESCC
 214
 215     flat (CAppend seq1 seq2)
 216       = BSCC("flatCAppend")
 217         flat seq1 `seqPrimIO` flat seq2
 218         ESCC
 219
 220     flat CNewline = BSCC("flatCNL") _ccall_ stg_putc '\n' file ESCC
 221
 222     flat (CCh c) = BSCC("flatCCh") _ccall_ stg_putc c file ESCC
 223
 224     flat (CInt i) = BSCC("flatCInt") _ccall_ fprintf file percent_d i ESCC
 225
 226     flat (CStr s) = BSCC("flatCStr") put_str s ESCC
 227
 228 # if defined(COMPILING_GHC) && __GLASGOW_HASKELL__ >= 23
 229     flat (CPStr s) = BSCC("flatCPStr") put_pstr s ESCC
 230 # endif
 231
 232     -----
 233     put_str, put_str2 :: String -> PrimIO ()
 234
 235     put_str str
 236       = --put_str2 ``stderr'' (str ++ "\n") `seqPrimIO`
 237         put_str2                str
 238
 239     put_str2 [] = BSCC("putNil") returnPrimIO () ESCC
 240
 241     put_str2 (c1@(C# _) : c2@(C# _) : c3@(C# _) : c4@(C# _) : cs)
 242       = BSCC("put4")
 243         _ccall_ stg_putc  c1 file       `seqPrimIO`
 244         _ccall_ stg_putc  c2 file       `seqPrimIO`
 245         _ccall_ stg_putc  c3 file       `seqPrimIO`
 246         _ccall_ stg_putc  c4 file       `seqPrimIO`
 247         put_str2 cs     -- efficiency hack?  who knows... (WDP 94/10)
 248         ESCC
 249
 250     put_str2 (c1@(C# _) : c2@(C# _) : c3@(C# _) : cs)
 251       = BSCC("put3")
 252         _ccall_ stg_putc  c1 file       `seqPrimIO`
 253         _ccall_ stg_putc  c2 file       `seqPrimIO`
 254         _ccall_ stg_putc  c3 file       `seqPrimIO`
 255         put_str2 cs     -- efficiency hack?  who knows... (WDP 94/10)
 256         ESCC
 257
 258     put_str2 (c1@(C# _) : c2@(C# _) : cs)
 259       = BSCC("put2")
 260         _ccall_ stg_putc  c1 file       `seqPrimIO`
 261         _ccall_ stg_putc  c2 file       `seqPrimIO`
 262         put_str2 cs     -- efficiency hack?  who knows... (WDP 94/10)
 263         ESCC
 264
 265     put_str2 (c1@(C# _) : cs)
 266       = BSCC("put1")
 267         _ccall_ stg_putc  c1 file       `seqPrimIO`
 268         put_str2 cs     -- efficiency hack?  who knows... (WDP 94/10)
 269         ESCC
 270
 271 # if __GLASGOW_HASKELL__ >= 23
 272     put_pstr ps = _putPS file ps
 273 # endif
 274
 275 # if __GLASGOW_HASKELL__ >= 23
 276 percent_d = _psToByteArray SLIT("%d")
 277 # else
 278 percent_d = "%d"
 279 # endif
 280
 281 #endif {- __GLASGOW_HASKELL__ >= 22 -}
 282 \end{code}