ghc/compiler/main/PreProcess.hs

   1 -----------------------------------------------------------------------------
   2 -- $Id: PreProcess.hs,v 1.1 2000/10/11 11:54:58 simonmar Exp $
   3 --
   4 -- Pre-process source files
   5 --
   6 -- (c) The University of Glasgow 2000
   7 --
   8 -----------------------------------------------------------------------------
   9
  10 module PreProcess (
  11         preprocess -- :: FilePath -> IO FilePath
  12    ) where
  13
  14 import TmpFiles
  15 import DriverState
  16 import DriverUtil
  17
  18 import IOExts
  19
  20 -----------------------------------------------------------------------------
  21 -- preprocess takes a haskell source file and generates a raw .hs
  22 -- file.  This involves passing the file through 'unlit', 'cpp', or both.
  23
  24 preprocess :: FilePath -> IO FilePath
  25 preprocess filename = do
  26   let (basename, suffix) = splitFilename filename
  27
  28   unlit_file <- unlit filename
  29   cpp_file   <- cpp unlit_file
  30   return cpp_file
  31
  32 -------------------------------------------------------------------------------
  33 -- Unlit phase
  34
  35 unlit :: FilePath -> IO FilePath
  36 unlit input_fn
  37   | suffix /= unlitInputExt = return input_fn
  38   | otherwise =
  39      do output_fn <- newTempName cppInputExt
  40         unlit <- readIORef pgm_L
  41         unlit_flags <- getOpts opt_L
  42         run_something "Literate pre-processor"
  43            ("echo '# 1 \"" ++input_fn++"\"' > "++output_fn++" && "
  44            ++ unlit ++ ' ':input_fn ++ " - >> " ++ output_fn)
  45         return output_fn
  46    where
  47         (filename, suffix) = splitFilename input_fn
  48
  49 -------------------------------------------------------------------------------
  50 -- Cpp phase
  51
  52 cpp :: FilePath -> IO FilePath
  53 cpp input_fn
  54   = do src_opts <- getOptionsFromSource input_fn
  55        _ <- processArgs dynamic_flags src_opts []
  56
  57        output_fn <- newTempName hscInputExt
  58
  59        do_cpp <- readState cpp_flag
  60        if do_cpp
  61           then do
  62
  63             cpp <- readIORef pgm_P
  64             hscpp_opts <- getOpts opt_P
  65             hs_src_cpp_opts <- readIORef hs_source_cpp_opts
  66
  67             cmdline_include_paths <- readIORef include_paths
  68             pkg_include_dirs <- getPackageIncludePath
  69             let include_paths = map (\p -> "-I"++p) (cmdline_include_paths
  70                                                         ++ pkg_include_dirs)
  71
  72             verb <- is_verbose
  73             run_something "C pre-processor"
  74                 (unwords
  75                    (["echo '{-# LINE 1 \"" ++ input_fn ++ "\" -}'", ">", output_fn, "&&",
  76                      cpp, verb]
  77                     ++ include_paths
  78                     ++ hs_src_cpp_opts
  79                     ++ hscpp_opts
  80                     ++ [ "-x", "c", input_fn, ">>", output_fn ]
  81                    ))
  82           else do
  83             run_something "Ineffective C pre-processor"
  84                    ("echo '{-# LINE 1 \""  ++ input_fn ++ "\" -}' > "
  85                     ++ output_fn ++ " && cat " ++ input_fn
  86                     ++ " >> " ++ output_fn)
  87        return True
  88
  89 -----------------------------------------------------------------------------
  90 -- utils
  91
  92 splitFilename :: String -> (String,String)
  93 splitFilename f = (reverse (stripDot rev_basename), reverse rev_ext)
  94   where (rev_ext, rev_basename) = span ('.' /=) (reverse f)
  95         stripDot ('.':xs) = xs
  96         stripDot xs       = xs
  97