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