--- /dev/null
+%
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
+%
+\section[CharSeq]{Characters sequences: the @CSeq@ type}
+
+\begin{code}
+#if defined(COMPILING_GHC)
+# include "HsVersions.h"
+#else
+# define FAST_STRING String
+# define FAST_INT Int
+# define ILIT(x) (x)
+# define IBOX(x) (x)
+# define _GE_ >=
+# define _ADD_ +
+# define _SUB_ -
+# define FAST_BOOL Bool
+# define _TRUE_ True
+# define _FALSE_ False
+#endif
+
+module CharSeq (
+ CSeq,
+ cNil, cAppend, cIndent, cNL, cStr, cPStr, cCh, cInt,
+#if ! defined(COMPILING_GHC)
+ cLength,
+ cShows,
+#endif
+ cShow
+
+#if defined(COMPILING_GHC) && __GLASGOW_HASKELL__ >= 22
+ , cAppendFile
+ ) where
+
+#if __GLASGOW_HASKELL__ < 26
+import PreludePrimIO
+#endif
+import PreludeGlaST
+
+#else
+ ) where
+#endif
+\end{code}
+
+%************************************************
+%* *
+ \subsection{The interface}
+%* *
+%************************************************
+
+\begin{code}
+cShow :: CSeq -> [Char]
+
+#if ! defined(COMPILING_GHC)
+-- not used in GHC
+cShows :: CSeq -> ShowS
+cLength :: CSeq -> Int
+#endif
+
+cNil :: CSeq
+cAppend :: CSeq -> CSeq -> CSeq
+cIndent :: Int -> CSeq -> CSeq
+cNL :: CSeq
+cStr :: [Char] -> CSeq
+cPStr :: FAST_STRING -> CSeq
+cCh :: Char -> CSeq
+cInt :: Int -> CSeq
+
+#if defined(COMPILING_GHC) && __GLASGOW_HASKELL__ >= 22
+
+# if __GLASGOW_HASKELL__ < 23
+# define _FILE _Addr
+# endif
+
+cAppendFile :: _FILE -> CSeq -> PrimIO ()
+#endif
+\end{code}
+
+%************************************************
+%* *
+ \subsection{The representation}
+%* *
+%************************************************
+
+\begin{code}
+data CSeq
+ = CNil
+ | CAppend CSeq CSeq
+ | CIndent Int CSeq
+ | CNewline -- Move to start of next line, unless we're
+ -- already at the start of a line.
+ | CStr [Char]
+ | CCh Char
+ | CInt Int -- equiv to "CStr (show the_int)"
+#if defined(COMPILING_GHC) && __GLASGOW_HASKELL__ >= 23
+ | CPStr _PackedString
+#endif
+\end{code}
+
+The construction functions do pattern matching, to ensure that
+redundant CNils are eliminated. This is bound to have some effect on
+evaluation order, but quite what I don't know.
+
+\begin{code}
+cNil = CNil
+\end{code}
+
+The following special cases were eating our lunch! They make the whole
+thing too strict. A classic strictness bug!
+\begin{code}
+-- cAppend CNil cs2 = cs2
+-- cAppend cs1 CNil = cs1
+
+cAppend cs1 cs2 = CAppend cs1 cs2
+
+cIndent n cs = CIndent n cs
+
+cNL = CNewline
+cStr = CStr
+cCh = CCh
+cInt = CInt
+
+#if defined(COMPILING_GHC) && __GLASGOW_HASKELL__ >= 23
+cPStr = CPStr
+#else
+cPStr = CStr
+#endif
+
+cShow seq = flatten ILIT(0) _TRUE_ seq []
+
+#if ! defined(COMPILING_GHC)
+cShows seq rest = cShow seq ++ rest
+cLength seq = length (cShow seq) -- *not* the best way to do this!
+#endif
+
+#if defined(COMPILING_GHC) && __GLASGOW_HASKELL__ >= 22
+cAppendFile file_star seq
+ = flattenIO file_star seq
+#endif
+\end{code}
+
+This code is {\em hammered}. We are not above doing sleazy
+non-standard things. (WDP 94/10)
+
+\begin{code}
+data WorkItem = WI FAST_INT CSeq -- indentation, and sequence
+
+flatten :: FAST_INT -- Indentation
+ -> FAST_BOOL -- True => just had a newline
+ -> CSeq -- Current seq to flatten
+ -> [WorkItem] -- Work list with indentation
+ -> String
+
+flatten n nlp CNil seqs = flattenS nlp seqs
+
+flatten n nlp (CAppend seq1 seq2) seqs = flatten n nlp seq1 ((WI n seq2) : seqs)
+flatten n nlp (CIndent IBOX(n2) seq) seqs = flatten (n2 _ADD_ n) nlp seq seqs
+
+flatten n _FALSE_ CNewline seqs = '\n' : flattenS _TRUE_ seqs
+flatten n _TRUE_ CNewline seqs = flattenS _TRUE_ seqs -- Already at start of line
+
+flatten n _FALSE_ (CStr s) seqs = s ++ flattenS _FALSE_ seqs
+flatten n _FALSE_ (CCh c) seqs = c : flattenS _FALSE_ seqs
+flatten n _FALSE_ (CInt i) seqs = show i ++ flattenS _FALSE_ seqs
+#if defined(COMPILING_GHC) && __GLASGOW_HASKELL__ >= 23
+flatten n _FALSE_ (CPStr s) seqs = _unpackPS s ++ flattenS _FALSE_ seqs
+#endif
+
+flatten n _TRUE_ (CStr s) seqs = mkIndent n (s ++ flattenS _FALSE_ seqs)
+flatten n _TRUE_ (CCh c) seqs = mkIndent n (c : flattenS _FALSE_ seqs)
+flatten n _TRUE_ (CInt i) seqs = mkIndent n (show i ++ flattenS _FALSE_ seqs)
+#if defined(COMPILING_GHC) && __GLASGOW_HASKELL__ >= 23
+flatten n _TRUE_ (CPStr s) seqs = mkIndent n (_unpackPS s ++ flattenS _FALSE_ seqs)
+#endif
+\end{code}
+
+\begin{code}
+flattenS :: FAST_BOOL -> [WorkItem] -> String
+flattenS nlp [] = ""
+flattenS nlp ((WI col seq):seqs) = flatten col nlp seq seqs
+\end{code}
+
+\begin{code}
+mkIndent :: FAST_INT -> String -> String
+mkIndent ILIT(0) s = s
+mkIndent n s
+ = if (n _GE_ ILIT(8))
+ then '\t' : mkIndent (n _SUB_ ILIT(8)) s
+ else ' ' : mkIndent (n _SUB_ ILIT(1)) s
+ -- Hmm.. a little Unix-y.
+\end{code}
+
+Now the I/O version.
+This code is massively {\em hammered}.
+It {\em ignores} indentation.
+
+\begin{code}
+#if defined(COMPILING_GHC) && __GLASGOW_HASKELL__ >= 22
+
+flattenIO :: _FILE -- file we are writing to
+ -> CSeq -- Seq to print
+ -> PrimIO ()
+
+flattenIO file sq
+# if __GLASGOW_HASKELL__ >= 23
+ | file == ``NULL'' = error "panic:flattenIO" -- really just to force eval :-)
+ | otherwise
+# endif
+ = flat sq
+ where
+ flat CNil = BSCC("flatCNil") returnPrimIO () ESCC
+
+ flat (CIndent n2 seq) = BSCC("flatCIndent") flat seq ESCC
+
+ flat (CAppend seq1 seq2)
+ = BSCC("flatCAppend")
+ flat seq1 `seqPrimIO` flat seq2
+ ESCC
+
+ flat CNewline = BSCC("flatCNL") _ccall_ stg_putc '\n' file ESCC
+
+ flat (CCh c) = BSCC("flatCCh") _ccall_ stg_putc c file ESCC
+
+ flat (CInt i) = BSCC("flatCInt") _ccall_ fprintf file percent_d i ESCC
+
+ flat (CStr s) = BSCC("flatCStr") put_str s ESCC
+
+# if defined(COMPILING_GHC) && __GLASGOW_HASKELL__ >= 23
+ flat (CPStr s) = BSCC("flatCPStr") put_pstr s ESCC
+# endif
+
+ -----
+ put_str, put_str2 :: String -> PrimIO ()
+
+ put_str str
+ = --put_str2 ``stderr'' (str ++ "\n") `seqPrimIO`
+ put_str2 str
+
+ put_str2 [] = BSCC("putNil") returnPrimIO () ESCC
+
+ put_str2 (c1@(C# _) : c2@(C# _) : c3@(C# _) : c4@(C# _) : cs)
+ = BSCC("put4")
+ _ccall_ stg_putc c1 file `seqPrimIO`
+ _ccall_ stg_putc c2 file `seqPrimIO`
+ _ccall_ stg_putc c3 file `seqPrimIO`
+ _ccall_ stg_putc c4 file `seqPrimIO`
+ put_str2 cs -- efficiency hack? who knows... (WDP 94/10)
+ ESCC
+
+ put_str2 (c1@(C# _) : c2@(C# _) : c3@(C# _) : cs)
+ = BSCC("put3")
+ _ccall_ stg_putc c1 file `seqPrimIO`
+ _ccall_ stg_putc c2 file `seqPrimIO`
+ _ccall_ stg_putc c3 file `seqPrimIO`
+ put_str2 cs -- efficiency hack? who knows... (WDP 94/10)
+ ESCC
+
+ put_str2 (c1@(C# _) : c2@(C# _) : cs)
+ = BSCC("put2")
+ _ccall_ stg_putc c1 file `seqPrimIO`
+ _ccall_ stg_putc c2 file `seqPrimIO`
+ put_str2 cs -- efficiency hack? who knows... (WDP 94/10)
+ ESCC
+
+ put_str2 (c1@(C# _) : cs)
+ = BSCC("put1")
+ _ccall_ stg_putc c1 file `seqPrimIO`
+ put_str2 cs -- efficiency hack? who knows... (WDP 94/10)
+ ESCC
+
+# if __GLASGOW_HASKELL__ >= 23
+ put_pstr ps = _putPS file ps
+# endif
+
+# if __GLASGOW_HASKELL__ >= 23
+percent_d = _psToByteArray SLIT("%d")
+# else
+percent_d = "%d"
+# endif
+
+#endif {- __GLASGOW_HASKELL__ >= 22 -}
+\end{code}
projects / ghc-hetmet.git / blobdiff