{-
-- The main program for cpphs, a simple C pre-processor written in Haskell.

-- Copyright (c) 2004 Malcolm Wallace
-- This file is LGPL (relicensed from the GPL by Malcolm Wallace, October 2011).
-}
module Language.Preprocessor.Cpphs.RunCpphs ( runCpphs
                                            , runCpphsPass1
                                            , runCpphsPass2
                                            , runCpphsReturningSymTab
                                            ) where

import Language.Preprocessor.Cpphs.CppIfdef (cppIfdef)
import Language.Preprocessor.Cpphs.MacroPass(macroPass,macroPassReturningSymTab)
import Language.Preprocessor.Cpphs.Options  (CpphsOptions(..), BoolOptions(..)
                                            ,trailing)
import Language.Preprocessor.Cpphs.Tokenise (deWordStyle, tokenise)
import Language.Preprocessor.Cpphs.Position (cleanPath, Posn)
import Language.Preprocessor.Unlit as Unlit (unlit)


runCpphs :: CpphsOptions -> FilePath -> String -> IO String
runCpphs :: CpphsOptions -> FilePath -> FilePath -> IO FilePath
runCpphs CpphsOptions
options FilePath
filename FilePath
input = do
  [(Posn, FilePath)]
pass1 <- CpphsOptions -> FilePath -> FilePath -> IO [(Posn, FilePath)]
runCpphsPass1 CpphsOptions
options FilePath
filename FilePath
input
  BoolOptions
-> [(FilePath, FilePath)]
-> FilePath
-> [(Posn, FilePath)]
-> IO FilePath
runCpphsPass2 (CpphsOptions -> BoolOptions
boolopts CpphsOptions
options) (CpphsOptions -> [(FilePath, FilePath)]
defines CpphsOptions
options) FilePath
filename [(Posn, FilePath)]
pass1

runCpphsPass1 :: CpphsOptions -> FilePath -> String -> IO [(Posn,String)]
runCpphsPass1 :: CpphsOptions -> FilePath -> FilePath -> IO [(Posn, FilePath)]
runCpphsPass1 CpphsOptions
options' FilePath
filename FilePath
input = do
  let options :: CpphsOptions
options= CpphsOptions
options'{ includes :: [FilePath]
includes= (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath
forall a. Eq a => [a] -> [a] -> [a]
trailing FilePath
"\\/") (CpphsOptions -> [FilePath]
includes CpphsOptions
options') }
  let bools :: BoolOptions
bools  = CpphsOptions -> BoolOptions
boolopts CpphsOptions
options
      preInc :: FilePath
preInc = case CpphsOptions -> [FilePath]
preInclude CpphsOptions
options of
                 [] -> FilePath
""
                 [FilePath]
is -> (FilePath -> FilePath) -> [FilePath] -> FilePath
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\FilePath
f->FilePath
"#include \""FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
fFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"\"\n") [FilePath]
is 
                       FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"#line 1 \""FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath -> FilePath
cleanPath FilePath
filenameFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"\"\n"

  [(Posn, FilePath)]
pass1 <- FilePath
-> [(FilePath, FilePath)]
-> [FilePath]
-> BoolOptions
-> FilePath
-> IO [(Posn, FilePath)]
cppIfdef FilePath
filename (CpphsOptions -> [(FilePath, FilePath)]
defines CpphsOptions
options) (CpphsOptions -> [FilePath]
includes CpphsOptions
options) BoolOptions
bools
                    (FilePath
preIncFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
input)
  [(Posn, FilePath)] -> IO [(Posn, FilePath)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Posn, FilePath)]
pass1

runCpphsPass2 :: BoolOptions -> [(String,String)] -> FilePath -> [(Posn,String)] -> IO String
runCpphsPass2 :: BoolOptions
-> [(FilePath, FilePath)]
-> FilePath
-> [(Posn, FilePath)]
-> IO FilePath
runCpphsPass2 BoolOptions
bools [(FilePath, FilePath)]
defines FilePath
filename [(Posn, FilePath)]
pass1 = do
  FilePath
pass2 <- [(FilePath, FilePath)]
-> BoolOptions -> [(Posn, FilePath)] -> IO FilePath
macroPass [(FilePath, FilePath)]
defines BoolOptions
bools [(Posn, FilePath)]
pass1
  let result :: FilePath
result= if Bool -> Bool
not (BoolOptions -> Bool
macros BoolOptions
bools)
              then if   BoolOptions -> Bool
stripC89 BoolOptions
bools Bool -> Bool -> Bool
|| BoolOptions -> Bool
stripEol BoolOptions
bools
                   then (WordStyle -> FilePath) -> [WordStyle] -> FilePath
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap WordStyle -> FilePath
deWordStyle ([WordStyle] -> FilePath) -> [WordStyle] -> FilePath
forall a b. (a -> b) -> a -> b
$
                        Bool -> Bool -> Bool -> Bool -> [(Posn, FilePath)] -> [WordStyle]
tokenise (BoolOptions -> Bool
stripEol BoolOptions
bools) (BoolOptions -> Bool
stripC89 BoolOptions
bools)
                                 (BoolOptions -> Bool
ansi BoolOptions
bools) (BoolOptions -> Bool
lang BoolOptions
bools) [(Posn, FilePath)]
pass1
                   else [FilePath] -> FilePath
unlines (((Posn, FilePath) -> FilePath) -> [(Posn, FilePath)] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (Posn, FilePath) -> FilePath
forall a b. (a, b) -> b
snd [(Posn, FilePath)]
pass1)
              else FilePath
pass2
      pass3 :: FilePath -> FilePath
