ghc/compiler/utils/Unpretty.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   3 %
   4 \section[Unpretty]{Unpretty-printing data type}
   5
   6 \begin{code}
   7 #include "HsVersions.h"
   8
   9 module Unpretty (
  10         SYN_IE(Unpretty),
  11
  12         uppNil, uppStr, uppPStr, uppChar, uppInt, uppInteger,
  13         uppSP, upp'SP, uppLbrack, uppRbrack, uppLparen, uppRparen,
  14         uppSemi, uppComma, uppEquals,
  15
  16         uppBracket, uppParens,
  17         uppCat, uppBeside, uppBesides, uppAbove, uppAboves,
  18         uppNest, uppSep, uppInterleave, uppIntersperse,
  19         uppShow,
  20         uppPutStr,
  21
  22         -- abstract type, to complete the interface...
  23         CSeq
  24    ) where
  25
  26 CHK_Ubiq() -- debugging consistency check
  27 IMPORT_1_3(IO)
  28
  29 import CharSeq
  30 \end{code}
  31
  32 Same interface as @Pretty@, but doesn't do anything.
  33
  34 The pretty type is redefined here:
  35 \begin{code}
  36 type Unpretty = CSeq
  37 \end{code}
  38
  39 %************************************************
  40 %*                                              *
  41         \subsection{The interface}
  42 %*                                              *
  43 %************************************************
  44
  45 \begin{code}
  46 uppNil          :: Unpretty
  47 uppSP, upp'SP, uppLbrack, uppRbrack, uppLparen, uppRparen, uppSemi, uppComma, uppEquals :: Unpretty
  48
  49 uppStr          :: [Char] -> Unpretty
  50 uppPStr         :: FAST_STRING -> Unpretty
  51 uppChar         :: Char -> Unpretty
  52 uppInt          :: Int -> Unpretty
  53 uppInteger      :: Integer -> Unpretty
  54
  55 uppBracket      :: Unpretty -> Unpretty -- put brackets around it
  56 uppParens       :: Unpretty -> Unpretty -- put parens   around it
  57
  58 uppBeside       :: Unpretty -> Unpretty -> Unpretty
  59 uppBesides      :: [Unpretty] -> Unpretty
  60 ppBesideSP      :: Unpretty -> Unpretty -> Unpretty
  61 uppCat          :: [Unpretty] -> Unpretty               -- i.e., ppBesidesSP
  62
  63 uppAbove        :: Unpretty -> Unpretty -> Unpretty
  64 uppAboves       :: [Unpretty] -> Unpretty
  65
  66 uppInterleave   :: Unpretty -> [Unpretty] -> Unpretty
  67 uppIntersperse  :: Unpretty -> [Unpretty] -> Unpretty   -- no spaces between
  68 uppSep          :: [Unpretty] -> Unpretty
  69 uppNest         :: Int -> Unpretty -> Unpretty
  70
  71 uppShow         :: Int -> Unpretty -> [Char]
  72
  73 uppPutStr       :: Handle -> Int -> Unpretty -> IO ()
  74 \end{code}
  75
  76 %************************************************
  77 %*                                              *
  78         \subsection{The representation}
  79 %*                                              *
  80 %************************************************
  81
  82 \begin{code}
  83 uppShow _ p     = cShow p
  84
  85 uppPutStr f _ p = _scc_ "uppPutStr" (cPutStr f p)
  86
  87 uppNil          = cNil
  88 uppStr s        = cStr s
  89 uppPStr s       = cPStr s
  90 uppChar c       = cCh c
  91 uppInt n        = cInt n
  92
  93 uppInteger n    = cStr (show n)
  94
  95 uppSP           = cCh ' '
  96 upp'SP{-'-}     = uppBeside uppComma uppSP
  97 uppLbrack       = cCh '['
  98 uppRbrack       = cCh ']'
  99 uppLparen       = cCh '('
 100 uppRparen       = cCh ')'
 101 uppSemi         = cCh ';'
 102 uppComma        = cCh ','
 103 uppEquals       = cCh '='
 104
 105 uppBracket p = uppBeside uppLbrack (uppBeside p uppRbrack)
 106 uppParens  p = uppBeside uppLparen (uppBeside p uppRparen)
 107
 108 uppInterleave sep ps = uppSep (pi ps)
 109   where
 110    pi []        = []
 111    pi [x]       = [x]
 112    pi (x:xs)    = (cAppend{-uppBeside-} x sep) : pi xs
 113 \end{code}
 114
 115 \begin{code}
 116 uppIntersperse sep ps = uppBesides (pi ps)
 117   where
 118    pi []        = []
 119    pi [x]       = [x]
 120    pi (x:xs)    = (cAppend{-uppBeside-} x sep) : pi xs
 121 \end{code}
 122
 123 \begin{code}
 124 uppBeside p1 p2  = p1 `cAppend` p2
 125
 126 uppBesides []     = cNil{-uppNil-}
 127 uppBesides [p]    = p
 128 uppBesides (p:ps) = p `cAppend`{-uppBeside-} uppBesides ps
 129 \end{code}
 130
 131 \begin{code}
 132 ppBesideSP p1 p2 = p1 `cAppend` (cCh ' ') `cAppend` p2
 133 \end{code}
 134
 135 @uppCat@ is the name I (WDP) happen to have been using for @ppBesidesSP@.
 136
 137 \begin{code}
 138 uppCat []     = cNil{-uppNil-}
 139 uppCat [p]    = p
 140 uppCat (p:ps) = ppBesideSP p (uppCat ps)
 141
 142 uppAbove p1 p2 = p1 `cAppend` (cCh '\n') `cAppend` p2
 143
 144 uppAboves []     = cNil{-uppNil-}
 145 uppAboves [p]    = p
 146 uppAboves (p:ps) = p `cAppend` (cCh '\n') `cAppend` (uppAboves ps)
 147
 148 uppNest n p = p
 149
 150 uppSep ps = uppBesides ps
 151 \end{code}