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