ghc/compiler/absCSyn/CStrings.lhs

   1 This module deals with printing (a) C string literals and (b) C labels.
   2
   3 \begin{code}
   4 module CStrings(
   5
   6         cSEP,
   7         pp_cSEP,
   8
   9         identToC, modnameToC,
  10         stringToC, charToC,
  11         charToEasyHaskell
  12
  13   ) where
  14
  15 #include "HsVersions.h"
  16
  17 import Char     ( isAlphanum, ord, chr )
  18 import Outputable
  19 \end{code}
  20
  21
  22 \begin{verbatim}
  23 _ is the main separator
  24
  25 orig            becomes
  26 ****            *******
  27 _               Zu
  28 '               Zq (etc for ops ??)
  29 <funny char>    Z[hex-digit][hex-digit]
  30 Prelude<x>      ZP<x>
  31 <std class>     ZC<?>
  32 <std tycon>     ZT<?>
  33 \end{verbatim}
  34
  35 \begin{code}
  36 cSEP    = SLIT("_")     -- official C separator
  37 pp_cSEP = char '_'
  38
  39 identToC    :: FAST_STRING -> SDoc
  40 modnameToC  :: FAST_STRING -> FAST_STRING
  41 stringToC   :: String -> String
  42 charToC, charToEasyHaskell :: Char -> String
  43
  44 -- stringToC: the hassle is what to do w/ strings like "ESC 0"...
  45
  46 stringToC ""  = ""
  47 stringToC [c] = charToC c
  48 stringToC (c:cs)
  49     -- if we have something "octifiable" in "c", we'd better "octify"
  50     -- the rest of the string, too.
  51   = if (c < ' ' || c > '~')
  52     then (charToC c) ++ (concat (map char_to_C cs))
  53     else (charToC c) ++ (stringToC cs)
  54   where
  55     char_to_C c | c == '\n' = "\\n"     -- use C escapes when we can
  56                 | c == '\a' = "\\a"
  57                 | c == '\b' = "\\b"     -- ToDo: chk some of these...
  58                 | c == '\r' = "\\r"
  59                 | c == '\t' = "\\t"
  60                 | c == '\f' = "\\f"
  61                 | c == '\v' = "\\v"
  62                 | otherwise = '\\' : (octify (ord c))
  63
  64 charToC c = if (c >= ' ' && c <= '~')   -- non-portable...
  65             then case c of
  66                   '\'' -> "\\'"
  67                   '\\' -> "\\\\"
  68                   '"'  -> "\\\""
  69                   '\n' -> "\\n"
  70                   '\a' -> "\\a"
  71                   '\b' -> "\\b"
  72                   '\r' -> "\\r"
  73                   '\t' -> "\\t"
  74                   '\f' -> "\\f"
  75                   '\v' -> "\\v"
  76                   _    -> [c]
  77             else '\\' : (octify (ord c))
  78
  79 -- really: charToSimpleHaskell
  80
  81 charToEasyHaskell c
  82   = if (c >= 'a' && c <= 'z')
  83     || (c >= 'A' && c <= 'Z')
  84     || (c >= '0' && c <= '9')
  85     then [c]
  86     else case c of
  87           _    -> '\\' : show (ord c)
  88
  89 octify :: Int -> String
  90 octify n
  91   = if n < 8 then
  92         [chr (n + ord '0')]
  93     else
  94         octify (n `quot` 8) ++ [chr (n `rem` 8 + ord '0')]
  95
  96 identToC ps
  97   = let
  98         str = _UNPK_ ps
  99     in
 100     (<>)
 101         (case str of
 102            's':'t':'d':_ -> -- avoid "stdin", "stdout", and "stderr"...
 103                             char 'Z'
 104            _             -> empty)
 105
 106         (if (all isAlphanum str) -- we gamble that this test will succeed...
 107          then ptext ps
 108          else hcat (map char_to_c str))
 109   where
 110     char_to_c 'Z'  = ptext SLIT("ZZ")
 111     char_to_c '&'  = ptext SLIT("Za")
 112     char_to_c '|'  = ptext SLIT("Zb")
 113     char_to_c ':'  = ptext SLIT("Zc")
 114     char_to_c '/'  = ptext SLIT("Zd")
 115     char_to_c '='  = ptext SLIT("Ze")
 116     char_to_c '>'  = ptext SLIT("Zg")
 117     char_to_c '#'  = ptext SLIT("Zh")
 118     char_to_c '<'  = ptext SLIT("Zl")
 119     char_to_c '-'  = ptext SLIT("Zm")
 120     char_to_c '!'  = ptext SLIT("Zn")
 121     char_to_c '.'  = ptext SLIT("_")
 122     char_to_c '+'  = ptext SLIT("Zp")
 123     char_to_c '\'' = ptext SLIT("Zq")
 124     char_to_c '*'  = ptext SLIT("Zt")
 125     char_to_c '_'  = ptext SLIT("_")
 126
 127     char_to_c c    = if isAlphanum c
 128                      then char c
 129                      else char 'Z' <> int (ord c)
 130 \end{code}
 131
 132 For \tr{modnameToC}, we really only have to worry about \tr{'}s (quote
 133 chars) in the name.  Rare.
 134 \begin{code}
 135 modnameToC ps
 136   = let
 137         str = _UNPK_ ps
 138     in
 139     if not (any quote_here str) then
 140         ps
 141     else
 142         _PK_ (concat (map char_to_c str))
 143   where
 144     quote_here '\'' = True
 145     quote_here _    = False
 146
 147     char_to_c c
 148       = if isAlphanum c then [c] else 'Z' : (show (ord c))
 149 \end{code}
 150
 151