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