2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
4 \section[CharSeq]{Characters sequences: the @CSeq@ type}
7 #if defined(COMPILING_GHC)
8 # include "HsVersions.h"
10 # define FAST_STRING String
17 # define FAST_BOOL Bool
19 # define _FALSE_ False
24 cNil, cAppend, cIndent, cNL, cStr, cPStr, cCh, cInt,
25 #if ! defined(COMPILING_GHC)
31 #if defined(COMPILING_GHC) && __GLASGOW_HASKELL__ >= 22
35 #if __GLASGOW_HASKELL__ < 26
45 %************************************************
47 \subsection{The interface}
49 %************************************************
52 cShow :: CSeq -> [Char]
54 #if ! defined(COMPILING_GHC)
56 cShows :: CSeq -> ShowS
57 cLength :: CSeq -> Int
61 cAppend :: CSeq -> CSeq -> CSeq
62 cIndent :: Int -> CSeq -> CSeq
64 cStr :: [Char] -> CSeq
65 cPStr :: FAST_STRING -> CSeq
69 #if defined(COMPILING_GHC) && __GLASGOW_HASKELL__ >= 22
71 # if __GLASGOW_HASKELL__ < 23
75 cAppendFile :: _FILE -> CSeq -> PrimIO ()
79 %************************************************
81 \subsection{The representation}
83 %************************************************
90 | CNewline -- Move to start of next line, unless we're
91 -- already at the start of a line.
94 | CInt Int -- equiv to "CStr (show the_int)"
95 #if defined(COMPILING_GHC) && __GLASGOW_HASKELL__ >= 23
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.
108 The following special cases were eating our lunch! They make the whole
109 thing too strict. A classic strictness bug!
111 -- cAppend CNil cs2 = cs2
112 -- cAppend cs1 CNil = cs1
114 cAppend cs1 cs2 = CAppend cs1 cs2
116 cIndent n cs = CIndent n cs
123 #if defined(COMPILING_GHC) && __GLASGOW_HASKELL__ >= 23
129 cShow seq = flatten ILIT(0) _TRUE_ seq []
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!
136 #if defined(COMPILING_GHC) && __GLASGOW_HASKELL__ >= 22
137 cAppendFile file_star seq
138 = flattenIO file_star seq
142 This code is {\em hammered}. We are not above doing sleazy
143 non-standard things. (WDP 94/10)
146 data WorkItem = WI FAST_INT CSeq -- indentation, and sequence
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
154 flatten n nlp CNil seqs = flattenS nlp seqs
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
159 flatten n _FALSE_ CNewline seqs = '\n' : flattenS _TRUE_ seqs
160 flatten n _TRUE_ CNewline seqs = flattenS _TRUE_ seqs -- Already at start of line
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
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)
178 flattenS :: FAST_BOOL -> [WorkItem] -> String
180 flattenS nlp ((WI col seq):seqs) = flatten col nlp seq seqs
184 mkIndent :: FAST_INT -> String -> String
185 mkIndent ILIT(0) s = 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.
194 This code is massively {\em hammered}.
195 It {\em ignores} indentation.
198 #if defined(COMPILING_GHC) && __GLASGOW_HASKELL__ >= 22
200 flattenIO :: _FILE -- file we are writing to
201 -> CSeq -- Seq to print
205 # if __GLASGOW_HASKELL__ >= 23
206 | file == ``NULL'' = error "panic:flattenIO" -- really just to force eval :-)
211 flat CNil = BSCC("flatCNil") returnPrimIO () ESCC
213 flat (CIndent n2 seq) = BSCC("flatCIndent") flat seq ESCC
215 flat (CAppend seq1 seq2)
216 = BSCC("flatCAppend")
217 flat seq1 `seqPrimIO` flat seq2
220 flat CNewline = BSCC("flatCNL") _ccall_ stg_putc '\n' file ESCC
222 flat (CCh c) = BSCC("flatCCh") _ccall_ stg_putc c file ESCC
224 flat (CInt i) = BSCC("flatCInt") _ccall_ fprintf file percent_d i ESCC
226 flat (CStr s) = BSCC("flatCStr") put_str s ESCC
228 # if defined(COMPILING_GHC) && __GLASGOW_HASKELL__ >= 23
229 flat (CPStr s) = BSCC("flatCPStr") put_pstr s ESCC
233 put_str, put_str2 :: String -> PrimIO ()
236 = --put_str2 ``stderr'' (str ++ "\n") `seqPrimIO`
239 put_str2 [] = BSCC("putNil") returnPrimIO () ESCC
241 put_str2 (c1@(C# _) : c2@(C# _) : c3@(C# _) : c4@(C# _) : cs)
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)
250 put_str2 (c1@(C# _) : c2@(C# _) : c3@(C# _) : cs)
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)
258 put_str2 (c1@(C# _) : c2@(C# _) : cs)
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)
265 put_str2 (c1@(C# _) : cs)
267 _ccall_ stg_putc c1 file `seqPrimIO`
268 put_str2 cs -- efficiency hack? who knows... (WDP 94/10)
271 # if __GLASGOW_HASKELL__ >= 23
272 put_pstr ps = _putPS file ps
275 # if __GLASGOW_HASKELL__ >= 23
276 percent_d = _psToByteArray SLIT("%d")
281 #endif {- __GLASGOW_HASKELL__ >= 22 -}