+++ /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