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 cPutStr :: Handle -> CSeq -> IO ()
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!
130 This code is {\em hammered}. We are not above doing sleazy
131 non-standard things. (WDP 94/10)
134 data WorkItem = WI FAST_INT CSeq -- indentation, and sequence
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
142 flatten n nlp CNil seqs = flattenS nlp seqs
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
147 flatten n _FALSE_ CNewline seqs = '\n' : flattenS _TRUE_ seqs
148 flatten n _TRUE_ CNewline seqs = flattenS _TRUE_ seqs -- Already at start of line
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
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)
166 flattenS :: FAST_BOOL -> [WorkItem] -> String
168 flattenS nlp ((WI col seq):seqs) = flatten col nlp seq seqs
172 mkIndent :: FAST_INT -> String -> String
173 mkIndent ILIT(0) s = 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.
182 This code is massively {\em hammered}.
183 It {\em ignores} indentation.
185 (NB: 1.3 compiler: efficiency hacks removed for now!)
188 #if defined(COMPILING_GHC)
190 cPutStr handle sq = flat sq
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)
202 #endif {- COMPILING_GHC -}