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         , cPutStr
  35    ) where
  36
  37 CHK_Ubiq() -- debugging consistency check
  38 IMPORT_1_3(IO)
  39
  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 cPutStr :: Handle -> 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       FAST_STRING
  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 \end{code}
 129
 130 This code is {\em hammered}.  We are not above doing sleazy
 131 non-standard things.  (WDP 94/10)
 132
 133 \begin{code}
 134 data WorkItem = WI FAST_INT CSeq -- indentation, and sequence
 135
 136 flatten :: FAST_INT     -- Indentation
 137         -> FAST_BOOL    -- True => just had a newline
 138         -> CSeq         -- Current seq to flatten
 139         -> [WorkItem]   -- Work list with indentation
 140         -> String
 141
 142 flatten n nlp CNil seqs = flattenS nlp seqs
 143
 144 flatten n nlp (CAppend seq1 seq2) seqs = flatten n nlp seq1 ((WI n seq2) : seqs)
 145 flatten n nlp (CIndent IBOX(n2) seq) seqs = flatten (n2 _ADD_ n) nlp seq seqs
 146
 147 flatten n _FALSE_ CNewline seqs = '\n' : flattenS _TRUE_ seqs
 148 flatten n _TRUE_  CNewline seqs = flattenS _TRUE_ seqs  -- Already at start of line
 149
 150 flatten n _FALSE_ (CStr s) seqs = s ++ flattenS _FALSE_ seqs
 151 flatten n _FALSE_ (CCh  c) seqs = c :  flattenS _FALSE_ seqs
 152 flatten n _FALSE_ (CInt i) seqs = show i ++ flattenS _FALSE_ seqs
 153 #if defined(COMPILING_GHC)
 154 flatten n _FALSE_ (CPStr s) seqs = _UNPK_ s ++ flattenS _FALSE_ seqs
 155 #endif
 156
 157 flatten n _TRUE_  (CStr s) seqs = mkIndent n (s ++ flattenS _FALSE_ seqs)
 158 flatten n _TRUE_  (CCh  c) seqs = mkIndent n (c :  flattenS _FALSE_ seqs)
 159 flatten n _TRUE_  (CInt i) seqs = mkIndent n (show i ++ flattenS _FALSE_ seqs)
 160 #if defined(COMPILING_GHC)
 161 flatten n _TRUE_ (CPStr s) seqs = mkIndent n ( _UNPK_ s ++ flattenS _FALSE_ seqs)
 162 #endif
 163 \end{code}
 164
 165 \begin{code}
 166 flattenS :: FAST_BOOL -> [WorkItem] -> String
 167 flattenS nlp [] = ""
 168 flattenS nlp ((WI col seq):seqs) = flatten col nlp seq seqs
 169 \end{code}
 170
 171 \begin{code}
 172 mkIndent :: FAST_INT -> String -> String
 173 mkIndent ILIT(0) s = s
 174 mkIndent n       s
 175   = if (n _GE_ ILIT(8))
 176     then '\t' : mkIndent (n _SUB_ ILIT(8)) s
 177     else ' '  : mkIndent (n _SUB_ ILIT(1)) s
 178     -- Hmm.. a little Unix-y.
 179 \end{code}
 180
 181 Now the I/O version.
 182 This code is massively {\em hammered}.
 183 It {\em ignores} indentation.
 184
 185 (NB: 1.3 compiler: efficiency hacks removed for now!)
 186
 187 \begin{code}
 188 #if defined(COMPILING_GHC)
 189
 190 cPutStr handle sq = flat sq
 191   where
 192     flat CNil             = return ()
 193     flat (CIndent n2 seq) = flat seq
 194     flat (CAppend s1 s2)  = flat s1 >> flat s2
 195     flat CNewline         = hPutChar handle '\n'
 196     flat (CCh c)          = hPutChar handle c
 197     flat (CInt i)         = hPutStr  handle (show i)
 198     flat (CStr s)         = hPutStr  handle s
 199     flat (CPStr s)        = hPutFS   handle s
 200                             --hPutStr  handle (_UNPK_ s)
 201
 202 #endif {- COMPILING_GHC -}
 203 \end{code}