    --  C->Haskell Compiler: CHS file abstraction
    --
    --  Author : Manuel M T Chakravarty
    --  Created: 16 August 99
    --
    --  Version $Revision: 1.3 $ from $Date: 2005/01/23 15:44:36 $
    --
    --  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 ---------------------------------------------------------------
    --
    --  Main file for reading CHS files.
    --
    --  Import hooks & .chi files
    --  -------------------------
    --
    --  Reading of `.chi' files is interleaved with parsing.  More precisely,
    --  whenever the parser comes across an import hook, it immediately reads the
    --  `.chi' file and inserts its contents into the abstract representation of
    --  the hook.  The parser checks the version of the `.chi' file, but does not
    --  otherwise attempt to interpret its contents.  This is only done during
    --  generation of the binding module.  The first line of a .chi file has the
    --  form
    --
    --    C->Haskell Interface Version <version>
    --
    --  where <version> is the three component version number `Version.version'.
    --  C->Haskell will only accept files whose version number match its own in
    --  the first two components (ie, major and minor version).  In other words,
    --  it must be guaranteed that the format of .chi files is not altered between
    --  versions that differ only in their patchlevel.  All remaining lines of the
    --  file are version dependent and contain a dump of state information that
    --  the binding file generator needs to rescue across modules.
    --
    --- DOCU ----------------------------------------------------------------------
    --
    --  language: Haskell 98
    --
    --  The following binding hooks are recognised:
    --
    --  hook     -> `{#' inner `#}'
    --  inner    -> `import' ['qualified'] ident
    --            | `context' ctxt
    --            | `type' ident
    --            | `sizeof' ident
    --            | `enum' idalias trans [`with' prefix] [deriving]
    --            | `call' [`pure'] [`unsafe'] [`nolock'] idalias
    --            | `fun' [`pure'] [`unsafe'] [`nolock'] idalias parms
    --            | `get' apath
    --            | `set' apath
    --            | `pointer' ['*'] idalias ptrkind
    --            | `class' [ident `=>'] ident ident
    --  ctxt     -> [`lib' `=' string] [prefix] [lock]
    --  idalias  -> ident [`as' (ident | `^')]
    --  prefix   -> `prefix' `=' string
    --  lock     -> `lock' `=' string
    --  deriving -> `deriving' `(' ident_1 `,' ... `,' ident_n `)'
    --  parms    -> [verbhs `=>'] `{' parm_1 `,' ... `,' parm_n `}' `->' parm
    --  parm     -> [ident_1 [`*' | `-']] verbhs [`&'] [ident_2 [`*' | `-']]
    --  apath    -> ident
    --            | `*' apath
    --            | apath `.' ident
    --            | apath `->' ident
    --  trans    -> `{' alias_1 `,' ... `,' alias_n `}'
    --  alias    -> `underscoreToCase'
    --            | ident `as' ident
    --  ptrkind  -> [`foreign' | `stable' ] ['newtype' | '->' ident]
    --
    --  If `underscoreToCase' occurs in a translation table, it must be the first
    --  entry.
    --
    --  Remark: Optional Haskell names are normalised during structure tree
    --          construction, ie, associations that associated a name with itself
    --          are removed.  (They don't carry semantic content, and make some
    --          tests more complicated.)
    --
    --- TODO ----------------------------------------------------------------------
    --

    module CHS (CHSModule(..), CHSFrag(..), CHSHook(..), CHSTrans(..), CHSParm(..),
                CHSArg(..), CHSAccess(..), CHSAPath(..), CHSPtrType(..),
                skipToLangPragma, hasCPP,
                loadCHS, dumpCHS, hssuffix, chssuffix, loadAllCHI, loadCHI, dumpCHI,
                chisuffix, showCHSParm)
    where

    -- standard libraries
    import Data.Char         (isSpace, toUpper, toLower)
    import Data.List         (intersperse)
    import Control.Monad     (when, unless)

    -- Compiler Toolkit
    import Position  (Position(..), Pos(posOf), nopos, isBuiltinPos)
    import Errors    (interr)
    import Idents    (Ident, identToLexeme, onlyPosIdent)

    -- C->Haskell
    import C2HSState (CST, nop, doesFileExistCIO, readFileCIO, writeFileCIO, getId,
                      getSwitch, chiPathSB, catchExc, throwExc, raiseError,
                      fatal, errorsPresent, showErrors, Traces(..), putTraceStr)

    -- friends
    import CHSLexer  (CHSToken(..), lexCHS)

    -- CHS abstract syntax
    -- -------------------

    -- representation of a CHS module (EXPORTED)
    --
    data CHSModule = CHSModule [CHSFrag]

    -- a CHS code fragament (EXPORTED)
    --
    --  * `CHSVerb' fragments are present throughout the compilation and finally
    --   they are the only type of fragment (describing the generated Haskell
    --   code)
    --
    --  * `CHSHook' are binding hooks, which are being replaced by Haskell code by
    --   `GenBind.expandHooks'
    --
    --  * `CHSCPP' and `CHSC' are fragements of C code that are being removed when
    --   generating the custom C header in `GenHeader.genHeader'
    --
    --  * `CHSCond' are strutured conditionals that are being generated by
    --   `GenHeader.genHeader' from conditional CPP directives (`CHSCPP')
    --
    data CHSFrag = CHSVerb String                   -- Haskell code
                           Position
                 | CHSHook CHSHook                  -- binding hook
                 | CHSCPP  String                   -- pre-processor directive
                           Position
                 | CHSLine Position                 -- line pragma
                 | CHSC    String                   -- C code
                           Position
                 | CHSCond [(Ident,                 -- C variable repr. condition
                             [CHSFrag])]            -- then/elif branches
                           (Maybe [CHSFrag])        -- else branch
                 | CHSLang [String]                 -- GHC language pragma
                           Position

    instance Pos CHSFrag where
      posOf :: CHSFrag -> Position
    posOf (CHSVerb String
    _ Position
    pos ) = Position
    pos
      posOf (CHSHook CHSHook
    hook  ) = CHSHook -> Position
    forall a. Pos a => a -> Position
    posOf CHSHook
    hook
      posOf (CHSCPP  String
    _ Position
    pos ) = Position
    pos
      posOf (CHSLine   Position
    pos ) = Position
    pos
      posOf (CHSC    String
    _ Position
    pos ) = Position
    pos
      posOf (CHSCond [(Ident, [CHSFrag])]
    alts Maybe [CHSFrag]
    _) = case [(Ident, [CHSFrag])]
    alts of
                                 (Ident
    _, CHSFrag
    frag:[CHSFrag]
    _):[(Ident, [CHSFrag])]
    _ -> CHSFrag -> Position
    forall a. Pos a => a -> Position
    posOf CHSFrag
    frag
                                 [(Ident, [CHSFrag])]
    _             -> Position
    nopos
      posOf (CHSLang [String]
    _ Position
    pos)  = Position
    pos

    -- a CHS binding hook (EXPORTED)
    --
    data CHSHook = CHSImport  Bool                  -- qualified?
                              Ident                 -- module name
                              String                -- content of .chi file
                              Position
                 | CHSContext (Maybe String)        -- library name
                              (Maybe String)        -- prefix
                              (Maybe String)        -- lock function
                              Position
                 | CHSType    Ident                 -- C type
                              Position
                 | CHSSizeof  Ident                 -- C type
                              Position
                 | CHSEnum    Ident                 -- C enumeration type
                              (Maybe Ident)         -- Haskell name
                              CHSTrans              -- translation table
                              (Maybe String)        -- local prefix
                              [Ident]               -- instance requests from user
                              Position
                 | CHSCall    Bool                  -- is a pure function?
                              Bool                  -- is unsafe?
                              Bool                  -- is without lock?
                              Ident                 -- C function
                              (Maybe Ident)         -- Haskell name
                              Position
                 | CHSFun     Bool                  -- is a pure function?
                              Bool                  -- is unsafe?
                              Bool                  -- is without lock?
                              Ident                 -- C function
                              (Maybe Ident)         -- Haskell name
                              (Maybe String)        -- type context
                              [CHSParm]             -- argument marshalling
                              CHSParm               -- result marshalling
                              Position
                 | CHSField   CHSAccess             -- access type
                              CHSAPath              -- access path
                              Position
                 | CHSPointer Bool                  -- explicit '*' in hook
                              Ident                 -- C pointer name
                              (Maybe Ident)         -- Haskell name
                              CHSPtrType            -- Ptr, ForeignPtr or StablePtr
                              Bool                  -- create new type?
                              (Maybe Ident)         -- Haskell type pointed to
                              Position
                 | CHSClass   (Maybe Ident)         -- superclass
                              Ident                 -- class name
                              Ident                 -- name of pointer type
                              Position

    instance Pos CHSHook where
      posOf :: CHSHook -> Position
    posOf (CHSImport  Bool
    _ Ident
    _ String
    _         Position
    pos) = Position
    pos
      posOf (CHSContext Maybe String
    _ Maybe String
    _ Maybe String
    _         Position
    pos) = Position
    pos
      posOf (CHSType    Ident
    _             Position
    pos) = Position
    pos
      posOf (CHSSizeof  Ident
    _             Position
    pos) = Position
    pos
      posOf (CHSEnum    Ident
    _ Maybe Ident
    _ CHSTrans
    _ Maybe String
    _ [Ident]
    _     Position
    pos) = Position
    pos
      posOf (CHSCall    Bool
    _ Bool
    _ Bool
    _ Ident
    _ Maybe Ident
    _     Position
    pos) = Position
    pos
      posOf (CHSFun   Bool
    _ Bool
    _ Bool
    _ Ident
    _ Maybe Ident
    _ Maybe String
    _ [CHSParm]
    _ CHSParm
    _ Position
    pos) = Position
    pos
      posOf (CHSField   CHSAccess
    _ CHSAPath
    _           Position
    pos) = Position
    pos
      posOf (CHSPointer Bool
    _ Ident
    _ Maybe Ident
    _ CHSPtrType
    _ Bool
    _ Maybe Ident
    _   Position
    pos) = Position
    pos
      posOf (CHSClass   Maybe Ident
    _ Ident
    _ Ident
    _         Position
    pos) = Position
    pos

    -- two hooks are equal if they have the same Haskell name and reference the
    -- same C object
    --
    instance Eq CHSHook where
      (CHSImport Bool
    qual1 Ident
    ide1 String
    _      Position
    _) == :: CHSHook -> CHSHook -> Bool
    == (CHSImport Bool
    qual2 Ident
    ide2 String
    _      Position
    _) =
        Bool
    qual1 Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == Bool
    qual2 Bool -> Bool -> Bool
    && Ident
    ide1 Ident -> Ident -> Bool
    forall a. Eq a => a -> a -> Bool
    == Ident
    ide2
      (CHSContext Maybe String
    olib1 Maybe String
    opref1 Maybe String
    olock1 Position
    _   ) ==
        (CHSContext Maybe String
    olib2 Maybe String
    opref2 Maybe String
    olock2 Position
    _   ) =
        Maybe String
    olib1 Maybe String -> Maybe String -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe String
    olib1 Bool -> Bool -> Bool
    && Maybe String
    opref1 Maybe String -> Maybe String -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe String
    opref2 Bool -> Bool -> Bool
    && Maybe String
    olock1 Maybe String -> Maybe String -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe String
    olock2
      (CHSType Ident
    ide1                Position
    _) == (CHSType Ident
    ide2                Position
    _) =
        Ident
    ide1 Ident -> Ident -> Bool
    forall a. Eq a => a -> a -> Bool
    == Ident
    ide2
      (CHSSizeof Ident
    ide1              Position
    _) == (CHSSizeof Ident
    ide2              Position
    _) =
        Ident
    ide1 Ident -> Ident -> Bool
    forall a. Eq a => a -> a -> Bool
    == Ident
    ide2
      (CHSEnum Ident
    ide1 Maybe Ident
    oalias1 CHSTrans
    _ Maybe String
    _ [Ident]
    _  Position
    _) == (CHSEnum Ident
    ide2 Maybe Ident
    oalias2 CHSTrans
    _ Maybe String
    _ [Ident]
    _  Position
    _) =
        Maybe Ident
    oalias1 Maybe Ident -> Maybe Ident -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe Ident
    oalias2 Bool -> Bool -> Bool
    && Ident
    ide1 Ident -> Ident -> Bool
    forall a. Eq a => a -> a -> Bool
    == Ident
    ide2
      (CHSCall Bool
    _ Bool
    _ Bool
    _ Ident
    ide1 Maybe Ident
    oalias1    Position
    _) == (CHSCall Bool
    _ Bool
    _ Bool
    _ Ident
    ide2 Maybe Ident
    oalias2    Position
    _) =
        Maybe Ident
    oalias1 Maybe Ident -> Maybe Ident -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe Ident
    oalias2 Bool -> Bool -> Bool
    && Ident
    ide1 Ident -> Ident -> Bool
    forall a. Eq a => a -> a -> Bool
    == Ident
    ide2
      (CHSFun  Bool
    _ Bool
    _ Bool
    _ Ident
    ide1 Maybe Ident
    oalias1 Maybe String
    _ [CHSParm]
    _ CHSParm
    _ Position
    _)
                                      == (CHSFun Bool
    _ Bool
    _ Bool
    _ Ident
    ide2 Maybe Ident
    oalias2 Maybe String
    _ [CHSParm]
    _ CHSParm
    _ Position
    _) =
        Maybe Ident
    oalias1 Maybe Ident -> Maybe Ident -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe Ident
    oalias2 Bool -> Bool -> Bool
    && Ident
    ide1 Ident -> Ident -> Bool
    forall a. Eq a => a -> a -> Bool
    == Ident
    ide2
      (CHSField CHSAccess
    acc1 CHSAPath
    path1         Position
    _) == (CHSField CHSAccess
    acc2 CHSAPath
    path2         Position
    _) =
        CHSAccess
    acc1 CHSAccess -> CHSAccess -> Bool
    forall a. Eq a => a -> a -> Bool
    == CHSAccess
    acc2 Bool -> Bool -> Bool
    && CHSAPath
    path1 CHSAPath -> CHSAPath -> Bool
    forall a. Eq a => a -> a -> Bool
    == CHSAPath
    path2
      (CHSPointer Bool
    _ Ident
    ide1 Maybe Ident
    oalias1 CHSPtrType
    _ Bool
    _ Maybe Ident
    _ Position
    _)
                                      == (CHSPointer Bool
    _ Ident
    ide2 Maybe Ident
    oalias2 CHSPtrType
    _ Bool
    _ Maybe Ident
    _ Position
    _) =
        Ident
    ide1 Ident -> Ident -> Bool
    forall a. Eq a => a -> a -> Bool
    == Ident
    ide2 Bool -> Bool -> Bool
    && Maybe Ident
    oalias1 Maybe Ident -> Maybe Ident -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe Ident
    oalias2
      (CHSClass Maybe Ident
    _ Ident
    ide1 Ident
    _           Position
    _) == (CHSClass Maybe Ident
    _ Ident
    ide2 Ident
    _           Position
    _) =
        Ident
    ide1 Ident -> Ident -> Bool
    forall a. Eq a => a -> a -> Bool
    == Ident
    ide2
      CHSHook
    _                               == CHSHook
    _                          = Bool
    False

    -- translation table (EXPORTED)
    --
    data CHSTrans = CHSTrans Bool                   -- underscore to case?
                             [(Ident, Ident)]       -- alias list

    -- marshalling descriptor for function hooks (EXPORTED)
    --
    --  * a marshaller consists of a function name and flag indicating whether it
    --   has to be executed in the IO monad
    --
    data CHSParm = CHSParm (Maybe (Ident, CHSArg))  -- "in" marshaller
                           String                   -- Haskell type
                           Bool                     -- C repr: two values?
                           (Maybe (Ident, CHSArg))  -- "out" marshaller
                           Position

    -- kinds of arguments in function hooks (EXPORTED)
    --
    data CHSArg = CHSValArg                         -- plain value argument
                | CHSIOArg                          -- reference argument
                | CHSVoidArg                        -- no argument
                deriving (CHSArg -> CHSArg -> Bool
    (CHSArg -> CHSArg -> Bool)
    -> (CHSArg -> CHSArg -> Bool) -> Eq CHSArg
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: CHSArg -> CHSArg -> Bool
    == :: CHSArg -> CHSArg -> Bool
    $c/= :: CHSArg -> CHSArg -> Bool
    /= :: CHSArg -> CHSArg -> Bool
    Eq)

    -- structure member access types (EXPORTED)
    --
    data CHSAccess = CHSSet                         -- set structure field
                   | CHSGet                         -- get structure field
                   deriving (CHSAccess -> CHSAccess -> Bool
    (CHSAccess -> CHSAccess -> Bool)
    -> (CHSAccess -> CHSAccess -> Bool) -> Eq CHSAccess
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: CHSAccess -> CHSAccess -> Bool
    == :: CHSAccess -> CHSAccess -> Bool
    $c/= :: CHSAccess -> CHSAccess -> Bool
    /= :: CHSAccess -> CHSAccess -> Bool
    Eq)

    -- structure access path (EXPORTED)
    --
    data CHSAPath = CHSRoot  Ident                  -- root of access path
                  | CHSDeref CHSAPath Position      -- dereferencing
                  | CHSRef   CHSAPath Ident         -- member referencing
                  deriving (CHSAPath -> CHSAPath -> Bool
    (CHSAPath -> CHSAPath -> Bool)
    -> (CHSAPath -> CHSAPath -> Bool) -> Eq CHSAPath
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: CHSAPath -> CHSAPath -> Bool
    == :: CHSAPath -> CHSAPath -> Bool
    $c/= :: CHSAPath -> CHSAPath -> Bool
    /= :: CHSAPath -> CHSAPath -> Bool
    Eq)

    -- pointer options (EXPORTED)
    --

    data CHSPtrType = CHSPtr                        -- standard Ptr from Haskell
                    | CHSForeignPtr                 -- a pointer with a finalizer
                    | CHSStablePtr                  -- a pointer into Haskell land
                    deriving (CHSPtrType -> CHSPtrType -> Bool
    (CHSPtrType -> CHSPtrType -> Bool)
    -> (CHSPtrType -> CHSPtrType -> Bool) -> Eq CHSPtrType
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: CHSPtrType -> CHSPtrType -> Bool
    == :: CHSPtrType -> CHSPtrType -> Bool
    $c/= :: CHSPtrType -> CHSPtrType -> Bool
    /= :: CHSPtrType -> CHSPtrType -> Bool
    Eq)

    instance Show CHSPtrType where
      show :: CHSPtrType -> String
    show CHSPtrType
    CHSPtr            = String
    "Ptr"
      show CHSPtrType
    CHSForeignPtr     = String
    "ForeignPtr"
      show CHSPtrType
    CHSStablePtr      = String
    "StablePtr"

    instance Read CHSPtrType where
      readsPrec :: Int -> ReadS CHSPtrType
    readsPrec Int
    _ (                            Char
    'P':Char
    't':Char
    'r':String
    rest) =
        [(CHSPtrType
    CHSPtr, String
    rest)]
      readsPrec Int
    _ (Char
    'F':Char
    'o':Char
    'r':Char
    'e':Char
    'i':Char
    'g':Char
    'n':Char
    'P':Char
    't':Char
    'r':String
    rest) =
        [(CHSPtrType
    CHSForeignPtr, String
    rest)]
      readsPrec Int
    _ (Char
    'S':Char
    't':Char
    'a':Char
    'b':Char
    'l':Char
    'e'    :Char
    'P':Char
    't':Char
    'r':String
    rest) =
        [(CHSPtrType
    CHSStablePtr, String
    rest)]
      readsPrec Int
    p (Char
    c:String
    cs)
        | Char -> Bool
    isSpace Char
    c                                              = Int -> ReadS CHSPtrType
    forall a. Read a => Int -> ReadS a
    readsPrec Int
    p String
    cs
      readsPrec Int
    _ String
    _                                              = []

    -- return a modified module description that starts off with a LANGUAGE pragma
    -- if it contains a LANGUAGE pragma at all
    skipToLangPragma :: CHSModule -> Maybe CHSModule
    skipToLangPragma :: CHSModule -> Maybe CHSModule
    skipToLangPragma (CHSModule [CHSFrag]
    frags) = [CHSFrag] -> Maybe CHSModule
    hLP [CHSFrag]
    frags
      where
      hLP :: [CHSFrag] -> Maybe CHSModule
    hLP all :: [CHSFrag]
    all@(CHSLang [String]
    exts Position
    _:[CHSFrag]
    _) = CHSModule -> Maybe CHSModule
    forall a. a -> Maybe a
    Just ([CHSFrag] -> CHSModule
    CHSModule [CHSFrag]
    all)
      hLP (CHSFrag
    x:[CHSFrag]
    xs) = [CHSFrag] -> Maybe CHSModule
    hLP [CHSFrag]
    xs
      hLP [] = Maybe CHSModule
    forall a. Maybe a
    Nothing

    -- test if the language pragma contains the CPP option
    hasCPP :: CHSModule -> Bool
    hasCPP :: CHSModule -> Bool
    hasCPP (CHSModule (CHSLang [String]
    exts Position
    _:[CHSFrag]
    _)) = String
    "CPP" String -> [String] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [String]
    exts
    hasCPP CHSModule
    _ = Bool
    False

    -- load and dump a CHS file
    -- ------------------------

    hssuffix, chssuffix :: String
    hssuffix :: String
    hssuffix  = String
    ".hs"
    chssuffix :: String
    chssuffix = String
    ".chs"

    -- parse a CHS module (EXPORTED)
    --
    --  * in case of a syntactical or lexical error, a fatal error is raised;
    --   warnings are returned together with the module
    --
    loadCHS       :: FilePath -> CST s (CHSModule, String)
    loadCHS :: forall s. String -> CST s (CHSModule, String)
    loadCHS String
    fname = do
       -- parse
       --
       String -> CST s ()
    forall {s}. String -> CST s ()
    traceInfoRead String
    fname
       String
    contents <- String -> PreCST SwitchBoard s String
    forall e s. String -> PreCST e s String
    readFileCIO String
    fname
       CST s ()
    forall {s}. CST s ()
    traceInfoParse
       CHSModule
    mod <- Position -> String -> CST s CHSModule
    forall s. Position -> String -> CST s CHSModule
    parseCHSModule (String -> Int -> Int -> Position
    Position String
    fname Int
    1 Int
    1) String
    contents

       -- check for errors and finalize
       --
       Bool
    errs <- PreCST SwitchBoard s Bool
    forall e s. PreCST e s Bool
    errorsPresent
       if Bool
    errs
         then do
           CST s ()
    forall {s}. CST s ()
    traceInfoErr
           String
    errmsgs <- PreCST SwitchBoard s String
    forall e s. PreCST e s String
    showErrors
           String -> CST s (CHSModule, String)
    forall e s a. String -> PreCST e s a
    fatal (String
    "CHS module contains \
                  \errors:\n\n" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    errmsgs)   -- fatal error
         else do
           CST s ()
    forall {s}. CST s ()
    traceInfoOK
           String
    warnmsgs <- PreCST SwitchBoard s String
    forall e s. PreCST e s String
    showErrors
           (CHSModule, String) -> CST s (CHSModule, String)
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CHSModule
    mod, String
    warnmsgs)
      where
        traceInfoRead :: String -> CST s ()
    traceInfoRead String
    fname = (Traces -> Bool) -> String -> CST s ()
    forall s. (Traces -> Bool) -> String -> CST s ()
    putTraceStr Traces -> Bool
    tracePhasesSW
                                (String
    "Attempting to read file `"
                                 String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    fname String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "'...\n")
        traceInfoParse :: CST s ()
    traceInfoParse      = (Traces -> Bool) -> String -> CST s ()
    forall s. (Traces -> Bool) -> String -> CST s ()
    putTraceStr Traces -> Bool
    tracePhasesSW
                                (String
    "...parsing `"
                                 String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    fname String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "'...\n")
        traceInfoErr :: CST s ()
    traceInfoErr        = (Traces -> Bool) -> String -> CST s ()
    forall s. (Traces -> Bool) -> String -> CST s ()
    putTraceStr Traces -> Bool
    tracePhasesSW
                                (String
    "...error(s) detected in `"
                                 String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    fname String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "'.\n")
        traceInfoOK :: CST s ()
    traceInfoOK         = (Traces -> Bool) -> String -> CST s ()
    forall s. (Traces -> Bool) -> String -> CST s ()
    putTraceStr Traces -> Bool
    tracePhasesSW
                                (String
    "...successfully loaded `"
                                 String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    fname String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "'.\n")

    -- given a file name (no suffix) and a CHS module, the module is printed
    -- into that file (EXPORTED)
    --
    --  * the module can be flagged as being pure Haskell
    --
    --  * the correct suffix will automagically be appended
    --
    dumpCHS                       :: String -> CHSModule -> Bool -> CST s ()
    dumpCHS :: forall s. String -> CHSModule -> Bool -> CST s ()
    dumpCHS String
    fname CHSModule
    mod Bool
    pureHaskell  =
      do
        let (String
    suffix, String
    kind) = if Bool
    pureHaskell
                             then (String
    hssuffix , String
    "(Haskell)")
                             else (String
    chssuffix, String
    "(C->HS binding)")
        (String
    version, String
    _, String
    _) <- PreCST SwitchBoard s (String, String, String)
    forall e s. PreCST e s (String, String, String)
    getId
        String -> String -> CST s ()
    forall e s. String -> String -> PreCST e s ()
    writeFileCIO (String
    fname String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    suffix) (String -> ShowS
    contents String
    version String
    kind)
      where
        contents :: String -> ShowS
    contents String
    version String
    kind | CHSModule -> Bool
    hasCPP CHSModule
    mod = CHSModule -> Bool -> String
    showCHSModule CHSModule
    mod Bool
    pureHaskell
                              | Bool
    otherwise =
          String
    "-- GENERATED by " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    version String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    kind String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n\
          \-- Edit the ORIGNAL .chs file instead!\n\n"
          String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ CHSModule -> Bool -> String
    showCHSModule CHSModule
    mod Bool
    pureHaskell

    -- to keep track of the current state of the line emission automaton
    --
    data LineState = Emit           -- emit LINE pragma if next frag is Haskell
                   | Wait           -- emit LINE pragma after the next '\n'
                   | NoLine         -- no pragma needed
                   deriving (LineState -> LineState -> Bool
    (LineState -> LineState -> Bool)
    -> (LineState -> LineState -> Bool) -> Eq LineState
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: LineState -> LineState -> Bool
    == :: LineState -> LineState -> Bool
    $c/= :: LineState -> LineState -> Bool
    /= :: LineState -> LineState -> Bool
    Eq)

    -- convert a CHS module into a string
    --
    --  * if the second argument is `True', all fragments must contain Haskell code
    --
    showCHSModule                               :: CHSModule -> Bool -> String
    showCHSModule :: CHSModule -> Bool -> String
    showCHSModule (CHSModule [CHSFrag]
    frags) Bool
    pureHaskell  =
      Bool -> LineState -> [CHSFrag] -> ShowS
    showFrags Bool
    pureHaskell LineState
    Emit [CHSFrag]
    frags []
      where
        -- the second argument indicates whether the next fragment (if it is
        -- Haskell code) should be preceded by a LINE pragma; in particular
        -- generated fragments and those following them need to be prefixed with a
        -- LINE pragma
        --
        showFrags :: Bool -> LineState -> [CHSFrag] -> ShowS
        showFrags :: Bool -> LineState -> [CHSFrag] -> ShowS
    showFrags Bool
    _      LineState
    _     []                           = ShowS
    forall a. a -> a
    id
        showFrags Bool
    pureHs LineState
    state (CHSVerb String
    s      Position
    pos : [CHSFrag]
    frags) =
          let
            (Position String
    fname Int
    line Int
    _) = Position
    pos
            generated :: Bool
    generated        = Position -> Bool
    isBuiltinPos Position
    pos
            emitNow :: Bool
    emitNow          = LineState
    state LineState -> LineState -> Bool
    forall a. Eq a => a -> a -> Bool
    == LineState
    Emit Bool -> Bool -> Bool
    ||
                               (LineState
    state LineState -> LineState -> Bool
    forall a. Eq a => a -> a -> Bool
    == LineState
    Wait Bool -> Bool -> Bool
    && Bool -> Bool
    not (String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    s) Bool -> Bool -> Bool
    && Bool
    nlStart)
            nlStart :: Bool
    nlStart          = String -> Char
    forall a. HasCallStack => [a] -> a
    head String
    s Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '\n'
            nextState :: LineState
    nextState        = if Bool
    generated then LineState
    Wait else LineState
    NoLine
          in
            (if Bool
    emitNow then
               String -> ShowS
    showString (String
    "\n{-# LINE " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show (Int
    line Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    `max` Int
    0) String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                           ShowS
    forall a. Show a => a -> String
    show String
    fname String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " #-}" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                           (if Bool
    nlStart then String
    "" else String
    "\n"))
             else ShowS
    forall a. a -> a
    id)
          ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    s
          ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> LineState -> [CHSFrag] -> ShowS
    showFrags Bool
    pureHs LineState
    nextState [CHSFrag]
    frags
        showFrags Bool
    False  LineState
    _     (CHSHook CHSHook
    hook       : [CHSFrag]
    frags) =
            String -> ShowS
    showString String
    "{#"
          ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CHSHook -> ShowS
    showCHSHook CHSHook
    hook
          ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    "#}"
          ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> LineState -> [CHSFrag] -> ShowS
    showFrags Bool
    False LineState
    Wait [CHSFrag]
    frags
        showFrags Bool
    False  LineState
    _     (CHSCPP  String
    s    Position
    _     : [CHSFrag]
    frags) =
            Char -> ShowS
    showChar Char
    '#'
          ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    s
    --      . showChar '\n'
          ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> LineState -> [CHSFrag] -> ShowS
    showFrags Bool
    False LineState
    Emit [CHSFrag]
    frags
        showFrags Bool
    pureHs LineState
    _     (CHSLine Position
    s          : [CHSFrag]
    frags) =
            Bool -> LineState -> [CHSFrag] -> ShowS
    showFrags Bool
    pureHs LineState
    Emit [CHSFrag]
    frags
        showFrags Bool
    False  LineState
    _     (CHSC    String
    s    Position
    _     : [CHSFrag]
    frags) =
            String -> ShowS
    showString String
    "\n#c"
          ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    s
          ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    "\n#endc"
          ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> LineState -> [CHSFrag] -> ShowS
    showFrags Bool
    False LineState
    Emit [CHSFrag]
    frags
        showFrags Bool
    False  LineState
    _     (CHSCond [(Ident, [CHSFrag])]
    _    Maybe [CHSFrag]
    _     : [CHSFrag]
    frags) =
          String -> ShowS
    forall a. String -> a
    interr String
    "showCHSFrag: Cannot print `CHSCond'!"
        showFrags Bool
    pureHs LineState
    _     (CHSLang [String]
    exts Position
    _     : [CHSFrag]
    frags) =
          let extsNoCPP :: [String]
    extsNoCPP = (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    (/=) String
    "CPP") [String]
    exts in
          if [String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    extsNoCPP then Bool -> LineState -> [CHSFrag] -> ShowS
    showFrags Bool
    pureHs LineState
    Emit [CHSFrag]
    frags else
            String -> ShowS
    showString String
    "{-# LANGUAGE "
          ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString ([String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat (String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    intersperse String
    "," [String]
    extsNoCPP))
          ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    " #-}\n"
          ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> LineState -> [CHSFrag] -> ShowS
    showFrags Bool
    pureHs LineState
    Emit [CHSFrag]
    frags
        showFrags Bool
    True   LineState
    _     [CHSFrag]
    _                            =
          String -> ShowS
    forall a. String -> a
    interr String
    "showCHSFrag: Illegal hook, cpp directive, or inline C code!"

    showCHSHook :: CHSHook -> ShowS
    showCHSHook :: CHSHook -> ShowS
    showCHSHook (CHSImport Bool
    isQual Ident
    ide String
    _ Position
    _) =
        String -> ShowS
    showString String
    "import "
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (if Bool
    isQual then String -> ShowS
    showString String
    "qualified " else ShowS
    forall a. a -> a
    id)
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Ident -> ShowS
    showCHSIdent Ident
    ide
    showCHSHook (CHSContext Maybe String
    olib Maybe String
    oprefix Maybe String
    olock Position
    _) =
        String -> ShowS
    showString String
    "context "
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (case Maybe String
    olib of
           Maybe String
    Nothing  -> String -> ShowS
    showString String
    ""
           Just String
    lib -> String -> ShowS
    showString String
    "lib = " ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    lib ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    " ")
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe String -> Bool -> ShowS
    showPrefix Maybe String
    oprefix Bool
    False
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (case Maybe String
    olock of
           Maybe String
    Nothing  -> String -> ShowS
    showString String
    ""
           Just String
    lock -> String -> ShowS
    showString String
    "lock = " ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    lock ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    " ")
    showCHSHook (CHSType Ident
    ide Position
    _) =
        String -> ShowS
    showString String
    "type "
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Ident -> ShowS
    showCHSIdent Ident
    ide
    showCHSHook (CHSSizeof Ident
    ide Position
    _) =
        String -> ShowS
    showString String
    "sizeof "
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Ident -> ShowS
    showCHSIdent Ident
    ide
    showCHSHook (CHSEnum Ident
    ide Maybe Ident
    oalias CHSTrans
    trans Maybe String
    oprefix [Ident]
    derive Position
    _) =
        String -> ShowS
    showString String
    "enum "
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Ident -> Maybe Ident -> ShowS
    showIdAlias Ident
    ide Maybe Ident
    oalias
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CHSTrans -> ShowS
    showCHSTrans CHSTrans
    trans
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe String -> Bool -> ShowS
    showPrefix Maybe String
    oprefix Bool
    True
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . if [Ident] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Ident]
    derive then ShowS
    forall a. a -> a
    id else String -> ShowS
    showString (String -> ShowS) -> String -> ShowS
    forall a b. (a -> b) -> a -> b
    $
          String
    "deriving ("
          String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat (String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    intersperse String
    ", " ((Ident -> String) -> [Ident] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Ident -> String
    identToLexeme [Ident]
    derive))
          String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ") "
    showCHSHook (CHSCall Bool
    isPure Bool
    isUns Bool
    isNol Ident
    ide Maybe Ident
    oalias Position
    _) =
        String -> ShowS
    showString String
    "call "
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (if Bool
    isPure then String -> ShowS
    showString String
    "pure " else ShowS
    forall a. a -> a
    id)
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (if Bool
    isUns then String -> ShowS
    showString String
    "unsafe " else ShowS
    forall a. a -> a
    id)
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (if Bool
    isNol then String -> ShowS
    showString String
    "nolock " else ShowS
    forall a. a -> a
    id)
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Ident -> Maybe Ident -> ShowS
    showIdAlias Ident
    ide Maybe Ident
    oalias
    showCHSHook (CHSFun Bool
    isPure Bool
    isUns Bool
    isNol Ident
    ide Maybe Ident
    oalias Maybe String
    octxt [CHSParm]
    parms CHSParm
    parm Position
    _) =
        String -> ShowS
    showString String
    "fun "
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (if Bool
    isPure then String -> ShowS
    showString String
    "pure " else ShowS
    forall a. a -> a
    id)
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (if Bool
    isUns then String -> ShowS
    showString String
    "unsafe " else ShowS
    forall a. a -> a
    id)
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (if Bool
    isNol then String -> ShowS
    showString String
    "nolock " else ShowS
    forall a. a -> a
    id)
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Ident -> Maybe Ident -> ShowS
    showIdAlias Ident
    ide Maybe Ident
    oalias
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (case Maybe String
    octxt of
           Maybe String
    Nothing      -> Char -> ShowS
    showChar Char
    ' '
           Just String
    ctxtStr -> String -> ShowS
    showString String
    ctxtStr ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    " => ")
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    "{"
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ShowS -> ShowS -> ShowS) -> ShowS -> [ShowS] -> ShowS
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    (.) ShowS
    forall a. a -> a
    id (ShowS -> [ShowS] -> [ShowS]
    forall a. a -> [a] -> [a]
    intersperse (String -> ShowS
    showString String
    ", ") ((CHSParm -> ShowS) -> [CHSParm] -> [ShowS]
    forall a b. (a -> b) -> [a] -> [b]
    map CHSParm -> ShowS
    showCHSParm [CHSParm]
    parms))
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    "} -> "
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CHSParm -> ShowS
    showCHSParm CHSParm
    parm
    showCHSHook (CHSField CHSAccess
    acc CHSAPath
    path Position
    _) =
        (case CHSAccess
    acc of
           CHSAccess
    CHSGet -> String -> ShowS
    showString String
    "get "
           CHSAccess
    CHSSet -> String -> ShowS
    showString String
    "set ")
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CHSAPath -> ShowS
    showCHSAPath CHSAPath
    path
    showCHSHook (CHSPointer Bool
    star Ident
    ide Maybe Ident
    oalias CHSPtrType
    ptrType Bool
    isNewtype Maybe Ident
    oRefType Position
    _) =
        String -> ShowS
    showString String
    "pointer "
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (if Bool
    star then String -> ShowS
    showString String
    "*" else String -> ShowS
    showString String
    "")
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Ident -> Maybe Ident -> ShowS
    showIdAlias Ident
    ide Maybe Ident
    oalias
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (case CHSPtrType
    ptrType of
           CHSPtrType
    CHSForeignPtr -> String -> ShowS
    showString String
    " foreign"
           CHSPtrType
    CHSStablePtr  -> String -> ShowS
    showString String
    " stable"
           CHSPtrType
    _             -> String -> ShowS
    showString String
    "")
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (case (Bool
    isNewtype, Maybe Ident
    oRefType) of
           (Bool
    True , Maybe Ident
    _       ) -> String -> ShowS
    showString String
    " newtype"
           (Bool
    False, Just Ident
    ide) -> String -> ShowS
    showString String
    " -> " ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Ident -> ShowS
    showCHSIdent Ident
    ide
           (Bool
    False, Maybe Ident
    Nothing ) -> String -> ShowS
    showString String
    "")
    showCHSHook (CHSClass Maybe Ident
    oclassIde Ident
    classIde Ident
    typeIde Position
    _) =
        String -> ShowS
    showString String
    "class "
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (case Maybe Ident
    oclassIde of
           Maybe Ident
    Nothing       -> String -> ShowS
    showString String
    ""
           Just Ident
    classIde -> Ident -> ShowS
    showCHSIdent Ident
    classIde ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    " => ")
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Ident -> ShowS
    showCHSIdent Ident
    classIde
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    " "
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Ident -> ShowS
    showCHSIdent Ident
    typeIde

    showPrefix                        :: Maybe String -> Bool -> ShowS
    showPrefix :: Maybe String -> Bool -> ShowS
    showPrefix Maybe String
    Nothing       Bool
    _         = String -> ShowS
    showString String
    ""
    showPrefix (Just String
    prefix) Bool
    withWith  =   ShowS
    maybeWith
                                         ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    "prefix = "
                                         ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    prefix
                                         ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    " "
      where
        maybeWith :: ShowS
    maybeWith = if Bool
    withWith then String -> ShowS
    showString String
    "with " else ShowS
    forall a. a -> a
    id

    showIdAlias            :: Ident -> Maybe Ident -> ShowS
    showIdAlias :: Ident -> Maybe Ident -> ShowS
    showIdAlias Ident
    ide Maybe Ident
    oalias  =
        Ident -> ShowS
    showCHSIdent Ident
    ide
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (case Maybe Ident
    oalias of
           Maybe Ident
    Nothing  -> ShowS
    forall a. a -> a
    id
           Just Ident
    ide -> String -> ShowS
    showString String
    " as " ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Ident -> ShowS
    showCHSIdent Ident
    ide)

    showCHSParm                                                :: CHSParm -> ShowS
    showCHSParm :: CHSParm -> ShowS
    showCHSParm (CHSParm Maybe (Ident, CHSArg)
    oimMarsh String
    hsTyStr Bool
    twoCVals Maybe (Ident, CHSArg)
    oomMarsh Position
    _)  =
        Maybe (Ident, CHSArg) -> ShowS
    showOMarsh Maybe (Ident, CHSArg)
    oimMarsh
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> ShowS
    showChar Char
    ' '
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showHsVerb String
    hsTyStr
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (if Bool
    twoCVals then Char -> ShowS
    showChar Char
    '&' else ShowS
    forall a. a -> a
    id)
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> ShowS
    showChar Char
    ' '
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe (Ident, CHSArg) -> ShowS
    showOMarsh Maybe (Ident, CHSArg)
    oomMarsh
      where
        showOMarsh :: Maybe (Ident, CHSArg) -> ShowS
    showOMarsh Maybe (Ident, CHSArg)
    Nothing               = ShowS
    forall a. a -> a
    id
        showOMarsh (Just (Ident
    ide, CHSArg
    argKind)) =   Ident -> ShowS
    showCHSIdent Ident
    ide
                                           ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (case CHSArg
    argKind of
                                               CHSArg
    CHSValArg  -> ShowS
    forall a. a -> a
    id
                                               CHSArg
    CHSIOArg   -> String -> ShowS
    showString String
    "*"
                                               CHSArg
    CHSVoidArg -> String -> ShowS
    showString String
    "-")
        --
        showHsVerb :: String -> ShowS
    showHsVerb String
    str = Char -> ShowS
    showChar Char
    '`' ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    str ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> ShowS
    showChar Char
    '\''

    showCHSTrans                          :: CHSTrans -> ShowS
    showCHSTrans :: CHSTrans -> ShowS
    showCHSTrans (CHSTrans Bool
    _2Case [(Ident, Ident)]
    assocs)  =
        String -> ShowS
    showString String
    "{"
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (if Bool
    _2Case then String -> ShowS
    showString (String
    "underscoreToCase" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    maybeComma) else ShowS
    forall a. a -> a
    id)
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ShowS -> ShowS -> ShowS) -> ShowS -> [ShowS] -> ShowS
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    (.) ShowS
    forall a. a -> a
    id (ShowS -> [ShowS] -> [ShowS]
    forall a. a -> [a] -> [a]
    intersperse (String -> ShowS
    showString String
    ", ") (((Ident, Ident) -> ShowS) -> [(Ident, Ident)] -> [ShowS]
    forall a b. (a -> b) -> [a] -> [b]
    map (Ident, Ident) -> ShowS
    showAssoc [(Ident, Ident)]
    assocs))
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    "}"
      where
        maybeComma :: String
    maybeComma = if [(Ident, Ident)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(Ident, Ident)]
    assocs then String
    "" else String
    ", "
        --
        showAssoc :: (Ident, Ident) -> ShowS
    showAssoc (Ident
    ide1, Ident
    ide2) =
            Ident -> ShowS
    showCHSIdent Ident
    ide1
          ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    " as "
          ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Ident -> ShowS
    showCHSIdent Ident
    ide2

    showCHSAPath :: CHSAPath -> ShowS
    showCHSAPath :: CHSAPath -> ShowS
    showCHSAPath (CHSRoot Ident
    ide) =
      Ident -> ShowS
    showCHSIdent Ident
    ide
    showCHSAPath (CHSDeref CHSAPath
    path Position
    _) =
        String -> ShowS
    showString String
    "* "
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CHSAPath -> ShowS
    showCHSAPath CHSAPath
    path
    showCHSAPath (CHSRef (CHSDeref CHSAPath
    path Position
    _) Ident
    ide) =
        CHSAPath -> ShowS
    showCHSAPath CHSAPath
    path
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    "->"
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Ident -> ShowS
    showCHSIdent Ident
    ide
    showCHSAPath (CHSRef CHSAPath
    path Ident
    ide) =
       CHSAPath -> ShowS
    showCHSAPath CHSAPath
    path
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    "."
      ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Ident -> ShowS
    showCHSIdent Ident
    ide

    showCHSIdent :: Ident -> ShowS
    showCHSIdent :: Ident -> ShowS
    showCHSIdent  = String -> ShowS
    showString (String -> ShowS) -> (Ident -> String) -> Ident -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Ident -> String
    identToLexeme

    -- load and dump a CHI file
    -- ------------------------

    chisuffix :: String
    chisuffix :: String
    chisuffix  = String
    ".chi"

    versionPrefix :: String
    versionPrefix :: String
    versionPrefix  = String
    "C->Haskell Interface Version "

    -- replace all import names with the content of the CHI file
    loadAllCHI :: CHSModule -> CST s CHSModule
    loadAllCHI :: forall s. CHSModule -> CST s CHSModule
    loadAllCHI (CHSModule [CHSFrag]
    frags) = do
            let checkFrag :: CHSFrag -> PreCST SwitchBoard s CHSFrag
    checkFrag (CHSHook (CHSImport Bool
    qual Ident
    name String
    fName Position
    pos)) = do
                    String
    chi <- String -> CST s String
    forall s. String -> CST s String
    loadCHI String
    fName
                    CHSFrag -> PreCST SwitchBoard s CHSFrag
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CHSHook -> CHSFrag
    CHSHook (Bool -> Ident -> String -> Position -> CHSHook
    CHSImport Bool
    qual Ident
    name String
    chi Position
    pos))
                checkFrag CHSFrag
    h = CHSFrag -> PreCST SwitchBoard s CHSFrag
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return CHSFrag
    h
            [CHSFrag]
    frags' <- (CHSFrag -> PreCST SwitchBoard s CHSFrag)
    -> [CHSFrag] -> PreCST SwitchBoard s [CHSFrag]
    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 CHSFrag -> PreCST SwitchBoard s CHSFrag
    forall {s}. CHSFrag -> PreCST SwitchBoard s CHSFrag
    checkFrag [CHSFrag]
    frags
            CHSModule -> CST s CHSModule
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([CHSFrag] -> CHSModule
    CHSModule [CHSFrag]
    frags')

    -- load a CHI file (EXPORTED)
    --
    --  * the file suffix is automagically appended
    --
    --  * any error raises a syntax exception (see below)
    --
    --  * the version of the .chi file is checked against the version of the current
    --   executable; they must match in the major and minor version
    --
    loadCHI       :: FilePath -> CST s String
    loadCHI :: forall s. String -> CST s String
    loadCHI String
    fname  = do
                       -- search for .chi files
                       --
                       [String]
    paths <- (SwitchBoard -> [String]) -> CST s [String]
    forall a s. (SwitchBoard -> a) -> CST s a
    getSwitch SwitchBoard -> [String]
    chiPathSB
                       let fullnames :: [String]
    fullnames = [String
    path String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Char
    '/'Char -> ShowS
    forall a. a -> [a] -> [a]
    :String
    fname String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    chisuffix |
                                        String
    path <- [String]
    paths]
                       String
    fullname <- [String] -> CST s String -> CST s String
    forall {e} {s}. [String] -> PreCST e s String -> PreCST e s String
    findFirst [String]
    fullnames
                         (String -> CST s String
    forall e s a. String -> PreCST e s a
    fatal (String -> CST s String) -> String -> CST s String
    forall a b. (a -> b) -> a -> b
    $ String
    fnameString -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    chisuffixString -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    " not found in:\n"String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                                  [String] -> String
    unlines [String]
    paths)
                       -- read file
                       --
                       String -> CST s ()
    forall {s}. String -> CST s ()
    traceInfoRead String
    fullname
                       String
    contents <- String -> CST s String
    forall e s. String -> PreCST e s String
    readFileCIO String
    fullname

                       -- parse
                       --
                       CST s ()
    forall {s}. CST s ()
    traceInfoVersion
                       let ls :: [String]
    ls = String -> [String]
    lines String
    contents
                       Bool -> CST s () -> CST s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ([String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    ls) (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
    errorCHICorrupt String
    fname
                       let String
    versline:[String]
    chi = [String]
    ls
                           prefixLen :: Int
    prefixLen    = String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    versionPrefix
                       Bool -> CST s () -> CST s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    versline Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    prefixLen
                             Bool -> Bool -> Bool
    || Int -> ShowS
    forall a. Int -> [a] -> [a]
    take Int
    prefixLen String
    versline String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= String
    versionPrefix) (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
    errorCHICorrupt String
    fname
                       let versline' :: String
    versline' = Int -> ShowS
    forall a. Int -> [a] -> [a]
    drop Int
    prefixLen String
    versline
                       (String
    major, String
    minor) <- case String -> Maybe (String, String)
    majorMinor String
    versline' of
                                           Maybe (String, String)
    Nothing     -> String -> PreCST SwitchBoard s (String, String)
    forall s a. String -> CST s a
    errorCHICorrupt String
    fname
                                           Just (String, String)
    majMin -> (String, String) -> PreCST SwitchBoard s (String, String)
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String, String)
    majMin

                       (String
    version, String
    _, String
    _) <- PreCST SwitchBoard s (String, String, String)
    forall e s. PreCST e s (String, String, String)
    getId
                       let Just (String
    myMajor, String
    myMinor) = String -> Maybe (String, String)
    majorMinor String
    version
                       Bool -> CST s () -> CST s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (String
    major String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= String
    myMajor Bool -> Bool -> Bool
    || String
    minor String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= String
    myMinor) (CST s () -> CST s ()) -> CST s () -> CST s ()
    forall a b. (a -> b) -> a -> b
    $
                         String -> String -> String -> CST s ()
    forall s a. String -> String -> String -> CST s a
    errorCHIVersion String
    fname
                           (String
    major String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "." String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    minor) (String
    myMajor String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "." String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    myMinor)

                       -- finalize
                       --
                       CST s ()
    forall {s}. CST s ()
    traceInfoOK
                       String -> CST s String
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> CST s String) -> String -> CST s String
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [String]
    chi
                      where
                        traceInfoRead :: String -> CST s ()
    traceInfoRead String
    fname = (Traces -> Bool) -> String -> CST s ()
    forall s. (Traces -> Bool) -> String -> CST s ()
    putTraceStr Traces -> Bool
    tracePhasesSW
                                                (String
    "Attempting to read file `"
                                                 String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    fname String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "'...\n")
                        traceInfoVersion :: CST s ()
    traceInfoVersion    = (Traces -> Bool) -> String -> CST s ()
    forall s. (Traces -> Bool) -> String -> CST s ()
    putTraceStr Traces -> Bool
    tracePhasesSW
                                                (String
    "...checking version `"
                                                 String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    fname String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "'...\n")
                        traceInfoOK :: CST s ()
    traceInfoOK         = (Traces -> Bool) -> String -> CST s ()
    forall s. (Traces -> Bool) -> String -> CST s ()
    putTraceStr Traces -> Bool
    tracePhasesSW
                                                (String
    "...successfully loaded `"
                                                 String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    fname String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "'.\n")
                        findFirst :: [String] -> PreCST e s String -> PreCST e s String
    findFirst []        PreCST e s String
    err =  PreCST e s String
    err
                        findFirst (String
    p:[String]
    aths)  PreCST e s String
    err =  do
                          Bool
    e <- String -> PreCST e s Bool
    forall e s. String -> PreCST e s Bool
    doesFileExistCIO String
    p
                          if Bool
    e then String -> PreCST e s String
    forall a. a -> PreCST e s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    p else [String] -> PreCST e s String -> PreCST e s String
    findFirst [String]
    aths PreCST e s String
    err

    -- given a file name (no suffix) and a CHI file, the information is printed
    -- into that file (EXPORTED)
    --
    --  * the correct suffix will automagically be appended
    --
    dumpCHI                :: String -> String -> CST s ()
    dumpCHI :: forall s. String -> String -> CST s ()
    dumpCHI String
    fname String
    contents  =
      do
        (String
    version, String
    _, String
    _) <- PreCST SwitchBoard s (String, String, String)
    forall e s. PreCST e s (String, String, String)
    getId
        String -> String -> CST s ()
    forall e s. String -> String -> PreCST e s ()
    writeFileCIO (String
    fname String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    chisuffix) (String -> CST s ()) -> String -> CST s ()
    forall a b. (a -> b) -> a -> b
    $
          String
    versionPrefix String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    version String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    contents

    -- extract major and minor number from a version string
    --
    majorMinor      :: String -> Maybe (String, String)
    majorMinor :: String -> Maybe (String, String)
    majorMinor String
    vers  = let (String
    major, String
    rest) = (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '.') String
    vers
                           (String
    minor, String
    _   ) = (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '.') (String -> (String, String)) -> ShowS -> String -> (String, String)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    forall a. HasCallStack => [a] -> [a]
    tail (String -> (String, String)) -> String -> (String, String)
    forall a b. (a -> b) -> a -> b
    $ String
    rest
                       in
                       if String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    rest then Maybe (String, String)
    forall a. Maybe a
    Nothing else (String, String) -> Maybe (String, String)
    forall a. a -> Maybe a
    Just (String
    major, String
    minor)

    -- parsing a CHS token stream
    -- --------------------------

    syntaxExc :: String
    syntaxExc :: String
    syntaxExc  = String
    "syntax"

    -- alternative action in case of a syntax exception
    --
    ifError                :: CST s a -> CST s a -> CST s a
    ifError :: forall s a. CST s a -> CST s a -> CST s a
    ifError CST s a
    action CST s a
    handler  = CST s a
    action 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
    syntaxExc, CST s a -> String -> CST s a
    forall a b. a -> b -> a
    const CST s a
    handler)

    -- raise syntax error exception
    --
    raiseSyntaxError :: CST s a
    raiseSyntaxError :: forall s a. CST s a
    raiseSyntaxError  = String -> String -> PreCST SwitchBoard s a
    forall e s a. String -> String -> PreCST e s a
    throwExc String
    syntaxExc String
    "syntax error"

    -- parse a complete module
    --
    --  * errors are entered into the compiler state
    --
    parseCHSModule        :: Position -> String -> CST s CHSModule
    parseCHSModule :: forall s. Position -> String -> CST s CHSModule
    parseCHSModule Position
    pos String
    cs  = do
                               [CHSToken]
    toks <- String -> Position -> CST s [CHSToken]
    forall s. String -> Position -> CST s [CHSToken]
    lexCHS String
    cs Position
    pos
                               [CHSFrag]
    frags <- [CHSToken] -> CST s [CHSFrag]
    forall s. [CHSToken] -> CST s [CHSFrag]
    parseFrags [CHSToken]
    toks
                               CHSModule -> CST s CHSModule
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([CHSFrag] -> CHSModule
    CHSModule [CHSFrag]
    frags)

    -- parsing of code fragments
    --
    --  * in case of an error, all tokens that are neither Haskell nor control
    --   tokens are skipped; afterwards parsing continues
    --
    --  * when encountering inline-C code we scan forward over all inline-C and
    --   control tokens to avoid turning the control tokens within a sequence of
    --   inline-C into Haskell fragments
    --
    parseFrags      :: [CHSToken] -> CST s [CHSFrag]
    parseFrags :: forall s. [CHSToken] -> CST s [CHSFrag]
    parseFrags [CHSToken]
    toks  = do
                         [CHSToken] -> CST s [CHSFrag]
    forall s. [CHSToken] -> CST s [CHSFrag]
    parseFrags0 [CHSToken]
    toks
                         CST s [CHSFrag] -> CST s [CHSFrag] -> CST s [CHSFrag]
    forall s a. CST s a -> CST s a -> CST s a
    `ifError` [CHSToken] -> CST s [CHSFrag]
    forall s. [CHSToken] -> CST s [CHSFrag]
    contFrags [CHSToken]
    toks
      where
        parseFrags0 :: [CHSToken] -> CST s [CHSFrag]
        parseFrags0 :: forall s. [CHSToken] -> CST s [CHSFrag]
    parseFrags0 []                         = [CHSFrag] -> PreCST SwitchBoard s [CHSFrag]
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
        parseFrags0 (CHSTokHaskell Position
    pos String
    s:[CHSToken]
    toks) = do
                                                   [CHSFrag]
    frags <- [CHSToken] -> PreCST SwitchBoard s [CHSFrag]
    forall s. [CHSToken] -> CST s [CHSFrag]
    parseFrags [CHSToken]
    toks
                                                   [CHSFrag] -> PreCST SwitchBoard s [CHSFrag]
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([CHSFrag] -> PreCST SwitchBoard s [CHSFrag])
    -> [CHSFrag] -> PreCST SwitchBoard s [CHSFrag]
    forall a b. (a -> b) -> a -> b
    $ String -> Position -> CHSFrag
    CHSVerb String
    s Position
    pos CHSFrag -> [CHSFrag] -> [CHSFrag]
    forall a. a -> [a] -> [a]
    : [CHSFrag]
    frags
        parseFrags0 (CHSTokCtrl    Position
    pos Char
    c:[CHSToken]
    toks) = do
                                                   [CHSFrag]
    frags <- [CHSToken] -> PreCST SwitchBoard s [CHSFrag]
    forall s. [CHSToken] -> CST s [CHSFrag]
    parseFrags [CHSToken]
    toks
                                                   [CHSFrag] -> PreCST SwitchBoard s [CHSFrag]
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([CHSFrag] -> PreCST SwitchBoard s [CHSFrag])
    -> [CHSFrag] -> PreCST SwitchBoard s [CHSFrag]
    forall a b. (a -> b) -> a -> b
    $ String -> Position -> CHSFrag
    CHSVerb [Char
    c] Position
    pos CHSFrag -> [CHSFrag] -> [CHSFrag]
    forall a. a -> [a] -> [a]
    : [CHSFrag]
    frags
        parseFrags0 (CHSTokCPP     Position
    pos String
    s:[CHSToken]
    toks) = do
                                                   [CHSFrag]
    frags <- [CHSToken] -> PreCST SwitchBoard s [CHSFrag]
    forall s. [CHSToken] -> CST s [CHSFrag]
    parseFrags [CHSToken]
    toks
                                                   [CHSFrag] -> PreCST SwitchBoard s [CHSFrag]
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([CHSFrag] -> PreCST SwitchBoard s [CHSFrag])
    -> [CHSFrag] -> PreCST SwitchBoard s [CHSFrag]
    forall a b. (a -> b) -> a -> b
    $ String -> Position -> CHSFrag
    CHSCPP String
    s Position
    pos CHSFrag -> [CHSFrag] -> [CHSFrag]
    forall a. a -> [a] -> [a]
    : [CHSFrag]
    frags
        parseFrags0 (CHSTokLine    Position
    pos  :[CHSToken]
    toks) = do
                                                   [CHSFrag]
    frags <- [CHSToken] -> PreCST SwitchBoard s [CHSFrag]
    forall s. [CHSToken] -> CST s [CHSFrag]
    parseFrags [CHSToken]
    toks
                                                   [CHSFrag] -> PreCST SwitchBoard s [CHSFrag]
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([CHSFrag] -> PreCST SwitchBoard s [CHSFrag])
    -> [CHSFrag] -> PreCST SwitchBoard s [CHSFrag]
    forall a b. (a -> b) -> a -> b
    $ Position -> CHSFrag
    CHSLine Position
    pos CHSFrag -> [CHSFrag] -> [CHSFrag]
    forall a. a -> [a] -> [a]
    : [CHSFrag]
    frags
        parseFrags0 (CHSTokC       Position
    pos String
    s:[CHSToken]
    toks) = Position -> String -> [CHSToken] -> PreCST SwitchBoard s [CHSFrag]
    forall s. Position -> String -> [CHSToken] -> CST s [CHSFrag]
    parseC       Position
    pos String
    s      [CHSToken]
    toks
        parseFrags0 (CHSTokImport  Position
    pos  :[CHSToken]
    toks) = Position -> [CHSToken] -> PreCST SwitchBoard s [CHSFrag]
    forall s. Position -> [CHSToken] -> CST s [CHSFrag]
    parseImport  Position
    pos        [CHSToken]
    toks
        parseFrags0 (CHSTokContext Position
    pos  :[CHSToken]
    toks) = Position -> [CHSToken] -> PreCST SwitchBoard s [CHSFrag]
    forall s. Position -> [CHSToken] -> CST s [CHSFrag]
    parseContext Position
    pos        [CHSToken]
    toks
        parseFrags0 (CHSTokType    Position
    pos  :[CHSToken]
    toks) = Position -> [CHSToken] -> PreCST SwitchBoard s [CHSFrag]
    forall s. Position -> [CHSToken] -> CST s [CHSFrag]
    parseType    Position
    pos        [CHSToken]
    toks
        parseFrags0 (CHSTokSizeof  Position
    pos  :[CHSToken]
    toks) = Position -> [CHSToken] -> PreCST SwitchBoard s [CHSFrag]
    forall s. Position -> [CHSToken] -> CST s [CHSFrag]
    parseSizeof  Position
    pos        [CHSToken]
    toks
        parseFrags0 (CHSTokEnum    Position
    pos  :[CHSToken]
    toks) = Position -> [CHSToken] -> PreCST SwitchBoard s [CHSFrag]
    forall s. Position -> [CHSToken] -> CST s [CHSFrag]
    parseEnum    Position
    pos        [CHSToken]
    toks
        parseFrags0 (CHSTokCall    Position
    pos  :[CHSToken]
    toks) = Position -> [CHSToken] -> PreCST SwitchBoard s [CHSFrag]
    forall s. Position -> [CHSToken] -> CST s [CHSFrag]
    parseCall    Position
    pos        [CHSToken]
    toks
        parseFrags0 (CHSTokFun     Position
    pos  :[CHSToken]
    toks) = Position -> [CHSToken] -> PreCST SwitchBoard s [CHSFrag]
    forall s. Position -> [CHSToken] -> CST s [CHSFrag]
    parseFun     Position
    pos        [CHSToken]
    toks
        parseFrags0 (CHSTokGet     Position
    pos  :[CHSToken]
    toks) = Position
    -> CHSAccess -> [CHSToken] -> PreCST SwitchBoard s [CHSFrag]
    forall s. Position -> CHSAccess -> [CHSToken] -> CST s [CHSFrag]
    parseField   Position
    pos CHSAccess
    CHSGet [CHSToken]
    toks
        parseFrags0 (CHSTokSet     Position
    pos  :[CHSToken]
    toks) = Position
    -> CHSAccess -> [CHSToken] -> PreCST SwitchBoard s [CHSFrag]
    forall s. Position -> CHSAccess -> [CHSToken] -> CST s [CHSFrag]
    parseField   Position
    pos CHSAccess
    CHSSet [CHSToken]
    toks
        parseFrags0 (CHSTokClass   Position
    pos  :[CHSToken]
    toks) = Position -> [CHSToken] -> PreCST SwitchBoard s [CHSFrag]
    forall s. Position -> [CHSToken] -> CST s [CHSFrag]
    parseClass   Position
    pos        [CHSToken]
    toks
        parseFrags0 (CHSTokPointer Position
    pos  :[CHSToken]
    toks) = Position -> [CHSToken] -> PreCST SwitchBoard s [CHSFrag]
    forall s. Position -> [CHSToken] -> CST s [CHSFrag]
    parsePointer Position
    pos        [CHSToken]
    toks
        parseFrags0 (CHSTokPragma  Position
    pos  :[CHSToken]
    toks) = Position -> [CHSToken] -> PreCST SwitchBoard s [CHSFrag]
    forall s. Position -> [CHSToken] -> CST s [CHSFrag]
    parsePragma  Position
    pos        [CHSToken]
    toks
        parseFrags0 [CHSToken]
    toks                       = [CHSToken] -> PreCST SwitchBoard s [CHSFrag]
    forall s a. [CHSToken] -> CST s a
    syntaxError [CHSToken]
    toks
        --
        -- skip to next Haskell or control token
        --
        contFrags :: [CHSToken] -> PreCST SwitchBoard s [CHSFrag]
    contFrags      []                       = [CHSFrag] -> PreCST SwitchBoard s [CHSFrag]
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
        contFrags toks :: [CHSToken]
    toks@(CHSTokHaskell Position
    _ String
    _:[CHSToken]
    _   ) = [CHSToken] -> PreCST SwitchBoard s [CHSFrag]
    forall s. [CHSToken] -> CST s [CHSFrag]
    parseFrags [CHSToken]
    toks
        contFrags toks :: [CHSToken]
    toks@(CHSTokCtrl    Position
    _ Char
    _:[CHSToken]
    _   ) = [CHSToken] -> PreCST SwitchBoard s [CHSFrag]
    forall s. [CHSToken] -> CST s [CHSFrag]
    parseFrags [CHSToken]
    toks
        contFrags      (CHSToken
    _                :[CHSToken]
    toks) = [CHSToken] -> PreCST SwitchBoard s [CHSFrag]
    contFrags  [CHSToken]
    toks

    parseC :: Position -> String -> [CHSToken] -> CST s [CHSFrag]
    parseC :: forall s. Position -> String -> [CHSToken] -> CST s [CHSFrag]
    parseC Position
    pos String
    s [CHSToken]
    toks =
      do
        [CHSFrag]
    frags <- [CHSToken] -> CST s [CHSFrag]
    forall s. [CHSToken] -> CST s [CHSFrag]
    collectCtrlAndC [CHSToken]
    toks
        [CHSFrag] -> CST s [CHSFrag]
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([CHSFrag] -> CST s [CHSFrag]) -> [CHSFrag] -> CST s [CHSFrag]
    forall a b. (a -> b) -> a -> b
    $ String -> Position -> CHSFrag
    CHSC String
    s Position
    pos CHSFrag -> [CHSFrag] -> [CHSFrag]
    forall a. a -> [a] -> [a]
    : [CHSFrag]
    frags
      where
        collectCtrlAndC :: [CHSToken] -> PreCST SwitchBoard s [CHSFrag]
    collectCtrlAndC (CHSTokCtrl Position
    pos Char
    c:[CHSToken]
    toks) = do
                                                    [CHSFrag]
    frags <- [CHSToken] -> PreCST SwitchBoard s [CHSFrag]
    collectCtrlAndC [CHSToken]
    toks
                                                    [CHSFrag] -> PreCST SwitchBoard s [CHSFrag]
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([CHSFrag] -> PreCST SwitchBoard s [CHSFrag])
    -> [CHSFrag] -> PreCST SwitchBoard s [CHSFrag]
    forall a b. (a -> b) -> a -> b
    $ String -> Position -> CHSFrag
    CHSC [Char
    c] Position
    pos CHSFrag -> [CHSFrag] -> [CHSFrag]
    forall a. a -> [a] -> [a]
    : [CHSFrag]
    frags
        collectCtrlAndC (CHSTokC    Position
    pos String
    s:[CHSToken]
    toks) = do
                                                    [CHSFrag]
    frags <- [CHSToken] -> PreCST SwitchBoard s [CHSFrag]
    collectCtrlAndC [CHSToken]
    toks
                                                    [CHSFrag] -> PreCST SwitchBoard s [CHSFrag]
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([CHSFrag] -> PreCST SwitchBoard s [CHSFrag])
    -> [CHSFrag] -> PreCST SwitchBoard s [CHSFrag]
    forall a b. (a -> b) -> a -> b
    $ String -> Position -> CHSFrag
    CHSC String
    s   Position
    pos CHSFrag -> [CHSFrag] -> [CHSFrag]
    forall a. a -> [a] -> [a]
    : [CHSFrag]
    frags
        collectCtrlAndC [CHSToken]
    toks                    = [CHSToken] -> PreCST SwitchBoard s [CHSFrag]
    forall s. [CHSToken] -> CST s [CHSFrag]
    parseFrags [CHSToken]
    toks

    parseImport :: Position -> [CHSToken] -> CST s [CHSFrag]
    parseImport :: forall s. Position -> [CHSToken] -> CST s [CHSFrag]
    parseImport Position
    pos [CHSToken]
    toks = do
      (Bool
    qual, Ident
    modid, [CHSToken]
    toks') <-
        case [CHSToken]
    toks of
          CHSTokIdent Position
    _ Ident
    ide                :[CHSToken]
    toks ->
            let (Ident
    ide', [CHSToken]
    toks') = Ident -> [CHSToken] -> (Ident, [CHSToken])
    rebuildModuleId Ident
    ide [CHSToken]
    toks
             in (Bool, Ident, [CHSToken])
    -> PreCST SwitchBoard s (Bool, Ident, [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    False, Ident
    ide', [CHSToken]
    toks')
          CHSTokQualif Position
    _: CHSTokIdent Position
    _ Ident
    ide:[CHSToken]
    toks ->
            let (Ident
    ide', [CHSToken]
    toks') = Ident -> [CHSToken] -> (Ident, [CHSToken])
    rebuildModuleId Ident
    ide [CHSToken]
    toks
             in (Bool, Ident, [CHSToken])
    -> PreCST SwitchBoard s (Bool, Ident, [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    True , Ident
    ide', [CHSToken]
    toks')
          [CHSToken]
    _                                      -> [CHSToken] -> PreCST SwitchBoard s (Bool, Ident, [CHSToken])
    forall s a. [CHSToken] -> CST s a
    syntaxError [CHSToken]
    toks
      let fName :: String
    fName = ShowS
    moduleNameToFileName ShowS -> (Ident -> String) -> Ident -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Ident -> String
    identToLexeme (Ident -> String) -> Ident -> String
    forall a b. (a -> b) -> a -> b
    $ Ident
    modid
      [CHSToken]
    toks'' <- [CHSToken] -> CST s [CHSToken]
    forall s. [CHSToken] -> CST s [CHSToken]
    parseEndHook [CHSToken]
    toks'
      [CHSFrag]
    frags <- [CHSToken] -> CST s [CHSFrag]
    forall s. [CHSToken] -> CST s [CHSFrag]
    parseFrags [CHSToken]
    toks''
      [CHSFrag] -> CST s [CHSFrag]
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([CHSFrag] -> CST s [CHSFrag]) -> [CHSFrag] -> CST s [CHSFrag]
    forall a b. (a -> b) -> a -> b
    $ CHSHook -> CHSFrag
    CHSHook (Bool -> Ident -> String -> Position -> CHSHook
    CHSImport Bool
    qual Ident
    modid String
    fName Position
    pos) CHSFrag -> [CHSFrag] -> [CHSFrag]
    forall a. a -> [a] -> [a]
    : [CHSFrag]
    frags

    -- Qualified module names do not get lexed as a single token so we need to
    -- reconstruct it from a sequence of identifer and dot tokens.
    --
    rebuildModuleId :: Ident -> [CHSToken] -> (Ident, [CHSToken])
    rebuildModuleId Ident
    ide (CHSTokDot Position
    _ : CHSTokIdent Position
    _ Ident
    ide' : [CHSToken]
    toks) =
      let catIdent :: Ident -> Ident -> Ident
    catIdent Ident
    ide Ident
    ide' = Position -> String -> Ident
    onlyPosIdent (Ident -> Position
    forall a. Pos a => a -> Position
    posOf Ident
    ide)  --FIXME: unpleasent hack
                                (Ident -> String
    identToLexeme Ident
    ide String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Char
    '.' Char -> ShowS
    forall a. a -> [a] -> [a]
    : Ident -> String
    identToLexeme Ident
    ide')
       in Ident -> [CHSToken] -> (Ident, [CHSToken])
    rebuildModuleId (Ident -> Ident -> Ident
    catIdent Ident
    ide Ident
    ide') [CHSToken]
    toks
    rebuildModuleId Ident
    ide                                     [CHSToken]
    toks  = (Ident
    ide, [CHSToken]
    toks)

    moduleNameToFileName :: String -> FilePath
    moduleNameToFileName :: ShowS
    moduleNameToFileName = (Char -> Char) -> ShowS
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    dotToSlash
      where dotToSlash :: Char -> Char
    dotToSlash Char
    '.' = Char
    '/'
            dotToSlash Char
    c   = Char
    c

    parseContext          :: Position -> [CHSToken] -> CST s [CHSFrag]
    parseContext :: forall s. Position -> [CHSToken] -> CST s [CHSFrag]
    parseContext Position
    pos [CHSToken]
    toks  = do
                               (Maybe String
    olib    , [CHSToken]
    toks ) <- [CHSToken] -> CST s (Maybe String, [CHSToken])
    forall s. [CHSToken] -> CST s (Maybe String, [CHSToken])
    parseOptLib          [CHSToken]
    toks
                               (Maybe String
    opref   , [CHSToken]
    toks)  <- Bool -> [CHSToken] -> CST s (Maybe String, [CHSToken])
    forall s. Bool -> [CHSToken] -> CST s (Maybe String, [CHSToken])
    parseOptPrefix Bool
    False [CHSToken]
    toks
                               (Maybe String
    olock   , [CHSToken]
    toks)  <- [CHSToken] -> CST s (Maybe String, [CHSToken])
    forall s. [CHSToken] -> CST s (Maybe String, [CHSToken])
    parseOptLock         [CHSToken]
    toks
                               [CHSToken]
    toks              <- [CHSToken] -> CST s [CHSToken]
    forall s. [CHSToken] -> CST s [CHSToken]
    parseEndHook         [CHSToken]
    toks
                               [CHSFrag]
    frags             <- [CHSToken] -> CST s [CHSFrag]
    forall s. [CHSToken] -> CST s [CHSFrag]
    parseFrags           [CHSToken]
    toks
                               let frag :: CHSHook
    frag = Maybe String -> Maybe String -> Maybe String -> Position -> CHSHook
    CHSContext Maybe String
    olib Maybe String
    opref Maybe String
    olock Position
    pos
                               [CHSFrag] -> CST s [CHSFrag]
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([CHSFrag] -> CST s [CHSFrag]) -> [CHSFrag] -> CST s [CHSFrag]
    forall a b. (a -> b) -> a -> b
    $ CHSHook -> CHSFrag
    CHSHook CHSHook
    frag CHSFrag -> [CHSFrag] -> [CHSFrag]
    forall a. a -> [a] -> [a]
    : [CHSFrag]
    frags

    parseType :: Position -> [CHSToken] -> CST s [CHSFrag]
    parseType :: forall s. Position -> [CHSToken] -> CST s [CHSFrag]
    parseType Position
    pos (CHSTokIdent Position
    _ Ident
    ide:[CHSToken]
    toks) =
      do
        [CHSToken]
    toks' <- [CHSToken] -> CST s [CHSToken]
    forall s. [CHSToken] -> CST s [CHSToken]
    parseEndHook [CHSToken]
    toks
        [CHSFrag]
    frags <- [CHSToken] -> CST s [CHSFrag]
    forall s. [CHSToken] -> CST s [CHSFrag]
    parseFrags [CHSToken]
    toks'
        [CHSFrag] -> CST s [CHSFrag]
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([CHSFrag] -> CST s [CHSFrag]) -> [CHSFrag] -> CST s [CHSFrag]
    forall a b. (a -> b) -> a -> b
    $ CHSHook -> CHSFrag
    CHSHook (Ident -> Position -> CHSHook
    CHSType Ident
    ide Position
    pos) CHSFrag -> [CHSFrag] -> [CHSFrag]
    forall a. a -> [a] -> [a]
    : [CHSFrag]
    frags
    parseType Position
    _ [CHSToken]
    toks = [CHSToken] -> CST s [CHSFrag]
    forall s a. [CHSToken] -> CST s a
    syntaxError [CHSToken]
    toks

    parseSizeof :: Position -> [CHSToken] -> CST s [CHSFrag]
    parseSizeof :: forall s. Position -> [CHSToken] -> CST s [CHSFrag]
    parseSizeof Position
    pos (CHSTokIdent Position
    _ Ident
    ide:[CHSToken]
    toks) =
      do
        [CHSToken]
    toks' <- [CHSToken] -> CST s [CHSToken]
    forall s. [CHSToken] -> CST s [CHSToken]
    parseEndHook [CHSToken]
    toks
        [CHSFrag]
    frags <- [CHSToken] -> CST s [CHSFrag]
    forall s. [CHSToken] -> CST s [CHSFrag]
    parseFrags [CHSToken]
    toks'
        [CHSFrag] -> CST s [CHSFrag]
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([CHSFrag] -> CST s [CHSFrag]) -> [CHSFrag] -> CST s [CHSFrag]
    forall a b. (a -> b) -> a -> b
    $ CHSHook -> CHSFrag
    CHSHook (Ident -> Position -> CHSHook
    CHSSizeof Ident
    ide Position
    pos) CHSFrag -> [CHSFrag] -> [CHSFrag]
    forall a. a -> [a] -> [a]
    : [CHSFrag]
    frags
    parseSizeof Position
    _ [CHSToken]
    toks = [CHSToken] -> CST s [CHSFrag]
    forall s a. [CHSToken] -> CST s a
    syntaxError [CHSToken]
    toks

    parseEnum :: Position -> [CHSToken] -> CST s [CHSFrag]
    parseEnum :: forall s. Position -> [CHSToken] -> CST s [CHSFrag]
    parseEnum Position
    pos (CHSTokIdent Position
    _ Ident
    ide:[CHSToken]
    toks) =
      do
        (Maybe Ident
    oalias, [CHSToken]
    toks' )   <- Ident -> Bool -> [CHSToken] -> CST s (Maybe Ident, [CHSToken])
    forall s.
    Ident -> Bool -> [CHSToken] -> CST s (Maybe Ident, [CHSToken])
    parseOptAs Ident
    ide Bool
    True [CHSToken]
    toks
        (CHSTrans
    trans , [CHSToken]
    toks'')   <- [CHSToken] -> CST s (CHSTrans, [CHSToken])
    forall s. [CHSToken] -> CST s (CHSTrans, [CHSToken])
    parseTrans          [CHSToken]
    toks'
        (Maybe String
    oprefix, [CHSToken]
    toks''') <- Bool -> [CHSToken] -> CST s (Maybe String, [CHSToken])
    forall s. Bool -> [CHSToken] -> CST s (Maybe String, [CHSToken])
    parseOptPrefix Bool
    True [CHSToken]
    toks''
        ([Ident]
    derive, [CHSToken]
    toks'''') <- [CHSToken] -> CST s ([Ident], [CHSToken])
    forall s. [CHSToken] -> CST s ([Ident], [CHSToken])
    parseDerive         [CHSToken]
    toks'''
        [CHSToken]
    toks'''''          <- [CHSToken] -> CST s [CHSToken]
    forall s. [CHSToken] -> CST s [CHSToken]
    parseEndHook        [CHSToken]
    toks''''
        [CHSFrag]
    frags              <- [CHSToken] -> CST s [CHSFrag]
    forall s. [CHSToken] -> CST s [CHSFrag]
    parseFrags          [CHSToken]
    toks'''''
        [CHSFrag] -> CST s [CHSFrag]
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([CHSFrag] -> CST s [CHSFrag]) -> [CHSFrag] -> CST s [CHSFrag]
    forall a b. (a -> b) -> a -> b
    $ CHSHook -> CHSFrag
    CHSHook (Ident
    -> Maybe Ident
    -> CHSTrans
    -> Maybe String
    -> [Ident]
    -> Position
    -> CHSHook
    CHSEnum Ident
    ide (Maybe Ident -> Maybe Ident
    norm Maybe Ident
    oalias) CHSTrans
    trans Maybe String
    oprefix [Ident]
    derive Position
    pos) CHSFrag -> [CHSFrag] -> [CHSFrag]
    forall a. a -> [a] -> [a]
    : [CHSFrag]
    frags
      where
        norm :: Maybe Ident -> Maybe Ident
    norm Maybe Ident
    Nothing                   = Maybe Ident
    forall a. Maybe a
    Nothing
        norm (Just Ident
    ide') | Ident
    ide Ident -> Ident -> Bool
    forall a. Eq a => a -> a -> Bool
    == Ident
    ide' = Maybe Ident
    forall a. Maybe a
    Nothing
                         | Bool
    otherwise   = Ident -> Maybe Ident
    forall a. a -> Maybe a
    Just Ident
    ide'
    parseEnum Position
    _ [CHSToken]
    toks = [CHSToken] -> CST s [CHSFrag]
    forall s a. [CHSToken] -> CST s a
    syntaxError [CHSToken]
    toks

    parseCall          :: Position -> [CHSToken] -> CST s [CHSFrag]
    parseCall :: forall s. Position -> [CHSToken] -> CST s [CHSFrag]
    parseCall Position
    pos [CHSToken]
    toks  =
      do
        (Bool
    isPure  , [CHSToken]
    toks ) <- [CHSToken] -> CST s (Bool, [CHSToken])
    forall s. [CHSToken] -> CST s (Bool, [CHSToken])
    parseIsPure          [CHSToken]
    toks
        (Bool
    isUnsafe, [CHSToken]
    toks ) <- [CHSToken] -> CST s (Bool, [CHSToken])
    forall s. [CHSToken] -> CST s (Bool, [CHSToken])
    parseIsUnsafe        [CHSToken]
    toks
        (Bool
    isNolock, [CHSToken]
    toks ) <- [CHSToken] -> CST s (Bool, [CHSToken])
    forall s. [CHSToken] -> CST s (Bool, [CHSToken])
    parseIsNolock        [CHSToken]
    toks
        (Ident
    ide     , [CHSToken]
    toks ) <- [CHSToken] -> CST s (Ident, [CHSToken])
    forall s. [CHSToken] -> CST s (Ident, [CHSToken])
    parseIdent           [CHSToken]
    toks
        (Maybe Ident
    oalias  , [CHSToken]
    toks ) <- Ident -> Bool -> [CHSToken] -> CST s (Maybe Ident, [CHSToken])
    forall s.
    Ident -> Bool -> [CHSToken] -> CST s (Maybe Ident, [CHSToken])
    parseOptAs Ident
    ide Bool
    False [CHSToken]
    toks
        [CHSToken]
    toks              <- [CHSToken] -> CST s [CHSToken]
    forall s. [CHSToken] -> CST s [CHSToken]
    parseEndHook         [CHSToken]
    toks
        [CHSFrag]
    frags             <- [CHSToken] -> CST s [CHSFrag]
    forall s. [CHSToken] -> CST s [CHSFrag]
    parseFrags           [CHSToken]
    toks
        [CHSFrag] -> CST s [CHSFrag]
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([CHSFrag] -> CST s [CHSFrag]) -> [CHSFrag] -> CST s [CHSFrag]
    forall a b. (a -> b) -> a -> b
    $
          CHSHook -> CHSFrag
    CHSHook (Bool -> Bool -> Bool -> Ident -> Maybe Ident -> Position -> CHSHook
    CHSCall Bool
    isPure Bool
    isUnsafe Bool
    isNolock Ident
    ide (Ident -> Maybe Ident -> Maybe Ident
    norm Ident
    ide Maybe Ident
    oalias) Position
    pos) CHSFrag -> [CHSFrag] -> [CHSFrag]
    forall a. a -> [a] -> [a]
    : [CHSFrag]
    frags

    parseFun          :: Position -> [CHSToken] -> CST s [CHSFrag]
    parseFun :: forall s. Position -> [CHSToken] -> CST s [CHSFrag]
    parseFun Position
    pos [CHSToken]
    toks  =
      do
        (Bool
    isPure  , [CHSToken]
    toks' ) <- [CHSToken] -> CST s (Bool, [CHSToken])
    forall s. [CHSToken] -> CST s (Bool, [CHSToken])
    parseIsPure          [CHSToken]
    toks
        (Bool
    isUnsafe, [CHSToken]
    toks'2) <- [CHSToken] -> CST s (Bool, [CHSToken])
    forall s. [CHSToken] -> CST s (Bool, [CHSToken])
    parseIsUnsafe        [CHSToken]
    toks'
        (Bool
    isNolock, [CHSToken]
    toks'3) <- [CHSToken] -> CST s (Bool, [CHSToken])
    forall s. [CHSToken] -> CST s (Bool, [CHSToken])
    parseIsNolock        [CHSToken]
    toks'2
        (Ident
    ide     , [CHSToken]
    toks'4) <- [CHSToken] -> CST s (Ident, [CHSToken])
    forall s. [CHSToken] -> CST s (Ident, [CHSToken])
    parseIdent           [CHSToken]
    toks'3
        (Maybe Ident
    oalias  , [CHSToken]
    toks'5) <- Ident -> Bool -> [CHSToken] -> CST s (Maybe Ident, [CHSToken])
    forall s.
    Ident -> Bool -> [CHSToken] -> CST s (Maybe Ident, [CHSToken])
    parseOptAs Ident
    ide Bool
    False [CHSToken]
    toks'4
        (Maybe String
    octxt   , [CHSToken]
    toks'6) <- [CHSToken] -> PreCST SwitchBoard s (Maybe String, [CHSToken])
    forall {m :: * -> *}.
    Monad m =>
    [CHSToken] -> m (Maybe String, [CHSToken])
    parseOptContext      [CHSToken]
    toks'5
        ([CHSParm]
    parms   , [CHSToken]
    toks'7) <- [CHSToken] -> PreCST SwitchBoard s ([CHSParm], [CHSToken])
    forall {s}.
    [CHSToken] -> PreCST SwitchBoard s ([CHSParm], [CHSToken])
    parseParms           [CHSToken]
    toks'6
        (CHSParm
    parm    , [CHSToken]
    toks'8) <- [CHSToken] -> CST s (CHSParm, [CHSToken])
    forall s. [CHSToken] -> CST s (CHSParm, [CHSToken])
    parseParm            [CHSToken]
    toks'7
        [CHSToken]
    toks'9             <- [CHSToken] -> CST s [CHSToken]
    forall s. [CHSToken] -> CST s [CHSToken]
    parseEndHook         [CHSToken]
    toks'8
        [CHSFrag]
    frags              <- [CHSToken] -> CST s [CHSFrag]
    forall s. [CHSToken] -> CST s [CHSFrag]
    parseFrags           [CHSToken]
    toks'9
        [CHSFrag] -> CST s [CHSFrag]
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([CHSFrag] -> CST s [CHSFrag]) -> [CHSFrag] -> CST s [CHSFrag]
    forall a b. (a -> b) -> a -> b
    $
          CHSHook -> CHSFrag
    CHSHook
            (Bool
    -> Bool
    -> Bool
    -> Ident
    -> Maybe Ident
    -> Maybe String
    -> [CHSParm]
    -> CHSParm
    -> Position
    -> CHSHook
    CHSFun Bool
    isPure Bool
    isUnsafe Bool
    isNolock Ident
    ide (Ident -> Maybe Ident -> Maybe Ident
    norm Ident
    ide Maybe Ident
    oalias) Maybe String
    octxt [CHSParm]
    parms CHSParm
    parm Position
    pos) CHSFrag -> [CHSFrag] -> [CHSFrag]
    forall a. a -> [a] -> [a]
    :
          [CHSFrag]
    frags
      where
        parseOptContext :: [CHSToken] -> m (Maybe String, [CHSToken])
    parseOptContext (CHSTokHSVerb Position
    _ String
    ctxt:CHSTokDArrow Position
    _:[CHSToken]
    toks) =
          (Maybe String, [CHSToken]) -> m (Maybe String, [CHSToken])
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    ctxt, [CHSToken]
    toks)
        parseOptContext [CHSToken]
    toks                                      =
          (Maybe String, [CHSToken]) -> m (Maybe String, [CHSToken])
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe String
    forall a. Maybe a
    Nothing  , [CHSToken]
    toks)
        --
        parseParms :: [CHSToken] -> PreCST SwitchBoard s ([CHSParm], [CHSToken])
    parseParms (CHSTokLBrace Position
    _:CHSTokRBrace Position
    _:CHSTokArrow Position
    _:[CHSToken]
    toks) =
          ([CHSParm], [CHSToken])
    -> PreCST SwitchBoard s ([CHSParm], [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([], [CHSToken]
    toks)
        parseParms (CHSTokLBrace Position
    _                             :[CHSToken]
    toks) =
          [CHSToken] -> PreCST SwitchBoard s ([CHSParm], [CHSToken])
    forall {s}.
    [CHSToken] -> PreCST SwitchBoard s ([CHSParm], [CHSToken])
    parseParms' (Position -> CHSToken
    CHSTokComma Position
    noposCHSToken -> [CHSToken] -> [CHSToken]
    forall a. a -> [a] -> [a]
    :[CHSToken]
    toks)
        parseParms                                              [CHSToken]
    toks  =
          [CHSToken] -> PreCST SwitchBoard s ([CHSParm], [CHSToken])
    forall s a. [CHSToken] -> CST s a
    syntaxError [CHSToken]
    toks
        --
        parseParms' :: [CHSToken] -> PreCST SwitchBoard s ([CHSParm], [CHSToken])
    parseParms' (CHSTokRBrace Position
    _:CHSTokArrow Position
    _:[CHSToken]
    toks) = ([CHSParm], [CHSToken])
    -> PreCST SwitchBoard s ([CHSParm], [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([], [CHSToken]
    toks)
        parseParms' (CHSTokComma Position
    _               :[CHSToken]
    toks) = do
          (CHSParm
    parm , [CHSToken]
    toks' ) <- [CHSToken] -> CST s (CHSParm, [CHSToken])
    forall s. [CHSToken] -> CST s (CHSParm, [CHSToken])
    parseParm   [CHSToken]
    toks
          ([CHSParm]
    parms, [CHSToken]
    toks'') <- [CHSToken] -> PreCST SwitchBoard s ([CHSParm], [CHSToken])
    parseParms' [CHSToken]
    toks'
          ([CHSParm], [CHSToken])
    -> PreCST SwitchBoard s ([CHSParm], [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CHSParm
    parmCHSParm -> [CHSParm] -> [CHSParm]
    forall a. a -> [a] -> [a]
    :[CHSParm]
    parms, [CHSToken]
    toks'')
        parseParms' (CHSTokRBrace Position
    _              :[CHSToken]
    toks) = [CHSToken] -> PreCST SwitchBoard s ([CHSParm], [CHSToken])
    forall s a. [CHSToken] -> CST s a
    syntaxError [CHSToken]
    toks
          -- gives better error messages
        parseParms'                               [CHSToken]
    toks  = [CHSToken] -> PreCST SwitchBoard s ([CHSParm], [CHSToken])
    forall s a. [CHSToken] -> CST s a
    syntaxError [CHSToken]
    toks

    parseIsPure :: [CHSToken] -> CST s (Bool, [CHSToken])
    parseIsPure :: forall s. [CHSToken] -> CST s (Bool, [CHSToken])
    parseIsPure (CHSTokPure Position
    _:[CHSToken]
    toks) = (Bool, [CHSToken]) -> PreCST SwitchBoard s (Bool, [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    True , [CHSToken]
    toks)
    parseIsPure (CHSTokFun  Position
    _:[CHSToken]
    toks) = (Bool, [CHSToken]) -> PreCST SwitchBoard s (Bool, [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    True , [CHSToken]
    toks)  -- backwards compat.
    parseIsPure [CHSToken]
    toks                = (Bool, [CHSToken]) -> PreCST SwitchBoard s (Bool, [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    False, [CHSToken]
    toks)
    -- FIXME: eventually, remove `fun'; it's currently deprecated

    parseIsUnsafe :: [CHSToken] -> CST s (Bool, [CHSToken])
    parseIsUnsafe :: forall s. [CHSToken] -> CST s (Bool, [CHSToken])
    parseIsUnsafe (CHSTokUnsafe Position
    _:[CHSToken]
    toks) = (Bool, [CHSToken]) -> PreCST SwitchBoard s (Bool, [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    True , [CHSToken]
    toks)
    parseIsUnsafe [CHSToken]
    toks                  = (Bool, [CHSToken]) -> PreCST SwitchBoard s (Bool, [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    False, [CHSToken]
    toks)

    parseIsNolock :: [CHSToken] -> CST s (Bool, [CHSToken])
    parseIsNolock :: forall s. [CHSToken] -> CST s (Bool, [CHSToken])
    parseIsNolock (CHSTokNolock Position
    _:[CHSToken]
    toks) = (Bool, [CHSToken]) -> PreCST SwitchBoard s (Bool, [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    True , [CHSToken]
    toks)
    parseIsNolock [CHSToken]
    toks                  = (Bool, [CHSToken]) -> PreCST SwitchBoard s (Bool, [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    False, [CHSToken]
    toks)

    norm :: Ident -> Maybe Ident -> Maybe Ident
    norm :: Ident -> Maybe Ident -> Maybe Ident
    norm Ident
    ide Maybe Ident
    Nothing                   = Maybe Ident
    forall a. Maybe a
    Nothing
    norm Ident
    ide (Just Ident
    ide') | Ident
    ide Ident -> Ident -> Bool
    forall a. Eq a => a -> a -> Bool
    == Ident
    ide' = Maybe Ident
    forall a. Maybe a
    Nothing
                         | Bool
    otherwise   = Ident -> Maybe Ident
    forall a. a -> Maybe a
    Just Ident
    ide'

    parseParm :: [CHSToken] -> CST s (CHSParm, [CHSToken])
    parseParm :: forall s. [CHSToken] -> CST s (CHSParm, [CHSToken])
    parseParm [CHSToken]
    toks =
      do
        (Maybe (Ident, CHSArg)
    oimMarsh, [CHSToken]
    toks' ) <- [CHSToken] -> CST s (Maybe (Ident, CHSArg), [CHSToken])
    forall s. [CHSToken] -> CST s (Maybe (Ident, CHSArg), [CHSToken])
    parseOptMarsh [CHSToken]
    toks
        (String
    hsTyStr, Bool
    twoCVals, Position
    pos, [CHSToken]
    toks'2) <-
          case [CHSToken]
    toks' of
            (CHSTokHSVerb Position
    pos String
    hsTyStr:CHSTokAmp Position
    _:[CHSToken]
    toks'2) ->
              (String, Bool, Position, [CHSToken])
    -> PreCST SwitchBoard s (String, Bool, Position, [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String
    hsTyStr, Bool
    True , Position
    pos, [CHSToken]
    toks'2)
            (CHSTokHSVerb Position
    pos String
    hsTyStr            :[CHSToken]
    toks'2) ->
              (String, Bool, Position, [CHSToken])
    -> PreCST SwitchBoard s (String, Bool, Position, [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String
    hsTyStr, Bool
    False, Position
    pos, [CHSToken]
    toks'2)
            [CHSToken]
    toks                                          -> [CHSToken]
    -> PreCST SwitchBoard s (String, Bool, Position, [CHSToken])
    forall s a. [CHSToken] -> CST s a
    syntaxError [CHSToken]
    toks
        (Maybe (Ident, CHSArg)
    oomMarsh, [CHSToken]
    toks'3) <- [CHSToken] -> CST s (Maybe (Ident, CHSArg), [CHSToken])
    forall s. [CHSToken] -> CST s (Maybe (Ident, CHSArg), [CHSToken])
    parseOptMarsh [CHSToken]
    toks'2
        (CHSParm, [CHSToken]) -> CST s (CHSParm, [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (Ident, CHSArg)
    -> String -> Bool -> Maybe (Ident, CHSArg) -> Position -> CHSParm
    CHSParm Maybe (Ident, CHSArg)
    oimMarsh String
    hsTyStr Bool
    twoCVals Maybe (Ident, CHSArg)
    oomMarsh Position
    pos, [CHSToken]
    toks'3)
      where
        parseOptMarsh :: [CHSToken] -> CST s (Maybe (Ident, CHSArg), [CHSToken])
        parseOptMarsh :: forall s. [CHSToken] -> CST s (Maybe (Ident, CHSArg), [CHSToken])
    parseOptMarsh (CHSTokIdent Position
    _ Ident
    ide:CHSTokStar Position
    _ :[CHSToken]
    toks) =
          (Maybe (Ident, CHSArg), [CHSToken])
    -> PreCST SwitchBoard s (Maybe (Ident, CHSArg), [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Ident, CHSArg) -> Maybe (Ident, CHSArg)
    forall a. a -> Maybe a
    Just (Ident
    ide, CHSArg
    CHSIOArg) , [CHSToken]
    toks)
        parseOptMarsh (CHSTokIdent Position
    _ Ident
    ide:CHSTokMinus Position
    _:[CHSToken]
    toks) =
          (Maybe (Ident, CHSArg), [CHSToken])
    -> PreCST SwitchBoard s (Maybe (Ident, CHSArg), [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Ident, CHSArg) -> Maybe (Ident, CHSArg)
    forall a. a -> Maybe a
    Just (Ident
    ide, CHSArg
    CHSVoidArg), [CHSToken]
    toks)
        parseOptMarsh (CHSTokIdent Position
    _ Ident
    ide              :[CHSToken]
    toks) =
          (Maybe (Ident, CHSArg), [CHSToken])
    -> PreCST SwitchBoard s (Maybe (Ident, CHSArg), [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Ident, CHSArg) -> Maybe (Ident, CHSArg)
    forall a. a -> Maybe a
    Just (Ident
    ide, CHSArg
    CHSValArg) , [CHSToken]
    toks)
        parseOptMarsh [CHSToken]
    toks                                   =
          (Maybe (Ident, CHSArg), [CHSToken])
    -> PreCST SwitchBoard s (Maybe (Ident, CHSArg), [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (Ident, CHSArg)
    forall a. Maybe a
    Nothing, [CHSToken]
    toks)

    parseField :: Position -> CHSAccess -> [CHSToken] -> CST s [CHSFrag]
    parseField :: forall s. Position -> CHSAccess -> [CHSToken] -> CST s [CHSFrag]
    parseField Position
    pos CHSAccess
    access [CHSToken]
    toks =
      do
        (CHSAPath
    path, [CHSToken]
    toks') <- [CHSToken] -> CST s (CHSAPath, [CHSToken])
    forall s. [CHSToken] -> CST s (CHSAPath, [CHSToken])
    parsePath  [CHSToken]
    toks
        [CHSFrag]
    frags         <- [CHSToken] -> CST s [CHSFrag]
    forall s. [CHSToken] -> CST s [CHSFrag]
    parseFrags [CHSToken]
    toks'
        [CHSFrag] -> CST s [CHSFrag]
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([CHSFrag] -> CST s [CHSFrag]) -> [CHSFrag] -> CST s [CHSFrag]
    forall a b. (a -> b) -> a -> b
    $ CHSHook -> CHSFrag
    CHSHook (CHSAccess -> CHSAPath -> Position -> CHSHook
    CHSField CHSAccess
    access CHSAPath
    path Position
    pos) CHSFrag -> [CHSFrag] -> [CHSFrag]
    forall a. a -> [a] -> [a]
    : [CHSFrag]
    frags

    parsePointer :: Position -> [CHSToken] -> CST s [CHSFrag]
    parsePointer :: forall s. Position -> [CHSToken] -> CST s [CHSFrag]
    parsePointer Position
    pos [CHSToken]
    toks =
      do
        (Bool
    isStar, Ident
    ide, [CHSToken]
    toks')          <-
          case [CHSToken]
    toks of
            CHSTokStar Position
    _:CHSTokIdent Position
    _ Ident
    ide:[CHSToken]
    toks' -> (Bool, Ident, [CHSToken])
    -> PreCST SwitchBoard s (Bool, Ident, [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    True , Ident
    ide, [CHSToken]
    toks')
            CHSTokIdent Position
    _ Ident
    ide             :[CHSToken]
    toks' -> (Bool, Ident, [CHSToken])
    -> PreCST SwitchBoard s (Bool, Ident, [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    False, Ident
    ide, [CHSToken]
    toks')
            [CHSToken]
    _                                    -> [CHSToken] -> PreCST SwitchBoard s (Bool, Ident, [CHSToken])
    forall s a. [CHSToken] -> CST s a
    syntaxError [CHSToken]
    toks
        (Maybe Ident
    oalias , [CHSToken]
    toks'2)             <- Ident -> Bool -> [CHSToken] -> CST s (Maybe Ident, [CHSToken])
    forall s.
    Ident -> Bool -> [CHSToken] -> CST s (Maybe Ident, [CHSToken])
    parseOptAs Ident
    ide Bool
    True [CHSToken]
    toks'
        (CHSPtrType
    ptrType, [CHSToken]
    toks'3)             <- [CHSToken] -> CST s (CHSPtrType, [CHSToken])
    forall s. [CHSToken] -> CST s (CHSPtrType, [CHSToken])
    parsePtrType        [CHSToken]
    toks'2
        let
         (Bool
    isNewtype, Maybe Ident
    oRefType, [CHSToken]
    toks'4) =
          case [CHSToken]
    toks'3 of
            CHSTokNewtype Position
    _                  :[CHSToken]
    toks' -> (Bool
    True , Maybe Ident
    forall a. Maybe a
    Nothing , [CHSToken]
    toks' )
            CHSTokArrow   Position
    _:CHSTokIdent Position
    _ Ident
    ide:[CHSToken]
    toks' -> (Bool
    False, Ident -> Maybe Ident
    forall a. a -> Maybe a
    Just Ident
    ide, [CHSToken]
    toks' )
            [CHSToken]
    _                                       -> (Bool
    False, Maybe Ident
    forall a. Maybe a
    Nothing , [CHSToken]
    toks'3)
        [CHSToken]
    toks'5                        <- [CHSToken] -> CST s [CHSToken]
    forall s. [CHSToken] -> CST s [CHSToken]
    parseEndHook [CHSToken]
    toks'4
        [CHSFrag]
    frags                         <- [CHSToken] -> CST s [CHSFrag]
    forall s. [CHSToken] -> CST s [CHSFrag]
    parseFrags   [CHSToken]
    toks'5
        [CHSFrag] -> CST s [CHSFrag]
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([CHSFrag] -> CST s [CHSFrag]) -> [CHSFrag] -> CST s [CHSFrag]
    forall a b. (a -> b) -> a -> b
    $
          CHSHook -> CHSFrag
    CHSHook
           (Bool
    -> Ident
    -> Maybe Ident
    -> CHSPtrType
    -> Bool
    -> Maybe Ident
    -> Position
    -> CHSHook
    CHSPointer Bool
    isStar Ident
    ide (Ident -> Maybe Ident -> Maybe Ident
    forall {a}. Eq a => a -> Maybe a -> Maybe a
    norm Ident
    ide Maybe Ident
    oalias) CHSPtrType
    ptrType Bool
    isNewtype Maybe Ident
    oRefType Position
    pos)
           CHSFrag -> [CHSFrag] -> [CHSFrag]
    forall a. a -> [a] -> [a]
    : [CHSFrag]
    frags
      where
        parsePtrType :: [CHSToken] -> CST s (CHSPtrType, [CHSToken])
        parsePtrType :: forall s. [CHSToken] -> CST s (CHSPtrType, [CHSToken])
    parsePtrType (CHSTokForeign Position
    _:[CHSToken]
    toks) = (CHSPtrType, [CHSToken])
    -> PreCST SwitchBoard s (CHSPtrType, [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CHSPtrType
    CHSForeignPtr, [CHSToken]
    toks)
        parsePtrType (CHSTokStable Position
    _ :[CHSToken]
    toks) = (CHSPtrType, [CHSToken])
    -> PreCST SwitchBoard s (CHSPtrType, [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CHSPtrType
    CHSStablePtr, [CHSToken]
    toks)
        parsePtrType                  [CHSToken]
    toks  = (CHSPtrType, [CHSToken])
    -> PreCST SwitchBoard s (CHSPtrType, [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CHSPtrType
    CHSPtr, [CHSToken]
    toks)

        norm :: a -> Maybe a -> Maybe a
    norm a
    ide Maybe a
    Nothing                   = Maybe a
    forall a. Maybe a
    Nothing
        norm a
    ide (Just a
    ide') | a
    ide a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    ide' = Maybe a
    forall a. Maybe a
    Nothing
                             | Bool
    otherwise   = a -> Maybe a
    forall a. a -> Maybe a
    Just a
    ide'

    parsePragma :: Position -> [CHSToken] -> CST s [CHSFrag]
    parsePragma :: forall s. Position -> [CHSToken] -> CST s [CHSFrag]
    parsePragma Position
    pos [CHSToken]
    toks = do
      let
        parseExts :: [String]
    -> [CHSToken] -> PreCST SwitchBoard s ([String], [CHSToken])
    parseExts [String]
    exts (CHSTokIdent Position
    _ Ident
    ide:CHSTokComma Position
    _:[CHSToken]
    toks) =
          [String]
    -> [CHSToken] -> PreCST SwitchBoard s ([String], [CHSToken])
    parseExts (Ident -> String
    identToLexeme Ident
    ideString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    exts) [CHSToken]
    toks
        parseExts [String]
    exts (CHSTokIdent Position
    _ Ident
    ide:CHSTokPragEnd Position
    _:[CHSToken]
    toks) =
          ([String], [CHSToken])
    -> PreCST SwitchBoard s ([String], [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([String] -> [String]
    forall a. [a] -> [a]
    reverse (Ident -> String
    identToLexeme Ident
    ideString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    exts), [CHSToken]
    toks)
        parseExts [String]
    exts [CHSToken]
    toks = [CHSToken] -> PreCST SwitchBoard s ([String], [CHSToken])
    forall s a. [CHSToken] -> CST s a
    syntaxError [CHSToken]
    toks
      ([String]
    exts, [CHSToken]
    toks) <- [String]
    -> [CHSToken] -> PreCST SwitchBoard s ([String], [CHSToken])
    forall {s}.
    [String]
    -> [CHSToken] -> PreCST SwitchBoard s ([String], [CHSToken])
    parseExts [] [CHSToken]
    toks
      [CHSFrag]
    frags <- [CHSToken] -> CST s [CHSFrag]
    forall s. [CHSToken] -> CST s [CHSFrag]
    parseFrags [CHSToken]
    toks
      [CHSFrag] -> CST s [CHSFrag]
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([String] -> Position -> CHSFrag
    CHSLang [String]
    exts Position
    pos CHSFrag -> [CHSFrag] -> [CHSFrag]
    forall a. a -> [a] -> [a]
    : [CHSFrag]
    frags)

    parseClass :: Position -> [CHSToken] -> CST s [CHSFrag]
    parseClass :: forall s. Position -> [CHSToken] -> CST s [CHSFrag]
    parseClass Position
    pos (CHSTokIdent  Position
    _ Ident
    sclassIde:
                    CHSTokDArrow Position
    _          :
                    CHSTokIdent  Position
    _ Ident
    classIde :
                    CHSTokIdent  Position
    _ Ident
    typeIde  :
                    [CHSToken]
    toks)                     =
      do
        [CHSToken]
    toks' <- [CHSToken] -> CST s [CHSToken]
    forall s. [CHSToken] -> CST s [CHSToken]
    parseEndHook [CHSToken]
    toks
        [CHSFrag]
    frags <- [CHSToken] -> CST s [CHSFrag]
    forall s. [CHSToken] -> CST s [CHSFrag]
    parseFrags [CHSToken]
    toks'
        [CHSFrag] -> CST s [CHSFrag]
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([CHSFrag] -> CST s [CHSFrag]) -> [CHSFrag] -> CST s [CHSFrag]
    forall a b. (a -> b) -> a -> b
    $ CHSHook -> CHSFrag
    CHSHook (Maybe Ident -> Ident -> Ident -> Position -> CHSHook
    CHSClass (Ident -> Maybe Ident
    forall a. a -> Maybe a
    Just Ident
    sclassIde) Ident
    classIde Ident
    typeIde Position
    pos) CHSFrag -> [CHSFrag] -> [CHSFrag]
    forall a. a -> [a] -> [a]
    : [CHSFrag]
    frags
    parseClass Position
    pos (CHSTokIdent Position
    _ Ident
    classIde :
                    CHSTokIdent Position
    _ Ident
    typeIde  :
                    [CHSToken]
    toks)                     =
      do
        [CHSToken]
    toks' <- [CHSToken] -> CST s [CHSToken]
    forall s. [CHSToken] -> CST s [CHSToken]
    parseEndHook [CHSToken]
    toks
        [CHSFrag]
    frags <- [CHSToken] -> CST s [CHSFrag]
    forall s. [CHSToken] -> CST s [CHSFrag]
    parseFrags [CHSToken]
    toks'
        [CHSFrag] -> CST s [CHSFrag]
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([CHSFrag] -> CST s [CHSFrag]) -> [CHSFrag] -> CST s [CHSFrag]
    forall a b. (a -> b) -> a -> b
    $ CHSHook -> CHSFrag
    CHSHook (Maybe Ident -> Ident -> Ident -> Position -> CHSHook
    CHSClass Maybe Ident
    forall a. Maybe a
    Nothing Ident
    classIde Ident
    typeIde Position
    pos) CHSFrag -> [CHSFrag] -> [CHSFrag]
    forall a. a -> [a] -> [a]
    : [CHSFrag]
    frags
    parseClass Position
    _ [CHSToken]
    toks = [CHSToken] -> CST s [CHSFrag]
    forall s a. [CHSToken] -> CST s a
    syntaxError [CHSToken]
    toks

    parseOptLib :: [CHSToken] -> CST s (Maybe String, [CHSToken])
    parseOptLib :: forall s. [CHSToken] -> CST s (Maybe String, [CHSToken])
    parseOptLib (CHSTokLib    Position
    _    :
                 CHSTokEqual  Position
    _    :
                 CHSTokString Position
    _ String
    str:
                 [CHSToken]
    toks)                = (Maybe String, [CHSToken])
    -> PreCST SwitchBoard s (Maybe String, [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    str, [CHSToken]
    toks)
    parseOptLib (CHSTokLib Position
    _:[CHSToken]
    toks   ) = [CHSToken] -> PreCST SwitchBoard s (Maybe String, [CHSToken])
    forall s a. [CHSToken] -> CST s a
    syntaxError [CHSToken]
    toks
    parseOptLib [CHSToken]
    toks                  = (Maybe String, [CHSToken])
    -> PreCST SwitchBoard s (Maybe String, [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe String
    forall a. Maybe a
    Nothing, [CHSToken]
    toks)

    parseOptLock :: [CHSToken] -> CST s (Maybe String, [CHSToken])
    parseOptLock :: forall s. [CHSToken] -> CST s (Maybe String, [CHSToken])
    parseOptLock (CHSTokLock   Position
    _    :
                  CHSTokEqual  Position
    _    :
                  CHSTokString Position
    _ String
    str:
                  [CHSToken]
    toks)               = (Maybe String, [CHSToken])
    -> PreCST SwitchBoard s (Maybe String, [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    str, [CHSToken]
    toks)
    parseOptLock (CHSTokLock Position
    _:[CHSToken]
    toks ) = [CHSToken] -> PreCST SwitchBoard s (Maybe String, [CHSToken])
    forall s a. [CHSToken] -> CST s a
    syntaxError [CHSToken]
    toks
    parseOptLock [CHSToken]
    toks                 = (Maybe String, [CHSToken])
    -> PreCST SwitchBoard s (Maybe String, [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe String
    forall a. Maybe a
    Nothing, [CHSToken]
    toks)

    parseOptPrefix :: Bool -> [CHSToken] -> CST s (Maybe String, [CHSToken])
    parseOptPrefix :: forall s. Bool -> [CHSToken] -> CST s (Maybe String, [CHSToken])
    parseOptPrefix Bool
    False (CHSTokPrefix Position
    _    :
                          CHSTokEqual  Position
    _    :
                          CHSTokString Position
    _ String
    str:
                          [CHSToken]
    toks)                = (Maybe String, [CHSToken])
    -> PreCST SwitchBoard s (Maybe String, [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    str, [CHSToken]
    toks)
    parseOptPrefix Bool
    True  (CHSTokWith   Position
    _    :
                          CHSTokPrefix Position
    _    :
                          CHSTokEqual  Position
    _    :
                          CHSTokString Position
    _ String
    str:
                          [CHSToken]
    toks)                = (Maybe String, [CHSToken])
    -> PreCST SwitchBoard s (Maybe String, [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    str, [CHSToken]
    toks)
    parseOptPrefix Bool
    _     (CHSTokWith   Position
    _:[CHSToken]
    toks) = [CHSToken] -> PreCST SwitchBoard s (Maybe String, [CHSToken])
    forall s a. [CHSToken] -> CST s a
    syntaxError [CHSToken]
    toks
    parseOptPrefix Bool
    _     (CHSTokPrefix Position
    _:[CHSToken]
    toks) = [CHSToken] -> PreCST SwitchBoard s (Maybe String, [CHSToken])
    forall s a. [CHSToken] -> CST s a
    syntaxError [CHSToken]
    toks
    parseOptPrefix Bool
    _     [CHSToken]
    toks                  = (Maybe String, [CHSToken])
    -> PreCST SwitchBoard s (Maybe String, [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe String
    forall a. Maybe a
    Nothing, [CHSToken]
    toks)

    -- first argument is the identifier that is to be used when `^' is given and
    -- the second indicates whether the first character has to be upper case
    --
    parseOptAs :: Ident -> Bool -> [CHSToken] -> CST s (Maybe Ident, [CHSToken])
    parseOptAs :: forall s.
    Ident -> Bool -> [CHSToken] -> CST s (Maybe Ident, [CHSToken])
    parseOptAs Ident
    _   Bool
    _     (CHSTokAs Position
    _:CHSTokIdent Position
    _ Ident
    ide:[CHSToken]
    toks) =
      (Maybe Ident, [CHSToken])
    -> PreCST SwitchBoard s (Maybe Ident, [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Ident -> Maybe Ident
    forall a. a -> Maybe a
    Just Ident
    ide, [CHSToken]
    toks)
    parseOptAs Ident
    ide Bool
    upper (CHSTokAs Position
    _:CHSTokHat Position
    pos    :[CHSToken]
    toks) =
      (Maybe Ident, [CHSToken])
    -> PreCST SwitchBoard s (Maybe Ident, [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Ident -> Maybe Ident
    forall a. a -> Maybe a
    Just (Ident -> Maybe Ident) -> Ident -> Maybe Ident
    forall a b. (a -> b) -> a -> b
    $ Ident -> Bool -> Position -> Ident
    underscoreToCase Ident
    ide Bool
    upper Position
    pos, [CHSToken]
    toks)
    parseOptAs Ident
    _   Bool
    _     (CHSTokAs Position
    _                  :[CHSToken]
    toks) = [CHSToken] -> PreCST SwitchBoard s (Maybe Ident, [CHSToken])
    forall s a. [CHSToken] -> CST s a
    syntaxError [CHSToken]
    toks
    parseOptAs Ident
    _   Bool
    _                                   [CHSToken]
    toks  =
      (Maybe Ident, [CHSToken])
    -> PreCST SwitchBoard s (Maybe Ident, [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe Ident
    forall a. Maybe a
    Nothing, [CHSToken]
    toks)

    -- convert C style identifier to Haskell style identifier
    --
    underscoreToCase               :: Ident -> Bool -> Position -> Ident
    underscoreToCase :: Ident -> Bool -> Position -> Ident
    underscoreToCase Ident
    ide Bool
    upper Position
    pos  =
      let lexeme :: String
    lexeme = Ident -> String
    identToLexeme Ident
    ide
          ps :: [String]
    ps     = (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null) ([String] -> [String])
    -> (String -> [String]) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    parts (String -> [String]) -> String -> [String]
    forall a b. (a -> b) -> a -> b
    $ String
    lexeme
      in
      Position -> String -> Ident
    onlyPosIdent Position
    pos (String -> Ident) -> ([String] -> String) -> [String] -> Ident
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    adjustHead ShowS -> ([String] -> String) -> [String] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([String] -> String)
    -> ([String] -> [String]) -> [String] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map ShowS
    adjustCase ([String] -> Ident) -> [String] -> Ident
    forall a b. (a -> b) -> a -> b
    $ [String]
    ps
      where
        parts :: String -> [String]
    parts String
    s = let (String
    l, String
    s') = (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '_') String
    s
                  in
                  String
    l String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : case String
    s' of
                        []      -> []
                        (Char
    _:String
    s'') -> String -> [String]
    parts String
    s''
        --
        adjustCase :: ShowS
    adjustCase (Char
    c:String
    cs) = Char -> Char
    toUpper Char
    c Char -> ShowS
    forall a. a -> [a] -> [a]
    : (Char -> Char) -> ShowS
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower String
    cs
        --
        adjustHead :: ShowS
    adjustHead String
    ""     = String
    ""
        adjustHead (Char
    c:String
    cs) = if Bool
    upper then Char -> Char
    toUpper Char
    c Char -> ShowS
    forall a. a -> [a] -> [a]
    : String
    cs else Char -> Char
    toLower Char
    cChar -> ShowS
    forall a. a -> [a] -> [a]
    :String
    cs

    -- this is disambiguated and left factored
    --
    parsePath :: [CHSToken] -> CST s (CHSAPath, [CHSToken])
    parsePath :: forall s. [CHSToken] -> CST s (CHSAPath, [CHSToken])
    parsePath (CHSTokStar Position
    pos:[CHSToken]
    toks) =
      do
        (CHSAPath
    path, [CHSToken]
    toks') <- [CHSToken] -> CST s (CHSAPath, [CHSToken])
    forall s. [CHSToken] -> CST s (CHSAPath, [CHSToken])
    parsePath [CHSToken]
    toks
        (CHSAPath, [CHSToken]) -> CST s (CHSAPath, [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CHSAPath -> Position -> CHSAPath
    CHSDeref CHSAPath
    path Position
    pos, [CHSToken]
    toks')
    parsePath (CHSTokIdent Position
    _ Ident
    ide:[CHSToken]
    toks) =
      do
        (CHSAPath -> CHSAPath
    pathWithHole, [CHSToken]
    toks') <- [CHSToken] -> CST s (CHSAPath -> CHSAPath, [CHSToken])
    forall s. [CHSToken] -> CST s (CHSAPath -> CHSAPath, [CHSToken])
    parsePath' [CHSToken]
    toks
        (CHSAPath, [CHSToken]) -> CST s (CHSAPath, [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CHSAPath -> CHSAPath
    pathWithHole (Ident -> CHSAPath
    CHSRoot Ident
    ide), [CHSToken]
    toks')
    parsePath [CHSToken]
    toks = [CHSToken] -> CST s (CHSAPath, [CHSToken])
    forall s a. [CHSToken] -> CST s a
    syntaxError [CHSToken]
    toks

    -- `s->m' is represented by `(*s).m' in the tree
    --
    parsePath' :: [CHSToken] -> CST s (CHSAPath -> CHSAPath, [CHSToken])
    parsePath' :: forall s. [CHSToken] -> CST s (CHSAPath -> CHSAPath, [CHSToken])
    parsePath' (CHSTokDot Position
    _:CHSTokIdent Position
    _ Ident
    ide:[CHSToken]
    toks) =
      do
        (CHSAPath -> CHSAPath
    pathWithHole, [CHSToken]
    toks') <- [CHSToken] -> CST s (CHSAPath -> CHSAPath, [CHSToken])
    forall s. [CHSToken] -> CST s (CHSAPath -> CHSAPath, [CHSToken])
    parsePath' [CHSToken]
    toks
        (CHSAPath -> CHSAPath, [CHSToken])
    -> CST s (CHSAPath -> CHSAPath, [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CHSAPath -> CHSAPath
    pathWithHole (CHSAPath -> CHSAPath)
    -> (CHSAPath -> CHSAPath) -> CHSAPath -> CHSAPath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (\CHSAPath
    hole -> CHSAPath -> Ident -> CHSAPath
    CHSRef CHSAPath
    hole Ident
    ide), [CHSToken]
    toks')
    parsePath' (CHSTokDot Position
    _:[CHSToken]
    toks) =
      [CHSToken] -> CST s (CHSAPath -> CHSAPath, [CHSToken])
    forall s a. [CHSToken] -> CST s a
    syntaxError [CHSToken]
    toks
    parsePath' (CHSTokArrow Position
    pos:CHSTokIdent Position
    _ Ident
    ide:[CHSToken]
    toks) =
      do
        (CHSAPath -> CHSAPath
    pathWithHole, [CHSToken]
    toks') <- [CHSToken] -> CST s (CHSAPath -> CHSAPath, [CHSToken])
    forall s. [CHSToken] -> CST s (CHSAPath -> CHSAPath, [CHSToken])
    parsePath' [CHSToken]
    toks
        (CHSAPath -> CHSAPath, [CHSToken])
    -> CST s (CHSAPath -> CHSAPath, [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CHSAPath -> CHSAPath
    pathWithHole (CHSAPath -> CHSAPath)
    -> (CHSAPath -> CHSAPath) -> CHSAPath -> CHSAPath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (\CHSAPath
    hole -> CHSAPath -> Ident -> CHSAPath
    CHSRef (CHSAPath -> Position -> CHSAPath
    CHSDeref CHSAPath
    hole Position
    pos) Ident
    ide), [CHSToken]
    toks')
    parsePath' (CHSTokArrow Position
    _:[CHSToken]
    toks) =
      [CHSToken] -> CST s (CHSAPath -> CHSAPath, [CHSToken])
    forall s a. [CHSToken] -> CST s a
    syntaxError [CHSToken]
    toks
    parsePath' [CHSToken]
    toks =
      do
        [CHSToken]
    toks' <- [CHSToken] -> CST s [CHSToken]
    forall s. [CHSToken] -> CST s [CHSToken]
    parseEndHook [CHSToken]
    toks
        (CHSAPath -> CHSAPath, [CHSToken])
    -> CST s (CHSAPath -> CHSAPath, [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CHSAPath -> CHSAPath
    forall a. a -> a
    id, [CHSToken]
    toks')

    parseTrans :: [CHSToken] -> CST s (CHSTrans, [CHSToken])
    parseTrans :: forall s. [CHSToken] -> CST s (CHSTrans, [CHSToken])
    parseTrans (CHSTokLBrace Position
    _:[CHSToken]
    toks) =
      do
        (Bool
    _2Case, [CHSToken]
    toks' ) <- [CHSToken] -> PreCST SwitchBoard s (Bool, [CHSToken])
    forall {m :: * -> *}. Monad m => [CHSToken] -> m (Bool, [CHSToken])
    parse_2Case [CHSToken]
    toks
        case [CHSToken]
    toks' of
          (CHSTokRBrace Position
    _:[CHSToken]
    toks'') -> (CHSTrans, [CHSToken]) -> CST s (CHSTrans, [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> [(Ident, Ident)] -> CHSTrans
    CHSTrans Bool
    _2Case [], [CHSToken]
    toks'')
          [CHSToken]
    _                       ->
            do
              -- if there was no `underscoreToCase', we add a comma token to meet
              -- the invariant of `parseTranss'
              --
              ([(Ident, Ident)]
    transs, [CHSToken]
    toks'') <- if Bool
    _2Case
                                  then [CHSToken] -> PreCST SwitchBoard s ([(Ident, Ident)], [CHSToken])
    forall {s}.
    [CHSToken] -> PreCST SwitchBoard s ([(Ident, Ident)], [CHSToken])
    parseTranss [CHSToken]
    toks'
                                  else [CHSToken] -> PreCST SwitchBoard s ([(Ident, Ident)], [CHSToken])
    forall {s}.
    [CHSToken] -> PreCST SwitchBoard s ([(Ident, Ident)], [CHSToken])
    parseTranss (Position -> CHSToken
    CHSTokComma Position
    noposCHSToken -> [CHSToken] -> [CHSToken]
    forall a. a -> [a] -> [a]
    :[CHSToken]
    toks')
              (CHSTrans, [CHSToken]) -> CST s (CHSTrans, [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> [(Ident, Ident)] -> CHSTrans
    CHSTrans Bool
    _2Case [(Ident, Ident)]
    transs, [CHSToken]
    toks'')
      where
        parse_2Case :: [CHSToken] -> m (Bool, [CHSToken])
    parse_2Case (CHSTok_2Case Position
    _:[CHSToken]
    toks) = (Bool, [CHSToken]) -> m (Bool, [CHSToken])
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    True, [CHSToken]
    toks)
        parse_2Case [CHSToken]
    toks                  = (Bool, [CHSToken]) -> m (Bool, [CHSToken])
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    False, [CHSToken]
    toks)
        --
        parseTranss :: [CHSToken] -> PreCST SwitchBoard s ([(Ident, Ident)], [CHSToken])
    parseTranss (CHSTokRBrace Position
    _:[CHSToken]
    toks) = ([(Ident, Ident)], [CHSToken])
    -> PreCST SwitchBoard s ([(Ident, Ident)], [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([], [CHSToken]
    toks)
        parseTranss (CHSTokComma  Position
    _:[CHSToken]
    toks) = do
                                              ((Ident, Ident)
    assoc, [CHSToken]
    toks' ) <- [CHSToken] -> PreCST SwitchBoard s ((Ident, Ident), [CHSToken])
    forall {s}.
    [CHSToken] -> PreCST SwitchBoard s ((Ident, Ident), [CHSToken])
    parseAssoc [CHSToken]
    toks
                                              ([(Ident, Ident)]
    trans, [CHSToken]
    toks'') <- [CHSToken] -> PreCST SwitchBoard s ([(Ident, Ident)], [CHSToken])
    parseTranss [CHSToken]
    toks'
                                              ([(Ident, Ident)], [CHSToken])
    -> PreCST SwitchBoard s ([(Ident, Ident)], [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Ident, Ident)
    assoc(Ident, Ident) -> [(Ident, Ident)] -> [(Ident, Ident)]
    forall a. a -> [a] -> [a]
    :[(Ident, Ident)]
    trans, [CHSToken]
    toks'')
        parseTranss [CHSToken]
    toks                  = [CHSToken] -> PreCST SwitchBoard s ([(Ident, Ident)], [CHSToken])
    forall s a. [CHSToken] -> CST s a
    syntaxError [CHSToken]
    toks
        --
        parseAssoc :: [CHSToken] -> PreCST SwitchBoard s ((Ident, Ident), [CHSToken])
    parseAssoc (CHSTokIdent Position
    _ Ident
    ide1:CHSTokAs Position
    _:CHSTokIdent Position
    _ Ident
    ide2:[CHSToken]
    toks) =
          ((Ident, Ident), [CHSToken])
    -> PreCST SwitchBoard s ((Ident, Ident), [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Ident
    ide1, Ident
    ide2), [CHSToken]
    toks)
        parseAssoc (CHSTokIdent Position
    _ Ident
    ide1:CHSTokAs Position
    _:[CHSToken]
    toks                   ) =
          [CHSToken] -> PreCST SwitchBoard s ((Ident, Ident), [CHSToken])
    forall s a. [CHSToken] -> CST s a
    syntaxError [CHSToken]
    toks
        parseAssoc (CHSTokIdent Position
    _ Ident
    ide1:[CHSToken]
    toks                              ) =
          [CHSToken] -> PreCST SwitchBoard s ((Ident, Ident), [CHSToken])
    forall s a. [CHSToken] -> CST s a
    syntaxError [CHSToken]
    toks
        parseAssoc [CHSToken]
    toks                                                    =
          [CHSToken] -> PreCST SwitchBoard s ((Ident, Ident), [CHSToken])
    forall s a. [CHSToken] -> CST s a
    syntaxError [CHSToken]
    toks
    parseTrans [CHSToken]
    toks = [CHSToken] -> CST s (CHSTrans, [CHSToken])
    forall s a. [CHSToken] -> CST s a
    syntaxError [CHSToken]
    toks

    parseDerive :: [CHSToken] -> CST s ([Ident], [CHSToken])
    parseDerive :: forall s. [CHSToken] -> CST s ([Ident], [CHSToken])
    parseDerive (CHSTokDerive Position
    _ :CHSTokLParen Position
    _:CHSTokRParen Position
    _:[CHSToken]
    toks) =
      ([Ident], [CHSToken]) -> PreCST SwitchBoard s ([Ident], [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([], [CHSToken]
    toks)
    parseDerive (CHSTokDerive Position
    _ :CHSTokLParen Position
    _:[CHSToken]
    toks)                =
      [CHSToken] -> PreCST SwitchBoard s ([Ident], [CHSToken])
    forall s. [CHSToken] -> CST s ([Ident], [CHSToken])
    parseCommaIdent (Position -> CHSToken
    CHSTokComma Position
    noposCHSToken -> [CHSToken] -> [CHSToken]
    forall a. a -> [a] -> [a]
    :[CHSToken]
    toks)
      where
        parseCommaIdent :: [CHSToken] -> CST s ([Ident], [CHSToken])
        parseCommaIdent :: forall s. [CHSToken] -> CST s ([Ident], [CHSToken])
    parseCommaIdent (CHSTokComma Position
    _:CHSTokIdent Position
    _ Ident
    ide:[CHSToken]
    toks) =
          do
            ([Ident]
    ids, [CHSToken]
    tok') <- [CHSToken] -> CST s ([Ident], [CHSToken])
    forall s. [CHSToken] -> CST s ([Ident], [CHSToken])
    parseCommaIdent [CHSToken]
    toks
            ([Ident], [CHSToken]) -> CST s ([Ident], [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Ident
    ideIdent -> [Ident] -> [Ident]
    forall a. a -> [a] -> [a]
    :[Ident]
    ids, [CHSToken]
    tok')
        parseCommaIdent (CHSTokRParen Position
    _                 :[CHSToken]
    toks) =
          ([Ident], [CHSToken]) -> CST s ([Ident], [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([], [CHSToken]
    toks)
    parseDerive [CHSToken]
    toks = ([Ident], [CHSToken]) -> PreCST SwitchBoard s ([Ident], [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([],[CHSToken]
    toks)

    parseIdent :: [CHSToken] -> CST s (Ident, [CHSToken])
    parseIdent :: forall s. [CHSToken] -> CST s (Ident, [CHSToken])
    parseIdent (CHSTokIdent Position
    _ Ident
    ide:[CHSToken]
    toks) = (Ident, [CHSToken]) -> PreCST SwitchBoard s (Ident, [CHSToken])
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Ident
    ide, [CHSToken]
    toks)
    parseIdent [CHSToken]
    toks                     = [CHSToken] -> PreCST SwitchBoard s (Ident, [CHSToken])
    forall s a. [CHSToken] -> CST s a
    syntaxError [CHSToken]
    toks

    parseEndHook :: [CHSToken] -> CST s ([CHSToken])
    parseEndHook :: forall s. [CHSToken] -> CST s [CHSToken]
    parseEndHook (CHSTokEndHook Position
    _:[CHSToken]
    toks) = [CHSToken] -> PreCST SwitchBoard s [CHSToken]
    forall a. a -> PreCST SwitchBoard s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [CHSToken]
    toks
    parseEndHook [CHSToken]
    toks                   = [CHSToken] -> PreCST SwitchBoard s [CHSToken]
    forall s a. [CHSToken] -> CST s a
    syntaxError [CHSToken]
    toks

    syntaxError         :: [CHSToken] -> CST s a
    syntaxError :: forall s a. [CHSToken] -> CST s a
    syntaxError []       = CST s a
    forall s a. CST s a
    errorEOF
    syntaxError (CHSToken
    tok:[CHSToken]
    _)  = CHSToken -> CST s a
    forall s a. CHSToken -> CST s a
    errorIllegal CHSToken
    tok

    errorIllegal     :: CHSToken -> CST s a
    errorIllegal :: forall s a. CHSToken -> CST s a
    errorIllegal CHSToken
    tok  = do
                          Position -> [String] -> PreCST SwitchBoard s ()
    forall e s. Position -> [String] -> PreCST e s ()
    raiseError (CHSToken -> Position
    forall a. Pos a => a -> Position
    posOf CHSToken
    tok)
                            [String
    "Syntax error!",
                             String
    "The phrase `" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ CHSToken -> String
    forall a. Show a => a -> String
    show CHSToken
    tok String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "' is not allowed \
                             \here."]
                          CST s a
    forall s a. CST s a
    raiseSyntaxError

    errorEOF :: CST s a
    errorEOF :: forall s a. CST s a
    errorEOF  = do
                  Position -> [String] -> PreCST SwitchBoard s ()
    forall e s. Position -> [String] -> PreCST e s ()
    raiseError Position
    nopos
                    [String
    "Premature end of file!",
                     String
    "The .chs file ends in the middle of a binding hook."]
                  CST s a
    forall s a. CST s a
    raiseSyntaxError

    errorCHINotFound     :: String -> CST s a
    errorCHINotFound :: forall s a. String -> CST s a
    errorCHINotFound String
    ide  = do
      Position -> [String] -> PreCST SwitchBoard s ()
    forall e s. Position -> [String] -> PreCST e s ()
    raiseError Position
    nopos
        [String
    "Unknown .chi file!",
         String
    "Cannot find the .chi file for `" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ide String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "'."]
      CST s a
    forall s a. CST s a
    raiseSyntaxError

    errorCHICorrupt      :: String -> CST s a
    errorCHICorrupt :: forall s a. String -> CST s a
    errorCHICorrupt String
    ide  = do
      Position -> [String] -> PreCST SwitchBoard s ()
    forall e s. Position -> [String] -> PreCST e s ()
    raiseError Position
    nopos
        [String
    "Corrupt .chi file!",
         String
    "The file `" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++  String
    ide String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ".chi' is corrupt."]
      CST s a
    forall s a. CST s a
    raiseSyntaxError

    errorCHIVersion :: String -> String -> String -> CST s a
    errorCHIVersion :: forall s a. String -> String -> String -> CST s a
    errorCHIVersion String
    ide String
    chiVersion String
    myVersion  = do
      Position -> [String] -> PreCST SwitchBoard s ()
    forall e s. Position -> [String] -> PreCST e s ()
    raiseError Position
    nopos
        [String
    "Wrong version of .chi file!",
         String
    "The file `" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ide String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ".chi' is version "
         String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    chiVersion String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ", but mine is " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    myVersion String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "."]
      CST s a
    forall s a. CST s a
    raiseSyntaxError