    --  C->Haskell Compiler: custom header generator
    --
    --  Author : Manuel M T Chakravarty
    --  Created: 5 February 2003
    --
    --  Version $Revision: 1.1 $
    --
    --  Copyright (c) 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 module implements the generation of a custom header from a binding
    --  module.
    --
    --- DOCU ----------------------------------------------------------------------
    --
    --  language: Haskell 98
    --
    --  Computing CPP Conditionals
    --  ~~~~~~~~~~~~~~~~~~~~~~~~~~
    --  We obtain information about which branches of CPP conditions are taken
    --  during pre-processing of the custom header file by introducing new
    --  struct declarations.  Specifically, after each #if[[n]def] or #elif,
    --  we place a declaration of the form
    --
    --    struct C2HS_COND_SENTRY<unique number>;
    --
    --  We can, then, determine which branch of a conditional has been taken by
    --  checking whether the struct corresponding to that conditional has been
    --  declared.
    --
    --- TODO ----------------------------------------------------------------------
    --
    --  * Ideally, `ghFrag[s]' should be tail recursive

    module GenHeader (
      genHeader
    ) where

    -- standard libraries
    import Control.Monad     (when)

    -- Compiler Toolkit
    import Position  (Position, Pos(..), nopos)
    import DLists    (DList, openDL, closeDL, zeroDL, unitDL, joinDL, snocDL)
    import Errors    (interr)
    import Idents    (onlyPosIdent)
    import UNames    (NameSupply, Name, names)

    -- C->Haskell
    import C2HSState (CST, getNameSupply, runCST, transCST, raiseError, catchExc,
                      throwExc, errorsPresent, showErrors, fatal)

    -- friends
    import CHS       (CHSModule(..), CHSFrag(..))

    -- The header generation monad
    --
    type GH a = CST [Name] a

    -- |Generate a custom C header from a CHS binding module.
    --
    --  * All CPP directives and inline-C fragments are moved into the custom header
    --
    --  * The CPP and inline-C fragments are removed from the .chs tree and
    --   conditionals are replaced by structured conditionals
    --
    genHeader :: CHSModule -> CST s ([String], CHSModule, String)
    genHeader :: forall s. CHSModule -> CST s ([String], CHSModule, String)
    genHeader CHSModule
    mod =
      do
        NameSupply
    supply <- PreCST SwitchBoard s NameSupply
    forall e s. PreCST e s NameSupply
    getNameSupply
        ([String]
    header, CHSModule
    mod) <- PreCST SwitchBoard [Name] ([String], CHSModule)
    -> [Name] -> PreCST SwitchBoard s ([String], CHSModule)
    forall e s a s'. PreCST e s a -> s -> PreCST e s' a
    runCST (CHSModule -> PreCST SwitchBoard [Name] ([String], CHSModule)
    ghModule CHSModule
    mod) (NameSupply -> [Name]
    names NameSupply
    supply)
                         PreCST SwitchBoard s ([String], CHSModule)
    -> PreCST SwitchBoard s ([String], CHSModule)
    -> PreCST SwitchBoard s ([String], CHSModule)
    forall s a. CST s a -> CST s a -> CST s a
    `ifGHExc` ([String], CHSModule) -> PreCST SwitchBoard s ([String], CHSModule)
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([], [CHSFrag] -> CHSModule
    CHSModule [])

        -- check for errors and finalise
        --
        Bool
    errs <- PreCST SwitchBoard s Bool
    forall e s. PreCST e s Bool
    errorsPresent
        if Bool
    errs
          then do
            String
    errmsgs <- PreCST SwitchBoard s String
    forall e s. PreCST e s String
    showErrors
            String -> CST s ([String], CHSModule, String)
    forall e s a. String -> PreCST e s a
    fatal (String
    "Errors during generation of C header:\n\n"   -- fatal error
                   String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    errmsgs)
          else do
            String
    warnmsgs <- PreCST SwitchBoard s String
    forall e s. PreCST e s String
    showErrors
            ([String], CHSModule, String)
    -> CST s ([String], CHSModule, String)
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([String]
    header, CHSModule
    mod, String
    warnmsgs)

    -- Obtain a new base name that may be used, in C, to encode the result of a
    -- preprocessor conditionl.
    --
    newName :: CST [Name] String
    newName :: CST [Name] String
    newName = ([Name] -> ([Name], String)) -> CST [Name] String
    forall s a e. (s -> (s, a)) -> PreCST e s a
    transCST (([Name] -> ([Name], String)) -> CST [Name] String)
    -> ([Name] -> ([Name], String)) -> CST [Name] String
    forall a b. (a -> b) -> a -> b
    $
      \[Name]
    supply -> ([Name] -> [Name]
    forall a. HasCallStack => [a] -> [a]
    tail [Name]
    supply, String
    "C2HS_COND_SENTRY_" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Name -> String
    forall a. Show a => a -> String
    show ([Name] -> Name
    forall a. HasCallStack => [a] -> a
    head [Name]
    supply))

    -- Various forms of processed fragments
    --
    data FragElem = Frag  CHSFrag
                  | Elif  String Position
                  | Else  Position
                  | Endif Position
                  | EOF

    instance Pos FragElem where
      posOf :: FragElem -> Position
    posOf (Frag CHSFrag
    frag    ) = CHSFrag -> Position
    forall a. Pos a => a -> Position
    posOf CHSFrag
    frag
      posOf (Elif String
    _    Position
    pos) = Position
    pos
      posOf (Else      Position
    pos) = Position
    pos
      posOf (Endif     Position
    pos) = Position
    pos
      posOf FragElem
    EOF             = Position
    nopos

    -- check for end of file
    --
    isEOF :: FragElem -> Bool
    isEOF :: FragElem -> Bool
    isEOF FragElem
    EOF = Bool
    True
    isEOF FragElem
    _   = Bool
    False

    -- Generate the C header for an entire .chs module.
    --
    --  * This works more or less like a recursive decent parser for a statement
    --   sequence that may contain conditionals, where `ghFrag' implements most of
    --   the state transition system of the associated automaton
    --
    ghModule :: CHSModule -> GH ([String], CHSModule)
    ghModule :: CHSModule -> PreCST SwitchBoard [Name] ([String], CHSModule)
    ghModule (CHSModule [CHSFrag]
    frags) =
      do
        (DList String
    header, [CHSFrag]
    frags, FragElem
    last, [CHSFrag]
    rest) <- [CHSFrag] -> GH (DList String, [CHSFrag], FragElem, [CHSFrag])
    ghFrags [CHSFrag]
    frags
        Bool
    -> PreCST SwitchBoard [Name] () -> PreCST SwitchBoard [Name] ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not (Bool -> Bool) -> (FragElem -> Bool) -> FragElem -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FragElem -> Bool
    isEOF (FragElem -> Bool) -> FragElem -> Bool
    forall a b. (a -> b) -> a -> b
    $ FragElem
    last) (PreCST SwitchBoard [Name] () -> PreCST SwitchBoard [Name] ())
    -> PreCST SwitchBoard [Name] () -> PreCST SwitchBoard [Name] ()
    forall a b. (a -> b) -> a -> b
    $
          Position -> PreCST SwitchBoard [Name] ()
    forall a. Position -> GH a
    notOpenCondErr (FragElem -> Position
    forall a. Pos a => a -> Position
    posOf FragElem
    last)
        ([String], CHSModule)
    -> PreCST SwitchBoard [Name] ([String], CHSModule)
    forall a. a -> PreCST SwitchBoard [Name] a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DList String -> [String]
    forall a. DList a -> [a]
    closeDL DList String
    header, [CHSFrag] -> CHSModule
    CHSModule [CHSFrag]
    frags)

    -- Collect header and fragments up to eof or a CPP directive that is part of a
    -- conditional
    --
    --  * We collect the header (ie, CPP directives and inline-C) using a
    --   difference list to avoid worst case O(n^2) complexity due to
    --   concatenation of lines that go into the header.
    --
    ghFrags :: [CHSFrag] -> GH (DList String, [CHSFrag], FragElem, [CHSFrag])
    ghFrags :: [CHSFrag] -> GH (DList String, [CHSFrag], FragElem, [CHSFrag])
    ghFrags []    = (DList String, [CHSFrag], FragElem, [CHSFrag])
    -> GH (DList String, [CHSFrag], FragElem, [CHSFrag])
    forall a. a -> PreCST SwitchBoard [Name] a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DList String
    forall a. DList a
    zeroDL, [], FragElem
    EOF, [])
    ghFrags [CHSFrag]
    frags =
      do
        (DList String
    header, FragElem
    frag, [CHSFrag]
    rest) <- [CHSFrag] -> GH (DList String, FragElem, [CHSFrag])
    ghFrag [CHSFrag]
    frags
        case FragElem
    frag of
          Frag CHSFrag
    aFrag -> do
                          (DList String
    header2, [CHSFrag]
    frags', FragElem
    frag', [CHSFrag]
    rest) <- [CHSFrag] -> GH (DList String, [CHSFrag], FragElem, [CHSFrag])
    ghFrags [CHSFrag]
    rest
                          -- FIXME: Not tail rec
                          (DList String, [CHSFrag], FragElem, [CHSFrag])
    -> GH (DList String, [CHSFrag], FragElem, [CHSFrag])
    forall a. a -> PreCST SwitchBoard [Name] a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DList String
    header DList String -> DList String -> DList String
    forall a. DList a -> DList a -> DList a
    `joinDL` DList String
    header2, CHSFrag
    aFragCHSFrag -> [CHSFrag] -> [CHSFrag]
    forall a. a -> [a] -> [a]
    :[CHSFrag]
    frags',
                                  FragElem
    frag', [CHSFrag]
    rest)
          FragElem
    _          -> (DList String, [CHSFrag], FragElem, [CHSFrag])
    -> GH (DList String, [CHSFrag], FragElem, [CHSFrag])
    forall a. a -> PreCST SwitchBoard [Name] a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DList String
    header, [], FragElem
    frag, [CHSFrag]
    rest)

    -- Process a single fragment *structure*; i.e., if the first fragment
    -- introduces a conditional, process the whole conditional; otherwise, process
    -- the first fragment
    --
    ghFrag :: [CHSFrag] -> GH (DList String, -- partial header file
                               FragElem,     -- processed fragment
                               [CHSFrag])    -- not yet processed fragments
    ghFrag :: [CHSFrag] -> GH (DList String, FragElem, [CHSFrag])
    ghFrag []                              =
      (DList String, FragElem, [CHSFrag])
    -> GH (DList String, FragElem, [CHSFrag])
    forall a. a -> PreCST SwitchBoard [Name] a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DList String
    forall a. DList a
    zeroDL, FragElem
    EOF, [])
    ghFrag (frag :: CHSFrag
    frag@(CHSVerb  String
    _ Position
    _  ) : [CHSFrag]
    frags) =
      (DList String, FragElem, [CHSFrag])
    -> GH (DList String, FragElem, [CHSFrag])
    forall a. a -> PreCST SwitchBoard [Name] a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DList String
    forall a. DList a
    zeroDL, CHSFrag -> FragElem
    Frag CHSFrag
    frag, [CHSFrag]
    frags)
    ghFrag (frag :: CHSFrag
    frag@(CHSHook  CHSHook
    _    ) : [CHSFrag]
    frags) =
      (DList String, FragElem, [CHSFrag])
    -> GH (DList String, FragElem, [CHSFrag])
    forall a. a -> PreCST SwitchBoard [Name] a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DList String
    forall a. DList a
    zeroDL, CHSFrag -> FragElem
    Frag CHSFrag
    frag, [CHSFrag]
    frags)
    ghFrag (frag :: CHSFrag
    frag@(CHSLine  Position
    _    ) : [CHSFrag]
    frags) =
      (DList String, FragElem, [CHSFrag])
    -> GH (DList String, FragElem, [CHSFrag])
    forall a. a -> PreCST SwitchBoard [Name] a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DList String
    forall a. DList a
    zeroDL, CHSFrag -> FragElem
    Frag CHSFrag
    frag, [CHSFrag]
    frags)
    ghFrag (frag :: CHSFrag
    frag@(CHSLang  [String]
    _ Position
    _  ) : [CHSFrag]
    frags) =
      (DList String, FragElem, [CHSFrag])
    -> GH (DList String, FragElem, [CHSFrag])
    forall a. a -> PreCST SwitchBoard [Name] a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DList String
    forall a. DList a
    zeroDL, CHSFrag -> FragElem
    Frag CHSFrag
    frag, [CHSFrag]
    frags)
    ghFrag (     (CHSC    String
    s  Position
    _  ) : [CHSFrag]
    frags) =
      do
        (DList String
    header, FragElem
    frag, [CHSFrag]
    frags' ) <- [CHSFrag] -> GH (DList String, FragElem, [CHSFrag])
    ghFrag [CHSFrag]
    frags     -- scan for next CHS fragment
        (DList String, FragElem, [CHSFrag])
    -> GH (DList String, FragElem, [CHSFrag])
    forall a. a -> PreCST SwitchBoard [Name] a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> DList String
    forall a. a -> [a] -> [a]
    unitDL String
    s DList String -> DList String -> DList String
    forall a. DList a -> DList a -> DList a
    `joinDL` DList String
    header, FragElem
    frag, [CHSFrag]
    frags')
        -- FIXME: this is not tail recursive...
    ghFrag (     (CHSCond [(Ident, [CHSFrag])]
    _  Maybe [CHSFrag]
    _  ) : [CHSFrag]
    frags) =
      String -> GH (DList String, FragElem, [CHSFrag])
    forall a. String -> a
    interr String
    "GenHeader.ghFrags: There can't be a structured conditional yet!"
    ghFrag (frag :: CHSFrag
    frag@(CHSCPP  String
    s  Position
    pos) : [CHSFrag]
    frags) =
      let
        (String
    directive, String
    _) =   (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String
    " \t")
                         (String -> (String, String))
    -> (String -> String) -> String -> (String, String)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String
    " \t")
                         (String -> (String, String)) -> String -> (String, String)
    forall a b. (a -> b) -> a -> b
    $ String
    s
      in
      case String
    directive of
        String
    "if"     -> String
    -> Position -> [CHSFrag] -> GH (DList String, FragElem, [CHSFrag])
    openIf String
    s Position
    pos [CHSFrag]
    frags
        String
    "ifdef"  -> String
    -> Position -> [CHSFrag] -> GH (DList String, FragElem, [CHSFrag])
    openIf String
    s Position
    pos [CHSFrag]
    frags
        String
    "ifndef" -> String
    -> Position -> [CHSFrag] -> GH (DList String, FragElem, [CHSFrag])
    openIf String
    s Position
    pos [CHSFrag]
    frags
        String
    "else"   -> (DList String, FragElem, [CHSFrag])
    -> GH (DList String, FragElem, [CHSFrag])
    forall a. a -> PreCST SwitchBoard [Name] a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DList String
    forall a. DList a
    zeroDL              , Position -> FragElem
    Else   Position
    pos               , [CHSFrag]
    frags)
        String
    "elif"   -> (DList String, FragElem, [CHSFrag])
    -> GH (DList String, FragElem, [CHSFrag])
    forall a. a -> PreCST SwitchBoard [Name] a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DList String
    forall a. DList a
    zeroDL              , String -> Position -> FragElem
    Elif String
    s Position
    pos               , [CHSFrag]
    frags)
        String
    "endif"  -> (DList String, FragElem, [CHSFrag])
    -> GH (DList String, FragElem, [CHSFrag])
    forall a. a -> PreCST SwitchBoard [Name] a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DList String
    forall a. DList a
    zeroDL              , Position -> FragElem
    Endif  Position
    pos               , [CHSFrag]
    frags)
        String
    _        -> (DList String, FragElem, [CHSFrag])
    -> GH (DList String, FragElem, [CHSFrag])
    forall a. a -> PreCST SwitchBoard [Name] a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([String] -> DList String
    forall a. [a] -> [a] -> [a]
    openDL [Char
    '#'Char -> String -> String
    forall a. a -> [a] -> [a]
    :String
    s, String
    "\n"], CHSFrag -> FragElem
    Frag   (String -> Position -> CHSFrag
    CHSVerb String
    "" Position
    nopos), [CHSFrag]
    frags)
      where
        -- enter a new conditional (may be an #if[[n]def] or #elif)
        --
        --  * Arguments are the lexeme of the directive `s', the position of that
        --   directive `pos', and the fragments following the directive `frags'
        --
        openIf :: String
    -> Position -> [CHSFrag] -> GH (DList String, FragElem, [CHSFrag])
    openIf String
    s Position
    pos [CHSFrag]
    frags =
          do
            (DList String
    headerTh, [CHSFrag]
    fragsTh, FragElem
    last, [CHSFrag]
    rest) <- [CHSFrag] -> GH (DList String, [CHSFrag], FragElem, [CHSFrag])
    ghFrags [CHSFrag]
    frags
            case FragElem
    last of
              Else    Position
    pos -> do
                               (DList String
    headerEl, [CHSFrag]
    fragsEl, FragElem
    last, [CHSFrag]
    rest) <- [CHSFrag] -> GH (DList String, [CHSFrag], FragElem, [CHSFrag])
    ghFrags [CHSFrag]
    rest
                               case FragElem
    last of
                                 Else    Position
    pos -> Position -> GH (DList String, FragElem, [CHSFrag])
    forall a. Position -> GH a
    notOpenCondErr Position
    pos
                                 Elif  String
    _ Position
    pos -> Position -> GH (DList String, FragElem, [CHSFrag])
    forall a. Position -> GH a
    notOpenCondErr Position
    pos
                                 Endif   Position
    pos -> DList String
    -> (String, [CHSFrag])
    -> [(Ident, [CHSFrag])]
    -> Maybe [CHSFrag]
    -> [CHSFrag]
    -> GH (DList String, FragElem, [CHSFrag])
    forall {c}.
    DList String
    -> (String, [CHSFrag])
    -> [(Ident, [CHSFrag])]
    -> Maybe [CHSFrag]
    -> c
    -> PreCST SwitchBoard [Name] (DList String, FragElem, c)
    closeIf
                                                  ((DList String
    headerTh
                                                    DList String -> String -> DList String
    forall a. DList a -> a -> DList a
    `snocDL` String
    "#else\n")
                                                   DList String -> DList String -> DList String
    forall a. DList a -> DList a -> DList a
    `joinDL`
                                                   (DList String
    headerEl
                                                    DList String -> String -> DList String
    forall a. DList a -> a -> DList a
    `snocDL` String
    "#endif\n"))
                                                  (String
    s, [CHSFrag]
    fragsTh)
                                                  []
                                                  ([CHSFrag] -> Maybe [CHSFrag]
    forall a. a -> Maybe a
    Just [CHSFrag]
    fragsEl)
                                                  [CHSFrag]
    rest
                                 FragElem
    EOF         -> Position -> GH (DList String, FragElem, [CHSFrag])
    forall a. Position -> GH a
    notClosedCondErr Position
    pos
              Elif String
    s' Position
    pos -> do
                               (DList String
    headerEl, FragElem
    condFrag, [CHSFrag]
    rest) <- String
    -> Position -> [CHSFrag] -> GH (DList String, FragElem, [CHSFrag])
    openIf String
    s' Position
    pos [CHSFrag]
    rest
                               case FragElem
    condFrag of
                                 Frag (CHSCond [(Ident, [CHSFrag])]
    alts Maybe [CHSFrag]
    dft) ->
                                   DList String
    -> (String, [CHSFrag])
    -> [(Ident, [CHSFrag])]
    -> Maybe [CHSFrag]
    -> [CHSFrag]
    -> GH (DList String, FragElem, [CHSFrag])
    forall {c}.
    DList String
    -> (String, [CHSFrag])
    -> [(Ident, [CHSFrag])]
    -> Maybe [CHSFrag]
    -> c
    -> PreCST SwitchBoard [Name] (DList String, FragElem, c)
    closeIf (DList String
    headerTh DList String -> DList String -> DList String
    forall a. DList a -> DList a -> DList a
    `joinDL` DList String
    headerEl)
                                           (String
    s, [CHSFrag]
    fragsTh)
                                           [(Ident, [CHSFrag])]
    alts
                                           Maybe [CHSFrag]
    dft
                                           [CHSFrag]
    rest
                                 FragElem
    _                       ->
                                   String -> GH (DList String, FragElem, [CHSFrag])
    forall a. String -> a
    interr String
    "GenHeader.ghFrag: Expected CHSCond!"
              Endif   Position
    pos -> DList String
    -> (String, [CHSFrag])
    -> [(Ident, [CHSFrag])]
    -> Maybe [CHSFrag]
    -> [CHSFrag]
    -> GH (DList String, FragElem, [CHSFrag])
    forall {c}.
    DList String
    -> (String, [CHSFrag])
    -> [(Ident, [CHSFrag])]
    -> Maybe [CHSFrag]
    -> c
    -> PreCST SwitchBoard [Name] (DList String, FragElem, c)
    closeIf (DList String
    headerTh DList String -> String -> DList String
    forall a. DList a -> a -> DList a
    `snocDL` String
    "#endif\n")
                                     (String
    s, [CHSFrag]
    fragsTh)
                                     []
                                     ([CHSFrag] -> Maybe [CHSFrag]
    forall a. a -> Maybe a
    Just [])
                                     [CHSFrag]
    rest
              FragElem
    EOF         -> Position -> GH (DList String, FragElem, [CHSFrag])
    forall a. Position -> GH a
    notClosedCondErr Position
    pos
        --
        -- turn a completed conditional into a `CHSCond' fragment
        --
        --  * `(s, fragsTh)' is the CPP directive `s' containing the condition under
        --   which `fragTh' should be executed; `alts' are alternative branches
        --   (with conditions); and `oelse' is an optional else-branch
        --
        closeIf :: DList String
    -> (String, [CHSFrag])
    -> [(Ident, [CHSFrag])]
    -> Maybe [CHSFrag]
    -> c
    -> PreCST SwitchBoard [Name] (DList String, FragElem, c)
    closeIf DList String
    headerTail (String
    s, [CHSFrag]
    fragsTh) [(Ident, [CHSFrag])]
    alts Maybe [CHSFrag]
    oelse c
    rest =
          do
            String
    sentryName <- CST [Name] String
    newName
            let sentry :: Ident
    sentry = Position -> String -> Ident
    onlyPosIdent Position
    nopos String
    sentryName
                           -- don't use an internal ident, as we need to test for
                           -- equality with identifiers read from the .i file
                           -- during binding hook expansion
                header :: DList String
    header = [String] -> DList String
    forall a. [a] -> [a] -> [a]
    openDL [Char
    '#'Char -> String -> String
    forall a. a -> [a] -> [a]
    :String
    s, String
    "\n",
                                 String
    "struct ", String
    sentryName, String
    ";\n"]
                                DList String -> DList String -> DList String
    forall a. DList a -> DList a -> DList a
    `joinDL` DList String
    headerTail
            (DList String, FragElem, c)
    -> PreCST SwitchBoard [Name] (DList String, FragElem, c)
    forall a. a -> PreCST SwitchBoard [Name] a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DList String
    header, CHSFrag -> FragElem
    Frag ([(Ident, [CHSFrag])] -> Maybe [CHSFrag] -> CHSFrag
    CHSCond ((Ident
    sentry, [CHSFrag]
    fragsTh)(Ident, [CHSFrag]) -> [(Ident, [CHSFrag])] -> [(Ident, [CHSFrag])]
    forall a. a -> [a] -> [a]
    :[(Ident, [CHSFrag])]
    alts) Maybe [CHSFrag]
    oelse), c
    rest)

    -- exception handling
    -- ------------------

    -- exception identifier
    --
    ghExc :: String
    ghExc :: String
    ghExc  = String
    "ghExc"

    -- throw an exception
    --
    throwGHExc :: GH a
    throwGHExc :: forall a. GH a
    throwGHExc  = String -> String -> PreCST SwitchBoard [Name] a
    forall e s a. String -> String -> PreCST e s a
    throwExc String
    ghExc String
    "Error during C header generation"

    -- catch a `ghExc'
    --
    ifGHExc           :: CST s a -> CST s a -> CST s a
    ifGHExc :: forall s a. CST s a -> CST s a -> CST s a
    ifGHExc CST s a
    m CST s a
    handler  = CST s a
    m CST s a -> (String, String -> CST s a) -> CST s a
    forall e s a.
    PreCST e s a -> (String, String -> PreCST e s a) -> PreCST e s a
    `catchExc` (String
    ghExc, CST s a -> String -> CST s a
    forall a b. a -> b -> a
    const CST s a
    handler)

    -- raise an error followed by throwing a GH exception
    --
    raiseErrorGHExc          :: Position -> [String] -> GH a
    raiseErrorGHExc :: forall a. Position -> [String] -> GH a
    raiseErrorGHExc Position
    pos [String]
    errs  = Position -> [String] -> PreCST SwitchBoard [Name] ()
    forall e s. Position -> [String] -> PreCST e s ()
    raiseError Position
    pos [String]
    errs PreCST SwitchBoard [Name] ()
    -> PreCST SwitchBoard [Name] a -> PreCST SwitchBoard [Name] a
    forall a b.
    PreCST SwitchBoard [Name] a
    -> PreCST SwitchBoard [Name] b -> PreCST SwitchBoard [Name] b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> PreCST SwitchBoard [Name] a
    forall a. GH a
    throwGHExc

    -- error messages
    -- --------------

    notClosedCondErr :: Position -> GH a
    notClosedCondErr :: forall a. Position -> GH a
    notClosedCondErr Position
    pos  =
      Position -> [String] -> GH a
    forall a. Position -> [String] -> GH a
    raiseErrorGHExc Position
    pos
        [String
    "Unexpected end of file!",
         String
    "File ended while the conditional block starting here was not closed \
         \properly."]

    notOpenCondErr :: Position -> GH a
    notOpenCondErr :: forall a. Position -> GH a
    notOpenCondErr Position
    pos  =
      Position -> [String] -> GH a
    forall a. Position -> [String] -> GH a
    raiseErrorGHExc Position
    pos
        [String
    "Missing #if[[n]def]!",
         String
    "There is a #else, #elif, or #endif without an #if, #ifdef, or #ifndef."]