X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FabsCSyn%2FCStrings.lhs;h=f25e6c204f04f70677fcee659e25b346a918744c;hb=553e90d9a32ee1b1809430f260c401cc4169c6c7;hp=720e143fa9af51810ca4755a3d24723b76ba1b27;hpb=7a3bd641457666e10d0a47be9f22762e03defbf0;p=ghc-hetmet.git

diff --git a/ghc/compiler/absCSyn/CStrings.lhs b/ghc/compiler/absCSyn/CStrings.lhs
index 720e143..f25e6c2 100644
--- a/ghc/compiler/absCSyn/CStrings.lhs
+++ b/ghc/compiler/absCSyn/CStrings.lhs
@@ -1,159 +1,55 @@
-This module deals with printing (a) C string literals and (b) C labels.
+This module deals with printing C string literals 
 
 \begin{code}
-#include "HsVersions.h"
-
 module CStrings(
+	CLabelString, isCLabelString, pprCLabelString,
 
-	cSEP,
 	pp_cSEP,
 
-	identToC, modnameToC,
-	stringToC, charToC,
-	charToEasyHaskell
-
+	pprFSInCStyle, pprStringInCStyle
   ) where
 
-CHK_Ubiq() -- debugging consistency check
-
-import Pretty
-import Unpretty( uppChar )
+#include "HsVersions.h"
 
-IMPORT_1_3(Char (isAlphanum))
-#ifdef REALLY_HASKELL_1_3
-ord = fromEnum :: Char -> Int
-chr = toEnum   :: Int -> Char
-#endif
+import Char	( ord, chr, isAlphaNum )
+import FastString
+import Outputable
 \end{code}
 
 
-\begin{verbatim}
-_ is the main separator
-
-orig		becomes
-****		*******
-_		Zu
-'		Zq (etc for ops ??)
-<funny char>	Z[hex-digit][hex-digit]
-Prelude<x>	ZP<x>
-<std class>	ZC<?>
-<std tycon>	ZT<?>
-\end{verbatim}
-
 \begin{code}
-cSEP    = SLIT("_")	-- official C separator
-pp_cSEP = uppChar '_'
-
-identToC    :: FAST_STRING -> Pretty
-modnameToC  :: FAST_STRING -> FAST_STRING
-stringToC   :: String -> String
-charToC, charToEasyHaskell :: Char -> String
+type CLabelString = FastString		-- A C label, completely unencoded
 
--- stringToC: the hassle is what to do w/ strings like "ESC 0"...
+pprCLabelString :: CLabelString -> SDoc
+pprCLabelString lbl = ftext lbl
 
-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))
-
--- really: charToSimpleHaskell
+    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
 
-charToEasyHaskell c
-  = if (c >= 'a' && c <= 'z')
-    || (c >= 'A' && c <= 'Z')
-    || (c >= '0' && c <= '9')
-    then [c]
-    else case c of
-	  _    -> '\\' : 'o' : (octify (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')]
-
-identToC ps
-  = let
-	str = _UNPK_ ps
-    in
-    ppBeside
-	(case str of
-	   's':'t':'d':_ -> -- avoid "stdin", "stdout", and "stderr"...
-			    ppChar 'Z'
-	   _	         -> ppNil)
-
-	(if (all isAlphanum str) -- we gamble that this test will succeed...
-	 then ppPStr ps
-	 else ppIntersperse ppNil (map char_to_c str))
-  where
-    char_to_c 'Z'  = ppPStr SLIT("ZZ")
-    char_to_c '&'  = ppPStr SLIT("Za")
-    char_to_c '|'  = ppPStr SLIT("Zb")
-    char_to_c ':'  = ppPStr SLIT("Zc")
-    char_to_c '/'  = ppPStr SLIT("Zd")
-    char_to_c '='  = ppPStr SLIT("Ze")
-    char_to_c '>'  = ppPStr SLIT("Zg")
-    char_to_c '#'  = ppPStr SLIT("Zh")
-    char_to_c '<'  = ppPStr SLIT("Zl")
-    char_to_c '-'  = ppPStr SLIT("Zm")
-    char_to_c '!'  = ppPStr SLIT("Zn")
-    char_to_c '.'  = ppPStr SLIT("_")
-    char_to_c '+'  = ppPStr SLIT("Zp")
-    char_to_c '\'' = ppPStr SLIT("Zq")
-    char_to_c '*'  = ppPStr SLIT("Zt")
-    char_to_c '_'  = ppPStr SLIT("Zu")
-
-    char_to_c c    = if isAlphanum c
-		     then ppChar c
-		     else ppBeside (ppChar 'Z') (ppInt (ord c))
+pp_cSEP = char '_'
 \end{code}
 
-For \tr{modnameToC}, we really only have to worry about \tr{'}s (quote
-chars) in the name.  Rare.
 \begin{code}
-modnameToC ps
-  = let
-	str = _UNPK_ ps
-    in
-    if not (any quote_here str) then
-	ps
-    else
-	_PK_ (concat (map char_to_c str))
-  where
-    quote_here '\'' = True
-    quote_here _    = False
-
-    char_to_c c
-      = if isAlphanum c then [c] else 'Z' : (show (ord c))
+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}
-
-