[project @ 2001-01-12 22:54:22 by qrczak]

Expand #-constructs only outside Haskell comments and string literals.

diff --git a/ghc/docs/users_guide/utils.sgml b/ghc/docs/users_guide/utils.sgml
index 4117f8d..965115e 100644 (file)
--- a/ghc/docs/users_guide/utils.sgml
+++ b/ghc/docs/users_guide/utils.sgml
@@ -116,7 +116,7 @@ tags:
     that gets included into the C code to which the Haskell module
     will be compiled (when compiled via C) and into the C file. These
     two files are created when the <literal>#def</literal> construct
-    is used.</para>
+    is used (see below).</para>
 
     <para>Actually <command>hsc2hs</command> does not output the Haskell
     file directly.  It creates a C program that includes the headers,
@@ -230,17 +230,18 @@ tags:
     <sect2><title>Input syntax</title>
 
       <para>All special processing is triggered by the
-      <literal>#</literal> character. To output a literal
-      <literal>#</literal>, write it twice: <literal>##</literal>.</para>
+      <literal>#</literal> character placed outside Haskell comments
+      and string literals. To output a literal <literal>#</literal>,
+      write it twice: <literal>##</literal>.</para>
 
       <para>Otherwise <literal>#</literal> is followed by optional
-      spaces and tabs, an alphanumeric key that describes the kind of
-      processing, and its arguments. Arguments look like C expressions
-      and extend up to the nearest unmatched <literal>)</literal>,
-      <literal>]</literal>, or <literal>}</literal>, or to the end of
-      line outside any <literal>() [] {} '' "" /* */</literal>. Any
-      character may be preceded by a backslash and will not be treated
-      specially.</para>
+      spaces and tabs, an alphanumeric key that describes the
+      kind of processing, and its arguments. Arguments look
+      like C expressions separated by commas and extend up to the
+      nearest unmatched <literal>)</literal>, <literal>]</literal>,
+      or <literal>}</literal>, or to the end of line outside any
+      <literal>() [] {} '' "" /* */</literal>. Any character may be
+      preceded by a backslash and will not be treated specially.</para>
 
       <para>Meanings of specific keys:</para>
 

diff --git a/ghc/utils/hsc2hs/Main.hs b/ghc/utils/hsc2hs/Main.hs
index a6dd69e..3ab4411 100644 (file)
--- a/ghc/utils/hsc2hs/Main.hs
+++ b/ghc/utils/hsc2hs/Main.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.7 2001/01/11 19:50:19 qrczak Exp $
+-- $Id: Main.hs,v 1.8 2001/01/12 22:54:23 qrczak Exp $
 --
 -- (originally "GlueHsc.hs" by Marcin 'Qrczak' Kowalczyk)
 --
