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