    --  C -> Haskell Compiler: main module
    --
    --  Author : Manuel M T Chakravarty
    --  Derived: 12 August 99
    --
    --  Version $Revision: 1.6 $ from $Date: 2005/07/03 14:58:16 $
    --
    --  Copyright (c) [1999..2004] Manuel M T Chakravarty
    --
    --  This file is free software; you can redistribute it and/or modify
    --  it under the terms of the GNU General Public License as published by
    --  the Free Software Foundation; either version 2 of the License, or
    --  (at your option) any later version.
    --
    --  This file is distributed in the hope that it will be useful,
    --  but WITHOUT ANY WARRANTY; without even the implied warranty of
    --  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    --  GNU General Public License for more details.
    --
    --- DESCRIPTION ---------------------------------------------------------------
    --
    --  This is the main module of the compiler.  It sets the version, processes
    --  the command line arguments, and controls the compilation process.
    --
    --  Originally, derived from `Main.hs' of the Nepal Compiler.
    --
    --- DOCU ----------------------------------------------------------------------
    --
    --  language: Haskell 98
    --
    --  Usage:
    --  ------
    --
    --    c2hs [ option... ] header-file binding-file
    --
    --  The compiler is supposed to emit a Haskell program that expands all hooks
    --  in the given binding file.
    --
    --  File name suffix:
    --  -----------------
    --
    --  Note: These also depend on suffixes defined in the compiler proper.
    --
    --  .h   C header file
    --  .i   pre-processed C header file
    --  .hs  Haskell file
    --  .chs Haskell file with C->Haskell hooks (binding file)
    --  .chi C->Haskell interface file
    --
    --  Options:
    --  --------
    --
    --  -C CPPOPTS
    --  --cppopts=CPPOPTS
    --        Pass the additional options CPPOPTS to the C preprocessor.
    --
    --        Repeated occurrences accumulate.
    --
    --  -c CPP
    --  --cpp=CPP
    --        Use the executable CPP to invoke CPP.
    --
    --        In the case of repeated occurrences, the last takes effect.
    --
    --  -d TYPE
    --  --dump=TYPE
    --        Dump intermediate representation:
    --
    --        + if TYPE is `trace', trace the compiler phases (to stderr)
    --        + if TYPE is `genbind', trace binding generation (to stderr)
    --        + if TYPE is `ctrav', trace C declaration traversal (to stderr)
    --        + if TYPE is `chs', dump the binding file (insert `.dump' into the
    --          file name to avoid overwriting the original file)
    --
    --  -h, -?
    --  --help
    --        Dump brief usage information to stderr.
    --
    --  -i DIRS
    --  --include=DIRS
    --        Search the colon separated list of directories DIRS when searching
    --        for .chi files.
    --
    --  -k
    --  --keep
    --        Keep the intermediate file that contains the pre-processed C header
    --        (it carries the suffix `.i').
    --
    --  -o FILE
    --  --output=FILE
    --        Place output in file FILE.
    --
    --        If `-o' is not specified, the default is to put the output for
    --        `source.chs' in `source.hs' in the same directory that contains the
    --        binding file.  If specified, the emitted C header file is put into
    --        the same directory as the output file.  The same holds for
    --        C->Haskell interface file.  All generated files also share the
    --        basename.
    --
    --  -t PATH
    --  --output-dir=PATH
    --        Place generated files in the directory PATH.
    --
    --        If this option as well as the `-o' option is given, the basename of
    --        the file specified with `-o' is put in the directory specified with
    --        `-t'.
    --
    --  -v,
    --  --version
    --        Print (on standard error output) the version and copyright
    --        information of the compiler (before doing anything else).
    --
    --  -p FILE
    --  --precomp=FILE
    --        Use or generate a precompiled header. If a header file is
    --        given write a condensed version of the header file into
    --        FILE. If a binding file is given that does not contain any C
    --        declarations itself, use the condensed information in FILE
    --        to generate the binding. Using a precompiled header file will
    --        significantly speed up the translation of a binding module.
    --
    --  --old-ffi [=yes|=no]
    --        Generate hooks using pre-standard FFI libraries.  This currently
    --        affects only call hooks where instead of `Addr' types
    --        `Ptr <someOtherType>' is used.
    --
    --  --lock=NAME
    --        Wrap each foreign function call in the function NAME. This
    --        function is usually a function that acquires a lock for
    --        the memory region that the called function is about to access.
    --        A wrap function can also be specified within the file in the
    --        context hook, in which case it overrides the command line function.
    --        The wrapper function can be omitted on a call-by-call basis by
    --        using the nolock option in the call hook.
    --
    --- TODO ----------------------------------------------------------------------
    --

    module Gtk2HsC2Hs (c2hsMain)
    where

    -- standard libraries
    import Data.List          (isPrefixOf)
    import System.IO          (openFile)
    import System.Process     (runProcess, waitForProcess)
    import Control.Monad      (when, unless, mapM)
    import Data.Maybe      (fromJust)

    -- base libraries
    import System.Console.GetOpt
                      (ArgOrder(..), OptDescr(..), ArgDescr(..), usageInfo, getOpt)
    import FNameOps   (suffix, basename, dirname, stripSuffix, addPath,
                       splitSearchPath)
    import Errors     (interr)
    import UNames     (saveRootNameSupply, restoreRootNameSupply)
    import Binary     (Binary(..), putBinFileWithDict, getBinFileWithDict)

    -- c2hs modules
    import C2HSState  (CST, nop, runC2HS, fatal, fatalsHandledBy, getId,
                       ExitCode(..), stderr, IOMode(..), putStrCIO, hPutStrCIO,
                       hPutStrLnCIO, exitWithCIO, getProgNameCIO,
                       ioeGetErrorString, ioeGetFileName, doesFileExistCIO,
                       removeFileCIO, liftIO,
                       fileFindInCIO, mktempCIO, openFileCIO, hCloseCIO,
                       SwitchBoard(..), Traces(..), setTraces,
                       traceSet, setSwitch, getSwitch, putTraceStr)
    import C          (AttrC, hsuffix, isuffix, loadAttrC)
    import CHS        (CHSModule, skipToLangPragma, hasCPP, loadCHS, dumpCHS, loadAllCHI,
                       hssuffix, chssuffix, dumpCHI)
    import GenHeader  (genHeader)
    import GenBind    (expandHooks)
    import Version    (version, copyright, disclaimer)
    import C2HSConfig (cpp, cppopts, cppoptsdef, hpaths, tmpdir)

    -- wrapper running the compiler
    -- ============================

    c2hsMain :: [String] -> IO ()
    c2hsMain :: [String] -> IO ()
    c2hsMain  = (String, String, String) -> CST () () -> IO ()
    forall a. (String, String, String) -> CST () a -> IO a
    runC2HS (String
    version, String
    copyright, String
    disclaimer) (CST () () -> IO ())
    -> ([String] -> CST () ()) -> [String] -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> CST () ()
    forall s. [String] -> CST s ()
    compile

    -- option handling
    -- ===============

    -- header is output in case of help, before the descriptions of the options;
    -- errTrailer is output after an error message
    --
    header :: String -> String -> String -> String
    header :: String -> String -> String -> String
    header String
    version String
    copyright String
    disclaimer  =
      String
    version String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    copyright String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    disclaimer
      String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n\nUsage: c2hs [ option... ] header-file binding-file\n"

    trailer, errTrailer :: String
    trailer :: String
    trailer    = String
    "\n\
                 \The header file must be a C header file matching the given \
                 \binding file.\n\
                 \The dump TYPE can be\n\
                 \  trace   -- trace compiler phases\n\
                 \  genbind -- trace binding generation\n\
                 \  ctrav   -- trace C declaration traversal\n\
                 \  chs     -- dump the binding file (adds `.dump' to the name)\n"
    errTrailer :: String
    errTrailer = String
    "Try the option `--help' on its own for more information.\n"

    -- supported option types
    --
    data Flag = CPPOpts String      -- additional options for C preprocessor
              | CPP     String      -- program name of C preprocessor
              | Dump    DumpType    -- dump internal information
              | Help                -- print brief usage information
              | Keep                -- keep the .i file
              | Include String      -- list of directories to search .chi files
              | Output  String      -- file where the generated file should go
              | OutDir  String      -- directory where generates files should go
              | PreComp String      -- write or read a precompiled header
              | LockFun String      -- wrap each function call in this function
              | Version             -- print version information on stderr
              | Error   String      -- error occurred during processing of options
              deriving Flag -> Flag -> Bool
    (Flag -> Flag -> Bool) -> (Flag -> Flag -> Bool) -> Eq Flag
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Flag -> Flag -> Bool
    == :: Flag -> Flag -> Bool
    $c/= :: Flag -> Flag -> Bool
    /= :: Flag -> Flag -> Bool
    Eq

    data DumpType = Trace         -- compiler trace
                  | GenBind       -- trace `GenBind'
                  | CTrav         -- trace `CTrav'
                  | CHS           -- dump binding file
                  deriving DumpType -> DumpType -> Bool
    (DumpType -> DumpType -> Bool)
    -> (DumpType -> DumpType -> Bool) -> Eq DumpType
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: DumpType -> DumpType -> Bool
    == :: DumpType -> DumpType -> Bool
    $c/= :: DumpType -> DumpType -> Bool
    /= :: DumpType -> DumpType -> Bool
    Eq

    -- option description suitable for `GetOpt'
    --
    options :: [OptDescr Flag]
    options :: [OptDescr Flag]
    options  = [
      String -> [String] -> ArgDescr Flag -> String -> OptDescr Flag
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option [Char
    'C']
             [String
    "cppopts"]
             ((String -> Flag) -> String -> ArgDescr Flag
    forall a. (String -> a) -> String -> ArgDescr a
    ReqArg String -> Flag
    CPPOpts String
    "CPPOPTS")
             String
    "pass CPPOPTS to the C preprocessor",
      String -> [String] -> ArgDescr Flag -> String -> OptDescr Flag
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option [Char
    'c']
             [String
    "cpp"]
             ((String -> Flag) -> String -> ArgDescr Flag
    forall a. (String -> a) -> String -> ArgDescr a
    ReqArg String -> Flag
    CPP String
    "CPP")
             String
    "use executable CPP to invoke C preprocessor",
      String -> [String] -> ArgDescr Flag -> String -> OptDescr Flag
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option [Char
    'd']
             [String
    "dump"]
             ((String -> Flag) -> String -> ArgDescr Flag
    forall a. (String -> a) -> String -> ArgDescr a
    ReqArg String -> Flag
    dumpArg String
    "TYPE")
             String
    "dump internal information (for debugging)",
      String -> [String] -> ArgDescr Flag -> String -> OptDescr Flag
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option [Char
    'h', Char
    '?']
             [String
    "help"]
             (Flag -> ArgDescr Flag
    forall a. a -> ArgDescr a
    NoArg Flag
    Help)
             String
    "brief help (the present message)",
      String -> [String] -> ArgDescr Flag -> String -> OptDescr Flag
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option [Char
    'i']
             [String
    "include"]
             ((String -> Flag) -> String -> ArgDescr Flag
    forall a. (String -> a) -> String -> ArgDescr a
    ReqArg String -> Flag
    Include String
    "INCLUDE")
             String
    "include paths for .chi files",
      String -> [String] -> ArgDescr Flag -> String -> OptDescr Flag
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option [Char
    'k']
             [String
    "keep"]
             (Flag -> ArgDescr Flag
    forall a. a -> ArgDescr a
    NoArg Flag
    Keep)
             String
    "keep pre-processed C header",
      String -> [String] -> ArgDescr Flag -> String -> OptDescr Flag
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option [Char
    'o']
             [String
    "output"]
             ((String -> Flag) -> String -> ArgDescr Flag
    forall a. (String -> a) -> String -> ArgDescr a
    ReqArg String -> Flag
    Output String
    "FILE")
             String
    "output result to FILE (should end in .hs)",
      String -> [String] -> ArgDescr Flag -> String -> OptDescr Flag
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option [Char
    't']
             [String
    "output-dir"]
             ((String -> Flag) -> String -> ArgDescr Flag
    forall a. (String -> a) -> String -> ArgDescr a
    ReqArg String -> Flag
    OutDir String
    "PATH")
             String
    "place generated files in PATH",
      String -> [String] -> ArgDescr Flag -> String -> OptDescr Flag
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option [Char
    'p']
             [String
    "precomp"]
             ((String -> Flag) -> String -> ArgDescr Flag
    forall a. (String -> a) -> String -> ArgDescr a
    ReqArg String -> Flag
    PreComp String
    "FILE")
             String
    "generate or read precompiled header file FILE",
      String -> [String] -> ArgDescr Flag -> String -> OptDescr Flag
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option [Char
    'l']
             [String
    "lock"]
             ((String -> Flag) -> String -> ArgDescr Flag
    forall a. (String -> a) -> String -> ArgDescr a
    ReqArg String -> Flag
    LockFun String
    "NAME")
             String
    "wrap each foreign call with the function NAME",
      String -> [String] -> ArgDescr Flag -> String -> OptDescr Flag
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option [Char
    'v']
             [String
    "version"]
             (Flag -> ArgDescr Flag
    forall a. a -> ArgDescr a
    NoArg Flag
    Version)
             String
    "show version information"]

    -- convert argument of `Dump' option
    --
    dumpArg           :: String -> Flag
    dumpArg :: String -> Flag
    dumpArg String
    "trace"    = DumpType -> Flag
    Dump DumpType
    Trace
    dumpArg String
    "genbind"  = DumpType -> Flag
    Dump DumpType
    GenBind
    dumpArg String
    "ctrav"    = DumpType -> Flag
    Dump DumpType
    CTrav
    dumpArg String
    "chs"      = DumpType -> Flag
    Dump DumpType
    CHS
    dumpArg String
    _          = String -> Flag
    Error String
    "Illegal dump type."

    -- main process (set up base configuration, analyse command line, and execute
    -- compilation process)
    --
    --  * Exceptions are caught and reported
    --
    compile :: [String] -> CST s ()
    compile :: forall s. [String] -> CST s ()
    compile [String]
    cmdLine =
      do
        CST s ()
    forall s. CST s ()
    setup
        case ArgOrder Flag
    -> [OptDescr Flag] -> [String] -> ([Flag], [String], [String])
    forall a.
    ArgOrder a -> [OptDescr a] -> [String] -> ([a], [String], [String])
    getOpt ArgOrder Flag
    forall a. ArgOrder a
    RequireOrder [OptDescr Flag]
    options [String]
    cmdLine of
          ([Flag
    Help]   , []  , []) -> [Flag] -> [String] -> CST s ()
    forall {s}. [Flag] -> [String] -> PreCST SwitchBoard s ()
    doExecute [Flag
    Help]    []
          ([Flag
    Version], []  , []) -> [Flag] -> [String] -> CST s ()
    forall {s}. [Flag] -> [String] -> PreCST SwitchBoard s ()
    doExecute [Flag
    Version] []
          ([Flag]
    opts     , [String]
    args, [])
            | [String] -> Bool
    properArgs [String]
    args -> [Flag] -> [String] -> CST s ()
    forall {s}. [Flag] -> [String] -> PreCST SwitchBoard s ()
    doExecute [Flag]
    opts [String]
    args
            | Bool
    otherwise       -> [String] -> CST s ()
    forall s a. [String] -> CST s a
    raiseErrs [String
    wrongNoOfArgsErr]
          ([Flag]
    _   , [String]
    _   , [String]
    errs)  -> [String] -> CST s ()
    forall s a. [String] -> CST s a
    raiseErrs [String]
    errs
      where
        properArgs :: [String] -> Bool
    properArgs [String
    file1, String
    file2] = String -> String
    suffix String
    file1 String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    hsuffix
                                    Bool -> Bool -> Bool
    && String -> String
    suffix String
    file2 String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    chssuffix
        properArgs [String]
    _              = Bool
    False
        --
        doExecute :: [Flag] -> [String] -> PreCST SwitchBoard s ()
    doExecute [Flag]
    opts [String]
    args = [Flag] -> [String] -> PreCST SwitchBoard s ()
    forall {s}. [Flag] -> [String] -> PreCST SwitchBoard s ()
    execute [Flag]
    opts [String]
    args
                                  PreCST SwitchBoard s ()
    -> (IOError -> PreCST SwitchBoard s ()) -> PreCST SwitchBoard s ()
    forall e s a.
    PreCST e s a -> (IOError -> PreCST e s a) -> PreCST e s a
    `fatalsHandledBy` IOError -> PreCST SwitchBoard s ()
    forall {e} {s} {b}. IOError -> PreCST e s b
    failureHandler
        --
        wrongNoOfArgsErr :: String
    wrongNoOfArgsErr =
          String
    "Supply the header file followed by the binding file.\n\
          \The header file can be omitted if it is supplied in the binding file.\n\
          \The binding file can be omitted if the --precomp flag is given.\n"
        --
        -- exception handler
        --
        failureHandler :: IOError -> PreCST e s b
    failureHandler IOError
    err =
          do
            let msg :: String
    msg   = IOError -> String
    ioeGetErrorString IOError
    err
                fnMsg :: String
    fnMsg = case IOError -> Maybe String
    ioeGetFileName IOError
    err of
                           Maybe String
    Nothing -> String
    ""
                           Just String
    s  -> String
    " (file: `" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "')"
            Handle -> String -> PreCST e s ()
    forall e s. Handle -> String -> PreCST e s ()
    hPutStrLnCIO Handle
    stderr (String
    msg String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    fnMsg)
            ExitCode -> PreCST e s b
    forall e s a. ExitCode -> PreCST e s a
    exitWithCIO (ExitCode -> PreCST e s b) -> ExitCode -> PreCST e s b
    forall a b. (a -> b) -> a -> b
    $ Int -> ExitCode
    ExitFailure Int
    1

    -- set up base configuration
    --
    setup :: CST s ()
    setup :: forall s. CST s ()
    setup  = do
               String -> CST s ()
    forall s. String -> CST s ()
    setCPP     String
    cpp
               [String] -> CST s ()
    forall s. [String] -> CST s ()
    addCPPOpts [String]
    cppopts
               [String] -> CST s ()
    forall s. [String] -> CST s ()
    addHPaths  [String]
    hpaths

    -- output error message
    --
    raiseErrs      :: [String] -> CST s a
    raiseErrs :: forall s a. [String] -> CST s a
    raiseErrs [String]
    errs = do
                       Handle -> String -> PreCST SwitchBoard s ()
    forall e s. Handle -> String -> PreCST e s ()
    hPutStrCIO Handle
    stderr ([String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [String]
    errs)
                       Handle -> String -> PreCST SwitchBoard s ()
    forall e s. Handle -> String -> PreCST e s ()
    hPutStrCIO Handle
    stderr String
    errTrailer
                       ExitCode -> CST s a
    forall e s a. ExitCode -> PreCST e s a
    exitWithCIO (ExitCode -> CST s a) -> ExitCode -> CST s a
    forall a b. (a -> b) -> a -> b
    $ Int -> ExitCode
    ExitFailure Int
    1

    -- Process tasks
    -- -------------

    -- execute the compilation task
    --
    --  * if `Help' is present, emit the help message and ignore the rest
    --  * if `Version' is present, do it first (and only once)
    --  * actual compilation is only invoked if we have one or two extra arguments
    --   (otherwise, it is just skipped)
    --
    execute :: [Flag] -> [FilePath] -> CST s ()
    execute :: forall {s}. [Flag] -> [String] -> PreCST SwitchBoard s ()
    execute [Flag]
    opts [String]
    args | Flag
    Help Flag -> [Flag] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Flag]
    opts = CST s ()
    forall s. CST s ()
    help
                      | Bool
    otherwise        =
      do
        let vs :: [Flag]
    vs      = (Flag -> Bool) -> [Flag] -> [Flag]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Flag -> Flag -> Bool
    forall a. Eq a => a -> a -> Bool
    == Flag
    Version) [Flag]
    opts
            opts' :: [Flag]
    opts'   = (Flag -> Bool) -> [Flag] -> [Flag]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Flag -> Flag -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Flag
    Version) [Flag]
    opts
        (Flag -> CST s ()) -> [Flag] -> CST s ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ Flag -> CST s ()
    forall s. Flag -> CST s ()
    processOpt ([Flag] -> [Flag]
    forall {a}. [a] -> [a]
    atMostOne [Flag]
    vs [Flag] -> [Flag] -> [Flag]
    forall a. [a] -> [a] -> [a]
    ++ [Flag]
    opts')

        let (String
    headerFile, String
    bndFile) = [String] -> (String, String)
    determineFileTypes [String]
    args

        Maybe String
    preCompFile <- (SwitchBoard -> Maybe String) -> CST s (Maybe String)
    forall a s. (SwitchBoard -> a) -> CST s a
    getSwitch SwitchBoard -> Maybe String
    preCompSB

        Bool -> CST s () -> CST s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Maybe String
    preCompFileMaybe String -> Maybe String -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Maybe String
    forall a. Maybe a
    Nothing) (CST s () -> CST s ()) -> CST s () -> CST s ()
    forall a b. (a -> b) -> a -> b
    $
          String -> String -> CST s ()
    forall s. String -> String -> CST s ()
    preCompileHeader String
    headerFile (Maybe String -> String
    forall a. HasCallStack => Maybe a -> a
    fromJust Maybe String
    preCompFile)
            CST s () -> (IOError -> CST s ()) -> CST s ()
    forall e s a.
    PreCST e s a -> (IOError -> PreCST e s a) -> PreCST e s a
    `fatalsHandledBy` IOError -> CST s ()
    forall {e} {s} {b}. IOError -> PreCST e s b
    ioErrorHandler

        let bndFileWithoutSuffix :: String
    bndFileWithoutSuffix  = String -> String
    stripSuffix String
    bndFile
        Bool -> CST s () -> CST s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    bndFile) (CST s () -> CST s ()) -> CST s () -> CST s ()
    forall a b. (a -> b) -> a -> b
    $ do
          String -> CST s ()
    forall s. String -> CST s ()
    computeOutputName String
    bndFileWithoutSuffix
          String -> Maybe String -> String -> CST s ()
    forall s. String -> Maybe String -> String -> CST s ()
    process String
    headerFile Maybe String
    preCompFile String
    bndFileWithoutSuffix
                   CST s () -> (IOError -> CST s ()) -> CST s ()
    forall e s a.
    PreCST e s a -> (IOError -> PreCST e s a) -> PreCST e s a
    `fatalsHandledBy` IOError -> CST s ()
    forall {e} {s} {b}. IOError -> PreCST e s b
    ioErrorHandler
      where
        atMostOne :: [a] -> [a]
    atMostOne = (([a] -> a -> [a]) -> [a] -> [a] -> [a]
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl (\[a]
    _ a
    x -> [a
    x]) [])

        determineFileTypes :: [String] -> (String, String)
    determineFileTypes [String
    hfile, String
    bfile]                = (String
    hfile, String
    bfile)
        determineFileTypes [String
    file] | String -> String
    suffix String
    fileString -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    ==String
    hsuffix = (String
    file, String
    "")
                                  | Bool
    otherwise            = (String
    "", String
    file)
        determineFileTypes []                            = (String
    "", String
    "")

        ioErrorHandler :: IOError -> PreCST e s b
    ioErrorHandler IOError
    ioerr = do
                                 String
    name <- PreCST e s String
    forall e s. PreCST e s String
    getProgNameCIO
                                 String -> PreCST e s ()
    forall e s. String -> PreCST e s ()
    putStrCIO (String -> PreCST e s ()) -> String -> PreCST e s ()
    forall a b. (a -> b) -> a -> b
    $
                                   String
    name String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ": " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ IOError -> String
    ioeGetErrorString IOError
    ioerr String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n"
                                 ExitCode -> PreCST e s b
    forall e s a. ExitCode -> PreCST e s a
    exitWithCIO (ExitCode -> PreCST e s b) -> ExitCode -> PreCST e s b
    forall a b. (a -> b) -> a -> b
    $ Int -> ExitCode
    ExitFailure Int
    1

    -- emit help message
    --
    help :: CST s ()
    help :: forall s. CST s ()
    help  = do
              (String
    version, String
    copyright, String
    disclaimer) <- PreCST SwitchBoard s (String, String, String)
    forall e s. PreCST e s (String, String, String)
    getId
              String -> CST s ()
    forall e s. String -> PreCST e s ()
    putStrCIO (String -> [OptDescr Flag] -> String
    forall a. String -> [OptDescr a] -> String
    usageInfo (String -> String -> String -> String
    header String
    version String
    copyright String
    disclaimer) [OptDescr Flag]
    options)
              String -> CST s ()
    forall e s. String -> PreCST e s ()
    putStrCIO String
    trailer

    -- process an option
    --
    --  * `Help' cannot occur
    --
    processOpt                   :: Flag -> CST s ()
    processOpt :: forall s. Flag -> CST s ()
    processOpt (CPPOpts String
    cppopt )  = [String] -> CST s ()
    forall s. [String] -> CST s ()
    addCPPOpts [String
    cppopt]
    processOpt (CPP     String
    cpp    )  = String -> CST s ()
    forall s. String -> CST s ()
    setCPP     String
    cpp
    processOpt (Dump    DumpType
    dt     )  = DumpType -> CST s ()
    forall s. DumpType -> CST s ()
    setDump    DumpType
    dt
    processOpt (Flag
    Keep           )  = CST s ()
    forall s. CST s ()
    setKeep
    processOpt (Include String
    dirs   )  = String -> CST s ()
    forall s. String -> CST s ()
    setInclude String
    dirs
    processOpt (Output  String
    fname  )  = String -> CST s ()
    forall s. String -> CST s ()
    setOutput  String
    fname
    processOpt (OutDir  String
    fname  )  = String -> CST s ()
    forall s. String -> CST s ()
    setOutDir  String
    fname
    processOpt (PreComp String
    fname  )  = String -> CST s ()
    forall s. String -> CST s ()
    setPreComp String
    fname
    processOpt (LockFun String
    name   )  = String -> CST s ()
    forall s. String -> CST s ()
    setLockFun String
    name
    processOpt Flag
    Version            = do
                                      (String
    version, String
    _, String
    _) <- PreCST SwitchBoard s (String, String, String)
    forall e s. PreCST e s (String, String, String)
    getId
                                      String -> CST s ()
    forall e s. String -> PreCST e s ()
    putStrCIO (String
    version String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n")
    processOpt (Error   String
    msg    )  = String -> CST s ()
    forall s. String -> CST s ()
    abort      String
    msg

    -- emit error message and raise an error
    --
    abort     :: String -> CST s ()
    abort :: forall s. String -> CST s ()
    abort String
    msg  = do
                   Handle -> String -> CST s ()
    forall e s. Handle -> String -> PreCST e s ()
    hPutStrLnCIO Handle
    stderr String
    msg
                   Handle -> String -> CST s ()
    forall e s. Handle -> String -> PreCST e s ()
    hPutStrCIO Handle
    stderr String
    errTrailer
                   String -> CST s ()
    forall e s a. String -> PreCST e s a
    fatal String
    "Error in command line options"

    -- Compute the base name for all generated files (Haskell, C header, and .chi
    -- file)
    --
    --  * The result is available from the `outputSB' switch
    --
    computeOutputName :: FilePath -> CST s ()
    computeOutputName :: forall s. String -> CST s ()
    computeOutputName String
    bndFileNoSuffix =
      do
        String
    output <- (SwitchBoard -> String) -> CST s String
    forall a s. (SwitchBoard -> a) -> CST s a
    getSwitch SwitchBoard -> String
    outputSB
        String
    outDir <- (SwitchBoard -> String) -> CST s String
    forall a s. (SwitchBoard -> a) -> CST s a
    getSwitch SwitchBoard -> String
    outDirSB
        let dir :: String
    dir  = if      String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    outDir Bool -> Bool -> Bool
    && String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    output then String -> String
    dirname String
    bndFileNoSuffix
                   else if String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    outDir                then String -> String
    dirname String
    output
                   else                                    String
    outDir
        let base :: String
    base = if String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    output then String -> String
    basename String
    bndFileNoSuffix
                   else                String -> String
    basename String
    output
        (SwitchBoard -> SwitchBoard) -> CST s ()
    forall s. (SwitchBoard -> SwitchBoard) -> CST s ()
    setSwitch ((SwitchBoard -> SwitchBoard) -> CST s ())
    -> (SwitchBoard -> SwitchBoard) -> CST s ()
    forall a b. (a -> b) -> a -> b
    $ \SwitchBoard
    sb -> SwitchBoard
    sb {
                             outputSB = dir `addPath` base,
                             outDirSB = dir
                           }

    -- set switches
    -- ------------

    -- set the options for the C proprocessor
    --
    --  * any header search path that is set with `-IDIR' is also added to
    --   `hpathsSB'
    --
    addCPPOpts      :: [String] -> CST s ()
    addCPPOpts :: forall s. [String] -> CST s ()
    addCPPOpts [String]
    opts  =
      do
        let iopts :: [String]
    iopts = [String
    opt | String
    opt <- [String]
    opts, String
    "-I" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String
    opt, String
    "-I-" String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= String
    opt]
        [String] -> CST s ()
    forall s. [String] -> CST s ()
    addHPaths ([String] -> CST s ())
    -> ([String] -> [String]) -> [String] -> CST s ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> String -> String
    forall a. Int -> [a] -> [a]
    drop Int
    2) ([String] -> CST s ()) -> [String] -> CST s ()
    forall a b. (a -> b) -> a -> b
    $ [String]
    iopts
        [String] -> CST s ()
    forall s. [String] -> CST s ()
    addOpts [String]
    opts
      where
        addOpts :: [String] -> CST s ()
    addOpts [String]
    opts  = (SwitchBoard -> SwitchBoard) -> CST s ()
    forall s. (SwitchBoard -> SwitchBoard) -> CST s ()
    setSwitch ((SwitchBoard -> SwitchBoard) -> CST s ())
    -> (SwitchBoard -> SwitchBoard) -> CST s ()
    forall a b. (a -> b) -> a -> b
    $
                          \SwitchBoard
    sb -> SwitchBoard
    sb {cppOptsSB = cppOptsSB sb ++ opts}

    -- set the program name of the C proprocessor
    --
    setCPP       :: FilePath -> CST s ()
    setCPP :: forall s. String -> CST s ()
    setCPP String
    fname  = (SwitchBoard -> SwitchBoard) -> CST s ()
    forall s. (SwitchBoard -> SwitchBoard) -> CST s ()
    setSwitch ((SwitchBoard -> SwitchBoard) -> CST s ())
    -> (SwitchBoard -> SwitchBoard) -> CST s ()
    forall a b. (a -> b) -> a -> b
    $ \SwitchBoard
    sb -> SwitchBoard
    sb {cppSB = fname}

    -- add header file search paths
    --
    addHPaths       :: [FilePath] -> CST s ()
    addHPaths :: forall s. [String] -> CST s ()
    addHPaths [String]
    paths  = (SwitchBoard -> SwitchBoard) -> CST s ()
    forall s. (SwitchBoard -> SwitchBoard) -> CST s ()
    setSwitch ((SwitchBoard -> SwitchBoard) -> CST s ())
    -> (SwitchBoard -> SwitchBoard) -> CST s ()
    forall a b. (a -> b) -> a -> b
    $ \SwitchBoard
    sb -> SwitchBoard
    sb {hpathsSB = paths ++ hpathsSB sb}

    -- set the given dump option
    --
    setDump         :: DumpType -> CST s ()
    setDump :: forall s. DumpType -> CST s ()
    setDump DumpType
    Trace    = (Traces -> Traces) -> CST s ()
    forall s. (Traces -> Traces) -> CST s ()
    setTraces ((Traces -> Traces) -> CST s ()) -> (Traces -> Traces) -> CST s ()
    forall a b. (a -> b) -> a -> b
    $ \Traces
    ts -> Traces
    ts {tracePhasesSW  = True}
    setDump DumpType
    GenBind  = (Traces -> Traces) -> CST s ()
    forall s. (Traces -> Traces) -> CST s ()
    setTraces ((Traces -> Traces) -> CST s ()) -> (Traces -> Traces) -> CST s ()
    forall a b. (a -> b) -> a -> b
    $ \Traces
    ts -> Traces
    ts {traceGenBindSW = True}
    setDump DumpType
    CTrav    = (Traces -> Traces) -> CST s ()
    forall s. (Traces -> Traces) -> CST s ()
    setTraces ((Traces -> Traces) -> CST s ()) -> (Traces -> Traces) -> CST s ()
    forall a b. (a -> b) -> a -> b
    $ \Traces
    ts -> Traces
    ts {traceCTravSW   = True}
    setDump DumpType
    CHS      = (Traces -> Traces) -> CST s ()
    forall s. (Traces -> Traces) -> CST s ()
    setTraces ((Traces -> Traces) -> CST s ()) -> (Traces -> Traces) -> CST s ()
    forall a b. (a -> b) -> a -> b
    $ \Traces
    ts -> Traces
    ts {dumpCHSSW      = True}

    -- set flag to keep the pre-processed header file
    --
    setKeep :: CST s ()
    setKeep :: forall s. CST s ()
    setKeep  = (SwitchBoard -> SwitchBoard) -> CST s ()
    forall s. (SwitchBoard -> SwitchBoard) -> CST s ()
    setSwitch ((SwitchBoard -> SwitchBoard) -> CST s ())
    -> (SwitchBoard -> SwitchBoard) -> CST s ()
    forall a b. (a -> b) -> a -> b
    $ \SwitchBoard
    sb -> SwitchBoard
    sb {keepSB = True}

    -- set the search directories for .chi files
    --
    --  * Several -i flags are accumulated. Later paths have higher priority.
    --
    --  * The current directory is always searched last because it is the
    --   standard value in the compiler state.
    --
    setInclude :: String -> CST s ()
    setInclude :: forall s. String -> CST s ()
    setInclude String
    str = do
      let fp :: [String]
    fp = String -> [String]
    splitSearchPath String
    str
      (SwitchBoard -> SwitchBoard) -> CST s ()
    forall s. (SwitchBoard -> SwitchBoard) -> CST s ()
    setSwitch ((SwitchBoard -> SwitchBoard) -> CST s ())
    -> (SwitchBoard -> SwitchBoard) -> CST s ()
    forall a b. (a -> b) -> a -> b
    $ \SwitchBoard
    sb -> SwitchBoard
    sb {chiPathSB = fp ++ (chiPathSB sb)}

    -- set the output file name
    --
    setOutput       :: FilePath -> CST s ()
    setOutput :: forall s. String -> CST s ()
    setOutput String
    fname  = do
                         Bool -> CST s () -> CST s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (String -> String
    suffix String
    fname String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= String
    hssuffix) (CST s () -> CST s ()) -> CST s () -> CST s ()
    forall a b. (a -> b) -> a -> b
    $
                           [String] -> CST s ()
    forall s a. [String] -> CST s a
    raiseErrs [String
    "Output file should end in .hs!\n"]
                         (SwitchBoard -> SwitchBoard) -> CST s ()
    forall s. (SwitchBoard -> SwitchBoard) -> CST s ()
    setSwitch ((SwitchBoard -> SwitchBoard) -> CST s ())
    -> (SwitchBoard -> SwitchBoard) -> CST s ()
    forall a b. (a -> b) -> a -> b
    $ \SwitchBoard
    sb -> SwitchBoard
    sb {outputSB = stripSuffix fname}

    -- set the output directory
    --
    setOutDir       :: FilePath -> CST s ()
    setOutDir :: forall s. String -> CST s ()
    setOutDir String
    fname  = (SwitchBoard -> SwitchBoard) -> CST s ()
    forall s. (SwitchBoard -> SwitchBoard) -> CST s ()
    setSwitch ((SwitchBoard -> SwitchBoard) -> CST s ())
    -> (SwitchBoard -> SwitchBoard) -> CST s ()
    forall a b. (a -> b) -> a -> b
    $ \SwitchBoard
    sb -> SwitchBoard
    sb {outDirSB = fname}

    -- set the name of the generated header file
    --
    setHeader       :: FilePath -> CST s ()
    setHeader :: forall s. String -> CST s ()
    setHeader String
    fname  = (SwitchBoard -> SwitchBoard) -> CST s ()
    forall s. (SwitchBoard -> SwitchBoard) -> CST s ()
    setSwitch ((SwitchBoard -> SwitchBoard) -> CST s ())
    -> (SwitchBoard -> SwitchBoard) -> CST s ()
    forall a b. (a -> b) -> a -> b
    $ \SwitchBoard
    sb -> SwitchBoard
    sb {headerSB = fname}

    -- set the file name in which the precompiled header ends up
    --
    setPreComp      :: FilePath -> CST s ()
    setPreComp :: forall s. String -> CST s ()
    setPreComp String
    fname = (SwitchBoard -> SwitchBoard) -> CST s ()
    forall s. (SwitchBoard -> SwitchBoard) -> CST s ()
    setSwitch ((SwitchBoard -> SwitchBoard) -> CST s ())
    -> (SwitchBoard -> SwitchBoard) -> CST s ()
    forall a b. (a -> b) -> a -> b
    $ \SwitchBoard
    sb -> SwitchBoard
    sb { preCompSB = Just fname }

    -- set the name of the wrapper function that acquires a lock
    --
    setLockFun      :: String -> CST s ()
    setLockFun :: forall s. String -> CST s ()
    setLockFun String
    name = (SwitchBoard -> SwitchBoard) -> CST s ()
    forall s. (SwitchBoard -> SwitchBoard) -> CST s ()
    setSwitch ((SwitchBoard -> SwitchBoard) -> CST s ())
    -> (SwitchBoard -> SwitchBoard) -> CST s ()
    forall a b. (a -> b) -> a -> b
    $ \SwitchBoard
    sb -> SwitchBoard
    sb { lockFunSB = Just name }

    -- compilation process
    -- -------------------

    -- read the binding module, construct a header, run it through CPP, read it,
    -- and finally generate the Haskell target
    --
    --  * the header file name (first argument) may be empty; otherwise, it already
    --   contains the right suffix
    --
    --  * the binding file name has been stripped of the .chs suffix
    --
    process                    :: FilePath -> Maybe FilePath -> FilePath -> CST s ()
    process :: forall s. String -> Maybe String -> String -> CST s ()
    process String
    headerFile Maybe String
    preCompFile String
    bndFileStripped  =
      do
        -- load the Haskell binding module, any imported module with CHI information is
        -- only inserted as file name, the content of the CHI modules is inserted below
        -- using 'loadAllCHI'. This ensures that we don't look for a CHI file that is
        -- commented out using an #ifdef
        --
        (CHSModule
    chsMod , String
    warnmsgs) <- String -> CST s (CHSModule, String)
    forall s. String -> CST s (CHSModule, String)
    loadCHS String
    bndFile

        String -> CST s ()
    forall e s. String -> PreCST e s ()
    putStrCIO String
    warnmsgs

        -- check if a CPP language pragma is present and, if so, run CPP on the file
        -- and re-read it
        CHSModule
    chsMod <- case CHSModule -> Maybe CHSModule
    skipToLangPragma CHSModule
    chsMod of
          Maybe CHSModule
    Nothing -> CHSModule -> PreCST SwitchBoard s CHSModule
    forall s. CHSModule -> CST s CHSModule
    loadAllCHI CHSModule
    chsMod
          Just CHSModule
    chsMod | Bool -> Bool
    not (CHSModule -> Bool
    hasCPP CHSModule
    chsMod) -> CHSModule -> PreCST SwitchBoard s CHSModule
    forall s. CHSModule -> CST s CHSModule
    loadAllCHI CHSModule
    chsMod
                      | Bool
    otherwise -> do
            String
    outFName <- (SwitchBoard -> String) -> CST s String
    forall a s. (SwitchBoard -> a) -> CST s a
    getSwitch SwitchBoard -> String
    outputSB
            let outFileBase :: String
    outFileBase  = if String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    outFName then String -> String
    basename String
    bndFile else String
    outFName
            let ppFile :: String
    ppFile = String
    outFileBase String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "_pp" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    chssuffix
            String
    cpp     <- (SwitchBoard -> String) -> CST s String
    forall a s. (SwitchBoard -> a) -> CST s a
    getSwitch SwitchBoard -> String
    cppSB
            [String]
    cppOpts <- (SwitchBoard -> [String]) -> CST s [String]
    forall a s. (SwitchBoard -> a) -> CST s a
    getSwitch SwitchBoard -> [String]
    cppOptsSB
            let args :: [String]
    args = [String]
    cppOpts [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String
    cppoptsdef, String
    headerFile, String
    bndFile]
            String -> CST s ()
    forall s. String -> CST s ()
    tracePreproc ([String] -> String
    unwords (String
    cppString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    args))
            ExitCode
    exitCode <- IO ExitCode -> PreCST SwitchBoard s ExitCode
    forall a e s. IO a -> PreCST e s a
    liftIO (IO ExitCode -> PreCST SwitchBoard s ExitCode)
    -> IO ExitCode -> PreCST SwitchBoard s ExitCode
    forall a b. (a -> b) -> a -> b
    $ do
              Handle
    ppHnd <- String -> IOMode -> IO Handle
    openFile String
    ppFile IOMode
    WriteMode
              ProcessHandle
    process <- String
    -> [String]
    -> Maybe String
    -> Maybe [(String, String)]
    -> Maybe Handle
    -> Maybe Handle
    -> Maybe Handle
    -> IO ProcessHandle
    runProcess String
    cpp [String]
    args
                Maybe String
    forall a. Maybe a
    Nothing Maybe [(String, String)]
    forall a. Maybe a
    Nothing Maybe Handle
    forall a. Maybe a
    Nothing (Handle -> Maybe Handle
    forall a. a -> Maybe a
    Just Handle
    ppHnd) Maybe Handle
    forall a. Maybe a
    Nothing
              ProcessHandle -> IO ExitCode
    waitForProcess ProcessHandle
    process
            case ExitCode
    exitCode of
              ExitFailure Int
    _ -> String -> CST s ()
    forall e s a. String -> PreCST e s a
    fatal String
    "Error during preprocessing chs file"
              ExitCode
    _             -> CST s ()
    forall e s. PreCST e s ()
    nop

            (CHSModule
    chsMod , String
    warnmsgs) <- String -> CST s (CHSModule, String)
    forall s. String -> CST s (CHSModule, String)
    loadCHS String
    ppFile

            Bool
    keep <- (SwitchBoard -> Bool) -> CST s Bool
    forall a s. (SwitchBoard -> a) -> CST s a
    getSwitch SwitchBoard -> Bool
    keepSB
            Bool -> CST s () -> CST s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    keep (CST s () -> CST s ()) -> CST s () -> CST s ()
    forall a b. (a -> b) -> a -> b
    $
              String -> CST s ()
    forall e s. String -> PreCST e s ()
    removeFileCIO String
    ppFile

            case CHSModule -> Maybe CHSModule
    skipToLangPragma CHSModule
    chsMod of Just CHSModule
    chsMod -> CHSModule -> PreCST SwitchBoard s CHSModule
    forall s. CHSModule -> CST s CHSModule
    loadAllCHI CHSModule
    chsMod

        CHSModule -> CST s ()
    forall {s}. CHSModule -> PreCST SwitchBoard s ()
    traceCHSDump CHSModule
    chsMod
        --
        -- extract CPP and inline-C embedded in the .chs file (all CPP and
        -- inline-C fragments are removed from the .chs tree and conditionals are
        -- replaced by structured conditionals)
        --
        ([String]
    header, CHSModule
    strippedCHSMod, String
    warnmsgs) <- CHSModule -> CST s ([String], CHSModule, String)
    forall s. CHSModule -> CST s ([String], CHSModule, String)
    genHeader CHSModule
    chsMod
        String -> CST s ()
    forall e s. String -> PreCST e s ()
    putStrCIO String
    warnmsgs

        Bool
    pcFileExists <- CST s Bool -> (String -> CST s Bool) -> Maybe String -> CST s Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Bool -> CST s Bool
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False) String -> CST s Bool
    forall e s. String -> PreCST e s Bool
    doesFileExistCIO Maybe String
    preCompFile

        AttrC
    cheader <- if [String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    header Bool -> Bool -> Bool
    && Bool
    pcFileExists then do
            -- there are no cpp directives in the .chs file, use the precompiled header
            --
            String -> CST s ()
    forall s. String -> CST s ()
    traceReadPrecomp (Maybe String -> String
    forall a. HasCallStack => Maybe a -> a
    fromJust Maybe String
    preCompFile)
            WithNameSupply AttrC
    cheader <- IO (WithNameSupply AttrC)
    -> PreCST SwitchBoard s (WithNameSupply AttrC)
    forall a e s. IO a -> PreCST e s a
    liftIO (IO (WithNameSupply AttrC)
     -> PreCST SwitchBoard s (WithNameSupply AttrC))
    -> IO (WithNameSupply AttrC)
    -> PreCST SwitchBoard s (WithNameSupply AttrC)
    forall a b. (a -> b) -> a -> b
    $ String -> IO (WithNameSupply AttrC)
    forall a. Binary a => String -> IO a
    getBinFileWithDict (Maybe String -> String
    forall a. HasCallStack => Maybe a -> a
    fromJust Maybe String
    preCompFile)
            AttrC -> PreCST SwitchBoard s AttrC
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return AttrC
    cheader

          else do
            --
            -- create new header file, make it #include `headerFile', and emit
            -- CPP and inline-C of .chs file into the new header
            --
            String
    outFName <- (SwitchBoard -> String) -> CST s String
    forall a s. (SwitchBoard -> a) -> CST s a
    getSwitch SwitchBoard -> String
    outputSB
            let newHeaderFile :: String
    newHeaderFile = String
    outFName String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    hsuffix
            let preprocFile :: String
    preprocFile   = String -> String
    basename String
    newHeaderFile String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    isuffix
            Handle
    newHeader <- String -> IOMode -> PreCST SwitchBoard s Handle
    forall e s. String -> IOMode -> PreCST e s Handle
    openFileCIO String
    newHeaderFile IOMode
    WriteMode
            Bool -> CST s () -> CST s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    headerFile) (CST s () -> CST s ()) -> CST s () -> CST s ()
    forall a b. (a -> b) -> a -> b
    $
              Handle -> String -> CST s ()
    forall e s. Handle -> String -> PreCST e s ()
    hPutStrLnCIO Handle
    newHeader (String -> CST s ()) -> String -> CST s ()
    forall a b. (a -> b) -> a -> b
    $ String
    "#include \"" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    headerFile String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\""
            (String -> CST s ()) -> [String] -> PreCST SwitchBoard s [()]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Handle -> String -> CST s ()
    forall e s. Handle -> String -> PreCST e s ()
    hPutStrCIO Handle
    newHeader) [String]
    header
            Handle -> CST s ()
    forall e s. Handle -> PreCST e s ()
    hCloseCIO Handle
    newHeader
            String -> CST s ()
    forall s. String -> CST s ()
    setHeader String
    newHeaderFile
            --
            -- run C preprocessor over the header
            --
            String
    cpp     <- (SwitchBoard -> String) -> CST s String
    forall a s. (SwitchBoard -> a) -> CST s a
    getSwitch SwitchBoard -> String
    cppSB
            [String]
    cppOpts <- (SwitchBoard -> [String]) -> CST s [String]
    forall a s. (SwitchBoard -> a) -> CST s a
    getSwitch SwitchBoard -> [String]
    cppOptsSB
            let args :: [String]
    args = [String]
    cppOpts [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String
    newHeaderFile]
            String -> CST s ()
    forall s. String -> CST s ()
    tracePreproc ([String] -> String
    unwords (String
    cppString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    args))
            ExitCode
    exitCode <- IO ExitCode -> PreCST SwitchBoard s ExitCode
    forall a e s. IO a -> PreCST e s a
    liftIO (IO ExitCode -> PreCST SwitchBoard s ExitCode)
    -> IO ExitCode -> PreCST SwitchBoard s ExitCode
    forall a b. (a -> b) -> a -> b
    $ do
              Handle
    preprocHnd <- String -> IOMode -> IO Handle
    openFile String
    preprocFile IOMode
    WriteMode
              ProcessHandle
    process <- String
    -> [String]
    -> Maybe String
    -> Maybe [(String, String)]
    -> Maybe Handle
    -> Maybe Handle
    -> Maybe Handle
    -> IO ProcessHandle
    runProcess String
    cpp [String]
    args
                Maybe String
    forall a. Maybe a
    Nothing Maybe [(String, String)]
    forall a. Maybe a
    Nothing Maybe Handle
    forall a. Maybe a
    Nothing (Handle -> Maybe Handle
    forall a. a -> Maybe a
    Just Handle
    preprocHnd) Maybe Handle
    forall a. Maybe a
    Nothing
              ProcessHandle -> IO ExitCode
    waitForProcess ProcessHandle
    process
            case ExitCode
    exitCode of
              ExitFailure Int
    _ -> String -> CST s ()
    forall e s a. String -> PreCST e s a
    fatal String
    "Error during preprocessing custom header file"
              ExitCode
    _             -> CST s ()
    forall e s. PreCST e s ()
    nop
            --
            -- load and analyse the C header file
            --
            (AttrC
    cheader, String
    warnmsgs) <- String -> CST s (AttrC, String)
    forall s. String -> CST s (AttrC, String)
    loadAttrC String
    preprocFile
            String -> CST s ()
    forall e s. String -> PreCST e s ()
    putStrCIO String
    warnmsgs
            --
            -- remove the custom header and the pre-processed header
            --
            Bool
    keep <- (SwitchBoard -> Bool) -> CST s Bool
    forall a s. (SwitchBoard -> a) -> CST s a
    getSwitch SwitchBoard -> Bool
    keepSB
            Bool -> CST s () -> CST s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    keep (CST s () -> CST s ()) -> CST s () -> CST s ()
    forall a b. (a -> b) -> a -> b
    $
              String -> CST s ()
    forall e s. String -> PreCST e s ()
    removeFileCIO String
    preprocFile

            AttrC -> PreCST SwitchBoard s AttrC
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return AttrC
    cheader

        --
        -- expand binding hooks into plain Haskell
        --
        (CHSModule
    hsMod, String
    chi, String
    warnmsgs) <- AttrC -> CHSModule -> CST s (CHSModule, String, String)
    forall s. AttrC -> CHSModule -> CST s (CHSModule, String, String)
    expandHooks AttrC
    cheader CHSModule
    strippedCHSMod
        String -> CST s ()
    forall e s. String -> PreCST e s ()
    putStrCIO String
    warnmsgs
        --
        -- output the result
        --
        String
    outFName <- (SwitchBoard -> String) -> CST s String
    forall a s. (SwitchBoard -> a) -> CST s a
    getSwitch SwitchBoard -> String
    outputSB
        let hsFile :: String
    hsFile  = if String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    outFName then String -> String
    basename String
    bndFile else String
    outFName
        String -> CHSModule -> Bool -> CST s ()
    forall s. String -> CHSModule -> Bool -> CST s ()
    dumpCHS String
    hsFile CHSModule
    hsMod Bool
    True
        String -> String -> CST s ()
    forall s. String -> String -> CST s ()
    dumpCHI String
    hsFile String
    chi          -- different suffix will be appended

      where
        bndFile :: String
    bndFile = String
    bndFileStripped String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    chssuffix
        traceReadPrecomp :: String -> CST s ()
    traceReadPrecomp String
    fName = (Traces -> Bool) -> String -> CST s ()
    forall s. (Traces -> Bool) -> String -> CST s ()
    putTraceStr Traces -> Bool
    tracePhasesSW (String -> CST s ()) -> String -> CST s ()
    forall a b. (a -> b) -> a -> b
    $
          String
    "Reading precompiled header file " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    fName String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "...\n"
        tracePreproc :: String -> CST s ()
    tracePreproc String
    cmd = (Traces -> Bool) -> String -> CST s ()
    forall s. (Traces -> Bool) -> String -> CST s ()
    putTraceStr Traces -> Bool
    tracePhasesSW (String -> CST s ()) -> String -> CST s ()
    forall a b. (a -> b) -> a -> b
    $
                             String
    "Invoking cpp as `" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    cmd String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "'...\n"
        traceCHSDump :: CHSModule -> PreCST SwitchBoard s ()
    traceCHSDump CHSModule
    mod = do
                             Bool
    flag <- (Traces -> Bool) -> CST s Bool
    forall s. (Traces -> Bool) -> CST s Bool
    traceSet Traces -> Bool
    dumpCHSSW
                             Bool -> PreCST SwitchBoard s () -> PreCST SwitchBoard s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    flag (PreCST SwitchBoard s () -> PreCST SwitchBoard s ())
    -> PreCST SwitchBoard s () -> PreCST SwitchBoard s ()
    forall a b. (a -> b) -> a -> b
    $
                               (do
                                  String -> PreCST SwitchBoard s ()
    forall e s. String -> PreCST e s ()
    putStrCIO (String
    "...dumping CHS to `" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    chsName
                                             String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "'...\n")
                                  String -> CHSModule -> Bool -> PreCST SwitchBoard s ()
    forall s. String -> CHSModule -> Bool -> CST s ()
    dumpCHS String
    chsName CHSModule
    mod Bool
    False)

        chsName :: String
    chsName = String -> String
    basename String
    bndFile String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ".dump"

    preCompileHeader :: FilePath -> FilePath -> CST s ()
    preCompileHeader :: forall s. String -> String -> CST s ()
    preCompileHeader String
    headerFile String
    preCompFile =
      do
        let preprocFile :: String
    preprocFile  = String -> String
    basename String
    headerFile String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    isuffix

        Bool
    pcFileExists <- String -> PreCST SwitchBoard s Bool
    forall e s. String -> PreCST e s Bool
    doesFileExistCIO String
    preCompFile
        Bool -> CST s () -> CST s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    pcFileExists (CST s () -> CST s ()) -> CST s () -> CST s ()
    forall a b. (a -> b) -> a -> b
    $ do

        [String]
    hpaths          <- (SwitchBoard -> [String]) -> CST s [String]
    forall a s. (SwitchBoard -> a) -> CST s a
    getSwitch SwitchBoard -> [String]
    hpathsSB
        String
    realHeaderFile  <- String
    headerFile String -> [String] -> PreCST SwitchBoard s String
    forall e s. String -> [String] -> PreCST e s String
    `fileFindInCIO` [String]
    hpaths

        --
        -- run C preprocessor over the header
        --
        String
    cpp     <- (SwitchBoard -> String) -> PreCST SwitchBoard s String
    forall a s. (SwitchBoard -> a) -> CST s a
    getSwitch SwitchBoard -> String
    cppSB
        [String]
    cppOpts <- (SwitchBoard -> [String]) -> CST s [String]
    forall a s. (SwitchBoard -> a) -> CST s a
    getSwitch SwitchBoard -> [String]
    cppOptsSB
        let args :: [String]
    args = [String]
    cppOpts [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String
    realHeaderFile]
        String -> CST s ()
    forall s. String -> CST s ()
    tracePreproc ([String] -> String
    unwords (String
    cppString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    args))
        ExitCode
    exitCode <- IO ExitCode -> PreCST SwitchBoard s ExitCode
    forall a e s. IO a -> PreCST e s a
    liftIO (IO ExitCode -> PreCST SwitchBoard s ExitCode)
    -> IO ExitCode -> PreCST SwitchBoard s ExitCode
    forall a b. (a -> b) -> a -> b
    $ do
          Handle
    preprocHnd <- String -> IOMode -> IO Handle
    openFile String
    preprocFile IOMode
    WriteMode
          ProcessHandle
    process <- String
    -> [String]
    -> Maybe String
    -> Maybe [(String, String)]
    -> Maybe Handle
    -> Maybe Handle
    -> Maybe Handle
    -> IO ProcessHandle
    runProcess String
    cpp [String]
    args
            Maybe String
    forall a. Maybe a
    Nothing Maybe [(String, String)]
    forall a. Maybe a
    Nothing Maybe Handle
    forall a. Maybe a
    Nothing (Handle -> Maybe Handle
    forall a. a -> Maybe a
    Just Handle
    preprocHnd) Maybe Handle
    forall a. Maybe a
    Nothing
          ProcessHandle -> IO ExitCode
    waitForProcess ProcessHandle
    process
        case ExitCode
    exitCode of
          ExitFailure Int
    _ -> String -> CST s ()
    forall e s a. String -> PreCST e s a
    fatal String
    "Error during preprocessing"
          ExitCode
    _             -> CST s ()
    forall e s. PreCST e s ()
    nop

        --
        -- load and analyse the C header file
        --
        (AttrC
    cheader, String
    warnmsgs) <- String -> CST s (AttrC, String)
    forall s. String -> CST s (AttrC, String)
    loadAttrC String
    preprocFile
        String -> CST s ()
    forall e s. String -> PreCST e s ()
    putStrCIO String
    warnmsgs

        --
        -- save the attributed C to disk
        --
        IO () -> CST s ()
    forall a e s. IO a -> PreCST e s a
    liftIO (IO () -> CST s ()) -> IO () -> CST s ()
    forall a b. (a -> b) -> a -> b
    $ String -> WithNameSupply AttrC -> IO ()
    forall a. Binary a => String -> a -> IO ()
    putBinFileWithDict String
    preCompFile (AttrC -> WithNameSupply AttrC
    forall a. a -> WithNameSupply a
    WithNameSupply AttrC
    cheader)

        --
        -- remove the pre-processed header
        --
        Bool
    keep <- (SwitchBoard -> Bool) -> PreCST SwitchBoard s Bool
    forall a s. (SwitchBoard -> a) -> CST s a
    getSwitch SwitchBoard -> Bool
    keepSB
        Bool -> CST s () -> CST s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    keep (CST s () -> CST s ()) -> CST s () -> CST s ()
    forall a b. (a -> b) -> a -> b
    $
          String -> CST s ()
    forall e s. String -> PreCST e s ()
    removeFileCIO String
    preprocFile

        () -> CST s ()
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      where
        tracePreproc :: String -> CST s ()
    tracePreproc String
    cmd = (Traces -> Bool) -> String -> CST s ()
    forall s. (Traces -> Bool) -> String -> CST s ()
    putTraceStr Traces -> Bool
    tracePhasesSW (String -> CST s ()) -> String -> CST s ()
    forall a b. (a -> b) -> a -> b
    $
                             String
    "Invoking cpp as `" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    cmd String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "'...\n"

    -- dummy type so we can save and restore the name supply
    data WithNameSupply a = WithNameSupply a

    instance Binary a => Binary (WithNameSupply a) where
      put_ :: BinHandle -> WithNameSupply a -> IO ()
    put_ BinHandle
    bh (WithNameSupply a
    x) = do
        BinHandle -> a -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh a
    x
        Name
    nameSupply <- IO Name
    saveRootNameSupply
        BinHandle -> Name -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh Name
    nameSupply
      get :: BinHandle -> IO (WithNameSupply a)
    get BinHandle
    bh = do
        a
    x <- BinHandle -> IO a
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
        Name
    nameSupply <- BinHandle -> IO Name
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
        Name -> IO ()
    restoreRootNameSupply Name
    nameSupply
        WithNameSupply a -> IO (WithNameSupply a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a -> WithNameSupply a
    forall a. a -> WithNameSupply a
    WithNameSupply a
    x)