@@ -16,11 +16,11 @@ import System    (getProgName, getArgs, ExitCode(..), system, exitWith, exitFail
 import Directory (removeFile)
 import Parsec
 import Monad     (liftM, liftM2, when)
-import Char      (ord, intToDigit, isSpace, isAlphaNum, toUpper)
+import Char      (ord, intToDigit, isSpace, isAlpha, isAlphaNum, toUpper)
 import List      (intersperse)
 
 version :: String
-version = "0.64"
+version = "hsc2hs-0.64"
 
 data Flag
     = Help
@@ -58,7 +58,7 @@ main = do
     case getOpt Permute options args of
         (flags, _, _)
             | any isHelp    flags -> putStrLn (usageInfo header options)
-            | any isVersion flags -> putStrLn ("hsc2hs-"++version)
+            | any isVersion flags -> putStrLn version
             where
             isHelp    Help    = True; isHelp    _ = False
             isVersion Version = True; isVersion _ = False
@@ -73,7 +73,7 @@ processFile :: [Flag] -> String -> IO ()
 processFile flags name = do
     parsed <- parseFromFile parser name
     case parsed of
-        Left err -> print err >> exitFailure
+        Left err   -> do print err; exitFailure
         Right toks -> output flags name toks
 
 data Token
@@ -84,7 +84,39 @@ parser :: Parser [Token]
 parser = many (text <|> special)
 
 text :: Parser Token
-text = liftM Text $ many1 $ satisfy (/= '#') <|> try (string "##" >> return '#')
+text =
+    liftM (Text . concat) $ many1
+    (   many1 (satisfy (\ch -> not (isAlpha ch || ch `elem` "\"#'-_{")))
+    <|> (do a <- satisfy (\ch -> isAlpha ch || ch == '_')
+            b <- many (satisfy (\ch -> isAlphaNum ch || ch == '_' || ch == '\''))
+            return (a:b))
+    <|> (do char '\"'; a <- hsString '\"'; char '\"'; return ("\""++a++"\""))
+    <|> (do try (string "##"); return "#")
+    <|> (do char '\''; a <- hsString '\''; char '\''; return ("\'"++a++"\'"))
+    <|> (do try (string "--"); a <- many (satisfy (/= '\n')); return ("--"++a))
+    <|> string "-"
+    <|> (do try (string "{-"); a <- hsComment; return ("{-"++a))
+    <|> string "{"
+    <?> "Haskell source")
+
+hsComment :: Parser String
+hsComment =
+    (   (do a <- many1 (noneOf "-{"); b <- hsComment; return (a++b))
+    <|> try (string "-}")
+    <|> (do char '-'; b <- hsComment; return ('-':b))
+    <|> (do try (string "{-"); a <- hsComment; b <- hsComment; return ("{-"++a++b))
+    <|> (do char '{'; b <- hsComment; return ('{':b))
+    <?> "Haskell comment")
+
+hsString :: Char -> Parser String
+hsString quote =
+    liftM concat $ many
+    (   many1 (noneOf (quote:"\n\\"))
+    <|> (do char '\\'; a <- escape; return ('\\':a))
+    <?> "Haskell character or string")
+    where
+    escape = (do a <- many1 (satisfy isSpace); char '\\'; return (a++"\\"))
+         <|> (do a <- anyChar; return [a])
 
 special :: Parser Token
 special = do
@@ -97,13 +129,14 @@ special = do
     return (Special key arg)
 
 argument :: Parser String -> Parser String
-argument eol = liftM concat $ many
+argument eol =
+    liftM concat $ many
     (   many1 (noneOf "\n\"\'()/[\\]{}")
     <|> eol
-    <|> (do char '\"'; a <- cString '\''; char '\"'; return ("\""++a++"\""))
-    <|> (do char '\''; a <- cString '\"'; char '\''; return ("\'"++a++"\'"))
+    <|> (do char '\"'; a <- cString '\"'; char '\"'; return ("\""++a++"\""))
+    <|> (do char '\''; a <- cString '\''; char '\''; return ("\'"++a++"\'"))
     <|> (do char '('; a <- nested; char ')'; return ("("++a++")"))
-    <|> (do try (string "/*"); comment; return " ")
+    <|> (do try (string "/*"); cComment; return " ")
     <|> (do try (string "//"); skipMany (satisfy (/= '\n')); return " ")
     <|> string "/"
     <|> (do char '['; a <- nested; char ']'; return ("["++a++"]"))
@@ -112,16 +145,17 @@ argument eol = liftM concat $ many
     <?> "C expression")
     where nested = argument (string "\n")
 
-comment :: Parser ()
-comment = (do skipMany1 (noneOf "*"); comment)
-      <|> (do try (string "*/"); return ())
-      <|> (do char '*'; comment)
-      <?> "C comment"
+cComment :: Parser ()
+cComment =
+    (   (do skipMany1 (noneOf "*"); cComment)
+    <|> (do try (string "*/"); return ())
+    <|> (do char '*'; cComment)
+    <?> "C comment")
 
 cString :: Char -> Parser String
-cString otherQuote = liftM concat $ many
-    (   many1 (noneOf "\n\\\'\"")
-    <|> string [otherQuote]
+cString quote =
+    liftM concat $ many
+    (   many1 (noneOf (quote:"\n\\"))
     <|> (do char '\\'; a <- anyChar; return ['\\',a])
     <?> "C character or string")
 

diff --git a/ghc/utils/hsc2hs/template-hsc.h b/ghc/utils/hsc2hs/template-hsc.h
index 43841f0..c235f24 100644 (file)
--- a/ghc/utils/hsc2hs/template-hsc.h
+++ b/ghc/utils/hsc2hs/template-hsc.h
@@ -12,6 +12,7 @@
 #endif
 
 #if __GLASGOW_HASKELL__
+
 static int hsc_options_started;
 
 static void hsc_begin_options (void)
@@ -38,11 +39,14 @@ static void hsc_end_options (void)
 {
     if (hsc_options_started) printf (" #-}\n");
 }
-#else
+
+#else /* !__GLASGOW_HASKELL__ */
+
 #define hsc_begin_options()
 #define hsc_option(s)
 #define hsc_end_options()
-#endif
+
+#endif /* !__GLASGOW_HASKELL__ */
 
 #define hsc_const(x)                        \
     if ((x) < 0)                            \