ghc/compiler/absCSyn/CStrings.lhs

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