[project @ 2004-08-13 10:45:16 by simonmar]

[ghc-hetmet.git] / ghc / compiler / absCSyn / CStrings.lhs

diff --git a/ghc/compiler/absCSyn/CStrings.lhs b/ghc/compiler/absCSyn/CStrings.lhs
index dcbf165..f25e6c2 100644 (file)
--- a/ghc/compiler/absCSyn/CStrings.lhs
+++ b/ghc/compiler/absCSyn/CStrings.lhs
@@ -2,79 +2,54 @@ This module deals with printing C string literals
 
 \begin{code}
 module CStrings(
-       cSEP, pp_cSEP,
+       CLabelString, isCLabelString, pprCLabelString,
 
-       stringToC, charToC, pprFSInCStyle,
-       charToEasyHaskell
+       pp_cSEP,
+
+       pprFSInCStyle, pprStringInCStyle
   ) where
 
 #include "HsVersions.h"
 
-import Char    ( ord, chr )
+import Char    ( ord, chr, isAlphaNum )
+import FastString
 import Outputable
 \end{code}
 
 
 \begin{code}
-cSEP    = SLIT("_")    -- official C separator
-pp_cSEP = char '_'
-
-stringToC   :: String -> String
-charToC, charToEasyHaskell :: Char -> String
+type CLabelString = FastString         -- A C label, completely unencoded
 
-pprFSInCStyle :: FAST_STRING -> SDoc
-pprFSInCStyle fs = doubleQuotes (text (stringToC (_UNPK_ fs)))
+pprCLabelString :: CLabelString -> SDoc
+pprCLabelString lbl = ftext lbl
 
--- stringToC: the hassle is what to do w/ strings like "ESC 0"...
-
-stringToC ""  = ""
-stringToC [c] = charToC c
-stringToC (c:cs)
-    -- if we have something "octifiable" in "c", we'd better "octify"
-    -- the rest of the string, too.
-  = if (c < ' ' || c > '~')
-    then (charToC c) ++ (concat (map char_to_C cs))
-    else (charToC c) ++ (stringToC cs)
+isCLabelString :: CLabelString -> Bool -- Checks to see if this is a valid C label
+isCLabelString lbl 
+  = all ok (unpackFS lbl)
   where
-    char_to_C c | c == '\n' = "\\n"    -- use C escapes when we can
-               | c == '\a' = "\\a"
-               | c == '\b' = "\\b"     -- ToDo: chk some of these...
-               | c == '\r' = "\\r"
-               | c == '\t' = "\\t"
-               | c == '\f' = "\\f"
-               | c == '\v' = "\\v"
-               | otherwise = '\\' : (octify (ord c))
-
-charToC c = if (c >= ' ' && c <= '~')  -- non-portable...
-           then case c of
-                 '\'' -> "\\'"
-                 '\\' -> "\\\\"
-                 '"'  -> "\\\""
-                 '\n' -> "\\n"
-                 '\a' -> "\\a"
-                 '\b' -> "\\b"
-                 '\r' -> "\\r"
-                 '\t' -> "\\t"
-                 '\f' -> "\\f"
-                 '\v' -> "\\v"
-                 _    -> [c]
-           else '\\' : (octify (ord c))
+    ok c = isAlphaNum c || c == '_' || c == '.'
+       -- The '.' appears in e.g. "foo.so" in the 
+       -- module part of a ExtName.  Maybe it should be separate
 
--- really: charToSimpleHaskell
-
-charToEasyHaskell c
-  = if (c >= 'a' && c <= 'z')
-    || (c >= 'A' && c <= 'Z')
-    || (c >= '0' && c <= '9')
-    then [c]
-    else case c of
-         _    -> '\\' : show (ord c)
-
-octify :: Int -> String
-octify n
-  = if n < 8 then
-       [chr (n + ord '0')]
-    else
-       octify (n `quot` 8) ++ [chr (n `rem` 8 + ord '0')]
+pp_cSEP = char '_'
 \end{code}
 
+\begin{code}
+pprFSInCStyle :: FastString -> SDoc
+-- Assumes it contains only characters '\0'..'\xFF'!
+pprFSInCStyle fs = pprStringInCStyle (unpackFS fs)
+
+pprStringInCStyle :: String -> SDoc
+pprStringInCStyle s = doubleQuotes (text (concatMap charToC s))
+
+charToC :: Char -> String
+charToC '\"' = "\\\""
+charToC '\'' = "\\\'"
+charToC '\\' = "\\\\"
+charToC c | c >= ' ' && c <= '~' = [c]
+          | c > '\xFF' = panic ("charToC "++show c)
+          | otherwise = ['\\',
+                         chr (ord '0' + ord c `div` 64),
+                         chr (ord '0' + ord c `div` 8 `mod` 8),
+                         chr (ord '0' + ord c         `mod` 8)]
+\end{code}