From b8b47abe336d17ae5354a9bb15c44564b51c97ef Mon Sep 17 00:00:00 2001 From: simonmar Date: Tue, 8 May 2001 10:58:48 +0000 Subject: [PATCH] [project @ 2001-05-08 10:58:48 by simonmar] 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 | 2 +- ghc/compiler/main/DriverPhases.hs | 15 +++++++++------ ghc/compiler/main/DriverPipeline.hs | 10 ++++++---- ghc/compiler/main/DriverUtil.hs | 5 ++++- ghc/compiler/main/Main.hs | 8 ++++---- 5 files changed, 24 insertions(+), 16 deletions(-) diff --git a/ghc/compiler/compMan/CompManager.lhs b/ghc/compiler/compMan/CompManager.lhs index 7cc8a27..34d835b 100644 --- a/ghc/compiler/compMan/CompManager.lhs +++ b/ghc/compiler/compMan/CompManager.lhs @@ -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 ++ "'")) diff --git a/ghc/compiler/main/DriverPhases.hs b/ghc/compiler/main/DriverPhases.hs index 294f733..89e8ef4 100644 --- a/ghc/compiler/main/DriverPhases.hs +++ b/ghc/compiler/main/DriverPhases.hs @@ -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 diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs index 4e70ec4..c8bd8e6 100644 --- a/ghc/compiler/main/DriverPipeline.hs +++ b/ghc/compiler/main/DriverPipeline.hs @@ -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 diff --git a/ghc/compiler/main/DriverUtil.hs b/ghc/compiler/main/DriverUtil.hs index fd0bcaf..0a25f76 100644 --- a/ghc/compiler/main/DriverUtil.hs +++ b/ghc/compiler/main/DriverUtil.hs @@ -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 diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs index 99b9629..4678065 100644 --- a/ghc/compiler/main/Main.hs +++ b/ghc/compiler/main/Main.hs @@ -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 -- 1.7.10.4