X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FabsCSyn%2FCStrings.lhs;h=f25e6c204f04f70677fcee659e25b346a918744c;hb=553e90d9a32ee1b1809430f260c401cc4169c6c7;hp=dcbf165aa175ea8c738bbda2373a08a27ae344a4;hpb=986cee9db6dcea5829f2f547d7604b339e436da8;p=ghc-hetmet.git diff --git a/ghc/compiler/absCSyn/CStrings.lhs b/ghc/compiler/absCSyn/CStrings.lhs index dcbf165..f25e6c2 100644 --- 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}