[project @ 2001-05-08 10:58:48 by simonmar]
authorsimonmar <unknown>
Tue, 8 May 2001 10:58:48 +0000 (10:58 +0000)
committersimonmar <unknown>
Tue, 8 May 2001 10:58:48 +0000 (10:58 +0000)
Add

DriverPhases.haskellish_src_suffix :: String -> Bool
DriverPhases.haskellish_src_file   :: String -> Bool

which return True for suffixes of Haskell source files only.  The
existing haskellish_suffix and haskellish_file return True also for
.raw_s and .hc files.

We use these instead of haskellish_file in Main.main when deciding
whether to preprocess a file.

Fixes: compilation of .raw_s files, and potential bugs with
compilation of .hc files.

ghc/compiler/compMan/CompManager.lhs
ghc/compiler/main/DriverPhases.hs
ghc/compiler/main/DriverPipeline.hs
ghc/compiler/main/DriverUtil.hs
ghc/compiler/main/Main.hs

index 7cc8a27..34d835b 100644 (file)
@@ -953,7 +953,7 @@ downsweep rootNm old_summaries
      where
        getRootSummary :: FilePath -> IO ModSummary
        getRootSummary file
-          | haskellish_file file
+          | haskellish_src_file file
           = do exists <- doesFileExist file
                if exists then summariseFile file else do
                throwDyn (CmdLineError ("can't find file `" ++ file ++ "'"))    
index 294f733..89e8ef4 100644 (file)
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: DriverPhases.hs,v 1.8 2001/05/04 15:18:00 simonmar Exp $
+-- $Id: DriverPhases.hs,v 1.9 2001/05/08 10:58:48 simonmar Exp $
 --
 -- GHC Driver
 --
@@ -13,6 +13,7 @@ module DriverPhases (
    phaseInputExt,      -- :: Phase -> String
 
    haskellish_file, haskellish_suffix,
+   haskellish_src_file, haskellish_src_suffix,
    objish_file, objish_suffix,
    cish_file, cish_suffix
  ) where
@@ -75,8 +76,9 @@ phaseInputExt SplitAs     = "split_s"   -- not really generated
 phaseInputExt Ln          = "o"
 phaseInputExt MkDependHS  = "dep"
 
-haskellish_suffix = (`elem` [ "hs", "hspp", "lhs", "hc", "raw_s" ])
-cish_suffix       = (`elem` [ "c", "s", "S" ])  -- maybe .cc et al.??
+haskellish_suffix     = (`elem` [ "hs", "hspp", "lhs", "hc", "raw_s" ])
+haskellish_src_suffix = (`elem` [ "hs", "hspp", "lhs" ])
+cish_suffix           = (`elem` [ "c", "s", "S" ])  -- maybe .cc et al.??
 
 #if mingw32_TARGET_OS || cygwin32_TARGET_OS
 objish_suffix     = (`elem` [ "o", "O", "obj", "OBJ" ])
@@ -84,6 +86,7 @@ objish_suffix     = (`elem` [ "o", "O", "obj", "OBJ" ])
 objish_suffix     = (`elem` [ "o" ])
 #endif
 
-haskellish_file f = haskellish_suffix suf where (_,suf) = splitFilename f
-cish_file       f = cish_suffix       suf where (_,suf) = splitFilename f
-objish_file     f = objish_suffix     suf where (_,suf) = splitFilename f
+haskellish_file     = haskellish_suffix     . getFileSuffix
+haskellish_src_file = haskellish_src_suffix . getFileSuffix
+cish_file           = cish_suffix           . getFileSuffix
+objish_file         = objish_suffix         . getFileSuffix
index 4e70ec4..c8bd8e6 100644 (file)
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: DriverPipeline.hs,v 1.65 2001/05/01 16:01:06 simonmar Exp $
+-- $Id: DriverPipeline.hs,v 1.66 2001/05/08 10:58:48 simonmar Exp $
 --
 -- GHC Driver
 --
@@ -167,8 +167,8 @@ genPipeline todo stop_flag persistent_output lang filename
     cish = cish_suffix suffix
 
        -- for a .hc file we need to force lang to HscC
-    real_lang | start_phase == HCc  = HscC
-             | otherwise           = lang
+    real_lang | start_phase == HCc || start_phase == Mangle = HscC
+             | otherwise                                   = lang
 
    let
    ----------- -----  ----   ---   --   --  -  -  -
@@ -261,6 +261,8 @@ genPipeline todo stop_flag persistent_output lang filename
                 ++ " is incompatible with source file `" ++ filename ++ "'"))
       else do
 
+   print (show pipeline ++ show annotated_pipeline ++ show stop_phase)
+
    return (
      takeWhile (phase_ne stop_phase ) $
      dropWhile (phase_ne start_phase) $
@@ -914,7 +916,7 @@ doMkDLL o_files = do
 
 preprocess :: FilePath -> IO FilePath
 preprocess filename =
-  ASSERT(haskellish_file filename) 
+  ASSERT(haskellish_src_file filename) 
   do init_dyn_flags <- readIORef v_InitDynFlags
      writeIORef v_DynFlags init_dyn_flags
      pipeline <- genPipeline (StopBefore Hsc) ("preprocess") False 
index fd0bcaf..0a25f76 100644 (file)
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: DriverUtil.hs,v 1.20 2001/04/26 14:33:44 simonmar Exp $
+-- $Id: DriverUtil.hs,v 1.21 2001/05/08 10:58:48 simonmar Exp $
 --
 -- Utils for the driver
 --
@@ -125,6 +125,9 @@ addNoDups var x = do
 splitFilename :: String -> (String,String)
 splitFilename f = split_longest_prefix f '.'
 
+getFileSuffix :: String -> String
+getFileSuffix f = drop_longest_prefix f '.'
+
 -- "foo/bar/xyzzy.ext" -> ("foo/bar", "xyzzy", ".ext")
 splitFilename3 :: String -> (String,String,String)
 splitFilename3 str
index 99b9629..4678065 100644 (file)
@@ -1,6 +1,6 @@
 {-# OPTIONS -fno-warn-incomplete-patterns #-}
 -----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.63 2001/04/26 13:52:57 simonmar Exp $
+-- $Id: Main.hs,v 1.64 2001/05/08 10:58:48 simonmar Exp $
 --
 -- GHC Driver program
 --
@@ -33,7 +33,7 @@ import DriverFlags
 import DriverMkDepend
 import DriverUtil
 import Panic
-import DriverPhases    ( Phase(..), haskellish_file, objish_file )
+import DriverPhases    ( Phase(..), haskellish_src_file, objish_file )
 import CmdLineOpts
 import TmpFiles
 import Finder          ( initFinder )
@@ -291,8 +291,8 @@ main =
          -- OPTIONS pragma that affects the compilation pipeline (eg. -fvia-C)
          let (basename, suffix) = splitFilename src
 
-         -- just preprocess
-         pp <- if not (haskellish_file src) || mode == StopBefore Hsc
+         -- just preprocess (Haskell source only)
+         pp <- if not (haskellish_src_file src) || mode == StopBefore Hsc
                        then return src else do
                phases <- genPipeline (StopBefore Hsc) stop_flag
                            False{-not persistent-} defaultHscLang src