pass3 = if BoolOptions -> Bool
literate BoolOptions
bools then FilePath -> FilePath -> FilePath
Unlit.unlit FilePath
filename else FilePath -> FilePath
forall a. a -> a
id
  FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> FilePath
pass3 FilePath
result)

runCpphsReturningSymTab :: CpphsOptions -> FilePath -> String
             -> IO (String,[(String,String)])
runCpphsReturningSymTab :: CpphsOptions
-> FilePath -> FilePath -> IO (FilePath, [(FilePath, FilePath)])
runCpphsReturningSymTab CpphsOptions
options' FilePath
filename FilePath
input = do
  let options :: CpphsOptions
options= CpphsOptions
options'{ includes :: [FilePath]
includes= (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath
forall a. Eq a => [a] -> [a] -> [a]
trailing FilePath
"\\/") (CpphsOptions -> [FilePath]
includes CpphsOptions
options') }
  let bools :: BoolOptions
bools  = CpphsOptions -> BoolOptions
boolopts CpphsOptions
options
      preInc :: FilePath
preInc = case CpphsOptions -> [FilePath]
preInclude CpphsOptions
options of
                 [] -> FilePath
""
                 [FilePath]
is -> (FilePath -> FilePath) -> [FilePath] -> FilePath
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\FilePath
f->FilePath
"#include \""FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
fFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"\"\n") [FilePath]
is 
                       FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"#line 1 \""FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath -> FilePath
cleanPath FilePath
filenameFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"\"\n"
  (FilePath
pass2,[(FilePath, FilePath)]
syms) <-
      if BoolOptions -> Bool
macros BoolOptions
bools then do
          [(Posn, FilePath)]
pass1 <- FilePath
-> [(FilePath, FilePath)]
-> [FilePath]
-> BoolOptions
-> FilePath
-> IO [(Posn, FilePath)]
cppIfdef FilePath
filename (CpphsOptions -> [(FilePath, FilePath)]
defines CpphsOptions
options) (CpphsOptions -> [FilePath]
includes CpphsOptions
options)
                            BoolOptions
bools (FilePath
preIncFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
input)
          [(FilePath, FilePath)]
-> BoolOptions
-> [(Posn, FilePath)]
-> IO (FilePath, [(FilePath, FilePath)])
macroPassReturningSymTab (CpphsOptions -> [(FilePath, FilePath)]
defines CpphsOptions
options) BoolOptions
bools [(Posn, FilePath)]
pass1
      else do
          [(Posn, FilePath)]
pass1 <- FilePath
-> [(FilePath, FilePath)]
-> [FilePath]
-> BoolOptions
-> FilePath
-> IO [(Posn, FilePath)]
cppIfdef FilePath
filename (CpphsOptions -> [(FilePath, FilePath)]
defines CpphsOptions
options) (CpphsOptions -> [FilePath]
includes CpphsOptions
options)
                            BoolOptions
bools{macros :: Bool
macros=Bool
True} (FilePath
preIncFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
input)
          (FilePath
_,[(FilePath, FilePath)]
syms) <- [(FilePath, FilePath)]
-> BoolOptions
-> [(Posn, FilePath)]
-> IO (FilePath, [(FilePath, FilePath)])
macroPassReturningSymTab (CpphsOptions -> [(FilePath, FilePath)]
defines CpphsOptions
options) BoolOptions
bools [(Posn, FilePath)]
pass1
          [(Posn, FilePath)]
pass1 <- FilePath
-> [(FilePath, FilePath)]
-> [FilePath]
-> BoolOptions
-> FilePath
-> IO [(Posn, FilePath)]
cppIfdef FilePath
filename (CpphsOptions -> [(FilePath, FilePath)]
defines CpphsOptions
options) (CpphsOptions -> [FilePath]
includes CpphsOptions
options)
                            BoolOptions
bools (FilePath
preIncFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
input)
          let result :: FilePath
result = if   BoolOptions -> Bool
stripC89 BoolOptions
bools Bool -> Bool -> Bool
|| BoolOptions -> Bool
stripEol BoolOptions
bools
                       then (WordStyle -> FilePath) -> [WordStyle] -> FilePath
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap WordStyle -> FilePath
deWordStyle ([WordStyle] -> FilePath) -> [WordStyle] -> FilePath
forall a b. (a -> b) -> a -> b
$
                            Bool -> Bool -> Bool -> Bool -> [(Posn, FilePath)] -> [WordStyle]
tokenise (BoolOptions -> Bool
stripEol BoolOptions
bools) (BoolOptions -> Bool
stripC89 BoolOptions
bools)
                                     (BoolOptions -> Bool
ansi BoolOptions
bools) (BoolOptions -> Bool
lang BoolOptions
bools) [(Posn, FilePath)]
pass1
                       else FilePath -> FilePath
forall a. [a] -> [a]
init (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines (((Posn, FilePath) -> FilePath) -> [(Posn, FilePath)] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (Posn, FilePath) -> FilePath
forall a b. (a, b) -> b
snd [(Posn, FilePath)]
pass1)
          (FilePath, [(FilePath, FilePath)])
-> IO (FilePath, [(FilePath, FilePath)])
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
result,[(FilePath, FilePath)]
syms)

  let pass3 :: FilePath -> FilePath
pass3 = if BoolOptions -> Bool
literate BoolOptions
bools then FilePath -> FilePath -> FilePath
Unlit.unlit FilePath
filename else FilePath -> FilePath
forall a. a -> a
id
  (FilePath, [(FilePath, FilePath)])
-> IO (FilePath, [(FilePath, FilePath)])
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> FilePath
pass3 FilePath
pass2, [(FilePath, FilePath)]
syms)