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)
37 CHK_Ubiq() -- debugging consistency check
43 %************************************************
45 \subsection{The interface}
47 %************************************************
50 cShow :: CSeq -> [Char]
52 #if ! defined(COMPILING_GHC)
54 cShows :: CSeq -> ShowS
55 cLength :: CSeq -> Int
59 cAppend :: CSeq -> CSeq -> CSeq
60 cIndent :: Int -> CSeq -> CSeq
62 cStr :: [Char] -> CSeq
63 cPStr :: FAST_STRING -> CSeq
67 #if defined(COMPILING_GHC)
68 cAppendFile :: _FILE -> CSeq -> PrimIO ()
72 %************************************************
74 \subsection{The representation}
76 %************************************************
83 | CNewline -- Move to start of next line, unless we're
84 -- already at the start of a line.
87 | CInt Int -- equiv to "CStr (show the_int)"
88 #if defined(COMPILING_GHC)
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.
101 The following special cases were eating our lunch! They make the whole
102 thing too strict. A classic strictness bug!
104 -- cAppend CNil cs2 = cs2
105 -- cAppend cs1 CNil = cs1
107 cAppend cs1 cs2 = CAppend cs1 cs2
109 cIndent n cs = CIndent n cs
116 #if defined(COMPILING_GHC)
122 cShow seq = flatten ILIT(0) _TRUE_ seq []
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!
129 #if defined(COMPILING_GHC)
130 cAppendFile file_star seq
131 = flattenIO file_star seq
135 This code is {\em hammered}. We are not above doing sleazy
136 non-standard things. (WDP 94/10)
139 data WorkItem = WI FAST_INT CSeq -- indentation, and sequence
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
147 flatten n nlp CNil seqs = flattenS nlp seqs
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
152 flatten n _FALSE_ CNewline seqs = '\n' : flattenS _TRUE_ seqs
153 flatten n _TRUE_ CNewline seqs = flattenS _TRUE_ seqs -- Already at start of line
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
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)
171 flattenS :: FAST_BOOL -> [WorkItem] -> String
173 flattenS nlp ((WI col seq):seqs) = flatten col nlp seq seqs
177 mkIndent :: FAST_INT -> String -> String
178 mkIndent ILIT(0) s = 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.
187 This code is massively {\em hammered}.
188 It {\em ignores} indentation.
191 #if defined(COMPILING_GHC)
193 flattenIO :: _FILE -- file we are writing to
194 -> CSeq -- Seq to print
198 | file == ``NULL'' = error "panic:flattenIO" -- really just to force eval :-)
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
212 put_str, put_str2 :: String -> PrimIO ()
215 = --put_str2 ``stderr'' (str ++ "\n") `seqPrimIO`
218 put_str2 [] = returnPrimIO ()
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)
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)
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)
238 put_str2 (c1@(C# _) : cs)
239 = _ccall_ stg_putc c1 file `seqPrimIO`
240 put_str2 cs -- efficiency hack? who knows... (WDP 94/10)
242 put_pstr ps = _putPS file ps
244 percent_d = _psToByteArray SLIT("%d")
246 #endif {- COMPILING_GHC -}