From: panne <unknown>
Date: Tue, 29 Jun 2004 17:14:01 +0000 (+0000)
Subject: [project @ 2004-06-29 17:14:01 by panne]
X-Git-Tag: Initial_conversion_from_CVS_complete~1786
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=b1d4bb554528bbce796616ec47e652139c1e00f6

[project @ 2004-06-29 17:14:01 by panne]
Workaround for hbc: It compiles matching against 0-ary constructors in
list comprehensions into wrong code, e.g.

   [ () | True <- [False] ]

results in something like

   Error: No match in I4680Pinteractive

when issued in hbi.
---

diff --git a/ghc/utils/hsc2hs/Main.hs b/ghc/utils/hsc2hs/Main.hs
index 52e6911..e60ea92 100644
--- a/ghc/utils/hsc2hs/Main.hs
+++ b/ghc/utils/hsc2hs/Main.hs
@@ -1,7 +1,7 @@
 {-# OPTIONS -fffi #-}
 
 ------------------------------------------------------------------------
--- $Id: Main.hs,v 1.57 2004/06/27 20:41:07 panne Exp $
+-- $Id: Main.hs,v 1.58 2004/06/29 17:14:01 panne Exp $
 --
 -- Program for converting .hsc files to .hs files, by converting the
 -- file into a C program which is run to generate the Haskell source.
@@ -19,7 +19,7 @@ import GetOpt
 
 import System        (getProgName, getArgs, ExitCode(..), exitWith, system)
 import Directory     (removeFile,doesFileExist)
-import Monad         (MonadPlus(..), liftM, liftM2, when, unless)
+import Monad         (MonadPlus(..), liftM, liftM2, when)
 import Char          (isAlpha, isAlphaNum, isSpace, isDigit, toUpper, intToDigit, ord)
 import List          (intersperse, isSuffixOf)
 import IO            (hPutStr, hPutStrLn, stderr)
@@ -563,7 +563,10 @@ output flags name toks = do
         concatMap outTokenHs toks++
         "    return 0;\n}\n"
     
-    unless (null [() | NoCompile <- flags]) $ exitWith ExitSuccess
+    -- NOTE: hbc compiles "[() | NoCompile <- flags]" into wrong code,
+    -- so we use something slightly more complicated.   :-P
+    when (any (\x -> case x of NoCompile -> True; _ -> False) flags) $
+       exitWith ExitSuccess