--  C->Haskell Compiler: traversals of C structure tree
--
--  Author : Manuel M. T. Chakravarty
--  Created: 16 October 99
--
--  Version $Revision: 1.1 $ from $Date: 2004/11/21 21:05:27 $
--
--  Copyright (c) [1999..2001] Manuel M. T. Chakravarty
--
--  This file is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2 of the License, or
--  (at your option) any later version.
--
--  This file is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--
--- DESCRIPTION ---------------------------------------------------------------
--
--  This modules provides for traversals of C structure trees.  The C
--  traversal monad supports traversals that need convenient access to the
--  attributes of an attributed C structure tree.  The monads state can still
--  be extended.
--
--- DOCU ----------------------------------------------------------------------
--
--  language: Haskell 98
--
--  Handling of redefined tag values
--  --------------------------------
--
--  Structures allow both
--
--    struct s {...} ...;
--    struct s       ...;
--
--  and
--
--    struct s       ...;       /* this is called a forward reference */
--    struct s {...} ...;
--
--  In contrast enumerations only allow (in ANSI C)
--
--    enum e {...} ...;
--    enum e       ...;
--
--  The function `defTag' handles both types and establishes an object
--  association from the tag identifier in the empty declaration (ie, the one
--  without `{...}') to the actually definition of the structure of
--  enumeration.  This implies that when looking for the details of a
--  structure or enumeration, possibly a chain of references on tag
--  identifiers has to be chased.  Note that the object association attribute
--  is _not_defined_ when the `{...}'  part is present in a declaration.
--
--- TODO ----------------------------------------------------------------------
--
--  * `extractStruct' doesn't account for forward declarations that have no
--   full declaration yet; if `extractStruct' is called on such a declaration, 
--   we have a user error, but currently an internal error is raised
--

module CTrav (CT, readCT, transCT, getCHeaderCT, runCT, throwCTExc, ifCTExc,
              raiseErrorCTExc,
              enter, enterObjs, leave, leaveObjs, defObj, findObj,
              findObjShadow, defTag, findTag, findTagShadow,
              applyPrefixToNameSpaces, getDefOf, refersToDef, refersToNewDef,
              getDeclOf, findTypeObjMaybe, findTypeObj, findValueObj,
              findFunObj,
              --
              -- C structure tree query functions
              --
              isTypedef, simplifyDecl, declrFromDecl, declrNamed,
              declaredDeclr, declaredName, structMembers, expandDecl,
              structName, enumName, tagName, isArrDeclr, isPtrDeclr, dropPtrDeclr,
              isPtrDecl, isFunDeclr, structFromDecl, funResultAndArgs,
              chaseDecl, findAndChaseDecl, checkForAlias,
              checkForOneAliasName, lookupEnum, lookupStructUnion,
              lookupDeclOrTag)
where

import Data.List       (find)
import Data.Maybe         (fromMaybe)
import Control.Monad      (liftM)
import Control.Exception (assert)

import Position   (Position, Pos(..), nopos)
import Errors     (interr)
import Idents     (Ident, dumpIdent, identToLexeme)
import Attributes (Attr(..), newAttrsOnlyPos)

import C2HSState  (CST, nop, readCST, transCST, runCST, raiseError, catchExc,
                   throwExc, Traces(..), putTraceStr)
import CAST
import CAttrs     (AttrC, getCHeader, enterNewRangeC, enterNewObjRangeC,
                   leaveRangeC, leaveObjRangeC, addDefObjC, lookupDefObjC,
                   lookupDefObjCShadow, addDefTagC, lookupDefTagC,
                   lookupDefTagCShadow, applyPrefix, getDefOfIdentC,
                   setDefOfIdentC, updDefOfIdentC, CObj(..), CTag(..),
                   CDef(..)) 


-- the C traversal monad
-- ---------------------

-- C traversal monad (EXPORTED ABSTRACTLY)
--
type CState s    = (AttrC, s)
type CT     s a  = CST (CState s) a

-- read attributed struture tree
--
readAttrCCT        :: (AttrC -> a) -> CT s a
readAttrCCT :: (AttrC -> a) -> CT s a
readAttrCCT reader :: AttrC -> a
reader  = ((AttrC, s) -> a) -> CT s a
forall s a e. (s -> a) -> PreCST e s a
readCST (((AttrC, s) -> a) -> CT s a) -> ((AttrC, s) -> a) -> CT s a
forall a b. (a -> b) -> a -> b
$ \(ac :: AttrC
ac, _) -> AttrC -> a
reader AttrC
ac

-- transform attributed structure tree
--
transAttrCCT       :: (AttrC -> (AttrC, a)) -> CT s a
transAttrCCT :: (AttrC -> (AttrC, a)) -> CT s a
transAttrCCT trans :: AttrC -> (AttrC, a)
trans  = ((AttrC, s) -> ((AttrC, s), a)) -> CT s a
forall s a e. (s -> (s, a)) -> PreCST e s a
transCST (((AttrC, s) -> ((AttrC, s), a)) -> CT s a)
-> ((AttrC, s) -> ((AttrC, s), a)) -> CT s a
forall a b. (a -> b) -> a -> b
$ \(ac :: AttrC
ac, s :: s
s) -> let
                                               (ac' :: AttrC
ac', r :: a
r) = AttrC -> (AttrC, a)
trans AttrC
ac
                                             in
                                             ((AttrC
ac', s
s), a
r)

-- access to the user-defined state
--

-- read user-defined state (EXPORTED)
--
readCT        :: (s -> a) -> CT s a
readCT :: (s -> a) -> CT s a
readCT reader :: s -> a
reader  = ((AttrC, s) -> a) -> CT s a
forall s a e. (s -> a) -> PreCST e s a
readCST (((AttrC, s) -> a) -> CT s a) -> ((AttrC, s) -> a) -> CT s a
forall a b. (a -> b) -> a -> b
$ \(_, s :: s
s) -> s -> a
reader s
s

-- transform user-defined state (EXPORTED)
--
transCT       :: (s -> (s, a)) -> CT s a
transCT :: (s -> (s, a)) -> CT s a
transCT trans :: s -> (s, a)
trans  = ((AttrC, s) -> ((AttrC, s), a)) -> CT s a
forall s a e. (s -> (s, a)) -> PreCST e s a
transCST (((AttrC, s) -> ((AttrC, s), a)) -> CT s a)
-> ((AttrC, s) -> ((AttrC, s), a)) -> CT s a
forall a b. (a -> b) -> a -> b
$ \(ac :: AttrC
ac, s :: s
s) -> let
                                          (s' :: s
s', r :: a
r) = s -> (s, a)
trans s
s
                                        in
                                        ((AttrC
ac, s
s'), a
r)

-- usage of a traversal monad
--

-- get the raw C header from the monad (EXPORTED)
--
getCHeaderCT :: CT s CHeader
getCHeaderCT :: CT s CHeader
getCHeaderCT  = (AttrC -> CHeader) -> CT s CHeader
forall a s. (AttrC -> a) -> CT s a
readAttrCCT AttrC -> CHeader
getCHeader

-- execute a traversal monad (EXPORTED)
--
--  * given a traversal monad, an attribute structure tree, and a user
--   state, the transformed structure tree and monads result are returned
--
runCT        :: CT s a -> AttrC -> s -> CST t (AttrC, a)
runCT :: CT s a -> AttrC -> s -> CST t (AttrC, a)
runCT m :: CT s a
m ac :: AttrC
ac s :: s
s  = PreCST SwitchBoard (CState s) (AttrC, a)
-> CState s -> CST t (AttrC, a)
forall e s a s'. PreCST e s a -> s -> PreCST e s' a
runCST PreCST SwitchBoard (CState s) (AttrC, a)
m' (AttrC
ac, s
s)
                where
                  m' :: PreCST SwitchBoard (CState s) (AttrC, a)
m' = do
                         a
r <- CT s a
m
                         (ac :: AttrC
ac, _) <- (CState s -> CState s) -> PreCST SwitchBoard (CState s) (CState s)
forall s a e. (s -> a) -> PreCST e s a
readCST CState s -> CState s
forall a. a -> a
id
                         (AttrC, a) -> PreCST SwitchBoard (CState s) (AttrC, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (AttrC
ac, a
r)


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

-- exception identifier
--
ctExc :: String
ctExc :: String
ctExc  = "ctExc"

-- throw an exception  (EXPORTED)
--
throwCTExc :: CT s a
throwCTExc :: CT s a
throwCTExc  = String -> String -> CT s a
forall e s a. String -> String -> PreCST e s a
throwExc String
ctExc "Error during traversal of a C structure tree"

-- catch a `ctExc'  (EXPORTED)
--
ifCTExc           :: CT s a -> CT s a -> CT s a
ifCTExc :: CT s a -> CT s a -> CT s a
ifCTExc m :: CT s a
m handler :: CT s a
handler  = CT s a
m CT s a -> (String, String -> CT s a) -> CT s a
forall e s a.
PreCST e s a -> (String, String -> PreCST e s a) -> PreCST e s a
`catchExc` (String
ctExc, CT s a -> String -> CT s a
forall a b. a -> b -> a
const CT s a
handler)

-- raise an error followed by throwing a CT exception (EXPORTED)
--
raiseErrorCTExc          :: Position -> [String] -> CT s a
raiseErrorCTExc :: Position -> [String] -> CT s a
raiseErrorCTExc pos :: Position
pos errs :: [String]
errs  = Position -> [String] -> PreCST SwitchBoard (CState s) ()
forall e s. Position -> [String] -> PreCST e s ()
raiseError Position
pos [String]
errs PreCST SwitchBoard (CState s) () -> CT s a -> CT s a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CT s a
forall s a. CT s a
throwCTExc


-- attribute manipulation
-- ----------------------

-- name spaces
--

-- enter a new local range (EXPORTED)
--
enter :: CT s ()
enter :: CT s ()
enter  = (AttrC -> (AttrC, ())) -> CT s ()
forall a s. (AttrC -> (AttrC, a)) -> CT s a
transAttrCCT ((AttrC -> (AttrC, ())) -> CT s ())
-> (AttrC -> (AttrC, ())) -> CT s ()
forall a b. (a -> b) -> a -> b
$ \ac :: AttrC
ac -> (AttrC -> AttrC
enterNewRangeC AttrC
ac, ())

-- enter a new local range, only for objects (EXPORTED)
--
enterObjs :: CT s ()
enterObjs :: CT s ()
enterObjs  = (AttrC -> (AttrC, ())) -> CT s ()
forall a s. (AttrC -> (AttrC, a)) -> CT s a
transAttrCCT ((AttrC -> (AttrC, ())) -> CT s ())
-> (AttrC -> (AttrC, ())) -> CT s ()
forall a b. (a -> b) -> a -> b
$ \ac :: AttrC
ac -> (AttrC -> AttrC
enterNewObjRangeC AttrC
ac, ())

-- leave the current local range (EXPORTED)
--
leave :: CT s ()
leave :: CT s ()
leave  = (AttrC -> (AttrC, ())) -> CT s ()
forall a s. (AttrC -> (AttrC, a)) -> CT s a
transAttrCCT ((AttrC -> (AttrC, ())) -> CT s ())
-> (AttrC -> (AttrC, ())) -> CT s ()
forall a b. (a -> b) -> a -> b
$ \ac :: AttrC
ac -> (AttrC -> AttrC
leaveRangeC AttrC
ac, ())

-- leave the current local range, only for objects (EXPORTED)
--
leaveObjs :: CT s ()
leaveObjs :: CT s ()
leaveObjs  = (AttrC -> (AttrC, ())) -> CT s ()
forall a s. (AttrC -> (AttrC, a)) -> CT s a
transAttrCCT ((AttrC -> (AttrC, ())) -> CT s ())
-> (AttrC -> (AttrC, ())) -> CT s ()
forall a b. (a -> b) -> a -> b
$ \ac :: AttrC
ac -> (AttrC -> AttrC
leaveObjRangeC AttrC
ac, ())

-- enter an object definition into the object name space (EXPORTED)
--
--  * if a definition of the same name was already present, it is returned 
--
defObj         :: Ident -> CObj -> CT s (Maybe CObj)
defObj :: Ident -> CObj -> CT s (Maybe CObj)
defObj ide :: Ident
ide obj :: CObj
obj  = (AttrC -> (AttrC, Maybe CObj)) -> CT s (Maybe CObj)
forall a s. (AttrC -> (AttrC, a)) -> CT s a
transAttrCCT ((AttrC -> (AttrC, Maybe CObj)) -> CT s (Maybe CObj))
-> (AttrC -> (AttrC, Maybe CObj)) -> CT s (Maybe CObj)
forall a b. (a -> b) -> a -> b
$ \ac :: AttrC
ac -> AttrC -> Ident -> CObj -> (AttrC, Maybe CObj)
addDefObjC AttrC
ac Ident
ide CObj
obj

-- find a definition in the object name space (EXPORTED)
--
findObj     :: Ident -> CT s (Maybe CObj)
findObj :: Ident -> CT s (Maybe CObj)
findObj ide :: Ident
ide  = (AttrC -> Maybe CObj) -> CT s (Maybe CObj)
forall a s. (AttrC -> a) -> CT s a
readAttrCCT ((AttrC -> Maybe CObj) -> CT s (Maybe CObj))
-> (AttrC -> Maybe CObj) -> CT s (Maybe CObj)
forall a b. (a -> b) -> a -> b
$ \ac :: AttrC
ac -> AttrC -> Ident -> Maybe CObj
lookupDefObjC AttrC
ac Ident
ide

-- find a definition in the object name space; if nothing found, try 
-- whether there is a shadow identifier that matches (EXPORTED)
--
findObjShadow     :: Ident -> CT s (Maybe (CObj, Ident))
findObjShadow :: Ident -> CT s (Maybe (CObj, Ident))
findObjShadow ide :: Ident
ide  = (AttrC -> Maybe (CObj, Ident)) -> CT s (Maybe (CObj, Ident))
forall a s. (AttrC -> a) -> CT s a
readAttrCCT ((AttrC -> Maybe (CObj, Ident)) -> CT s (Maybe (CObj, Ident)))
-> (AttrC -> Maybe (CObj, Ident)) -> CT s (Maybe (CObj, Ident))
forall a b. (a -> b) -> a -> b
$ \ac :: AttrC
ac -> AttrC -> Ident -> Maybe (CObj, Ident)
lookupDefObjCShadow AttrC
ac Ident
ide

-- enter a tag definition into the tag name space (EXPORTED)
--
--  * empty definitions of structures get overwritten with complete ones and a
--   forward reference is added to their tag identifier; furthermore, both
--   structures and enums may be referenced using an empty definition when
--   there was a full definition earlier and in this case there is also an
--   object association added; otherwise, if a definition of the same name was
--   already present, it is returned (see DOCU section)
--
--  * it is checked that the first occurence of an enumeration tag is
--   accompanied by a full definition of the enumeration
--
defTag         :: Ident -> CTag -> CT s (Maybe CTag)
defTag :: Ident -> CTag -> CT s (Maybe CTag)
defTag ide :: Ident
ide tag :: CTag
tag  = 
  do
    Maybe CTag
otag <- (AttrC -> (AttrC, Maybe CTag)) -> CT s (Maybe CTag)
forall a s. (AttrC -> (AttrC, a)) -> CT s a
transAttrCCT ((AttrC -> (AttrC, Maybe CTag)) -> CT s (Maybe CTag))
-> (AttrC -> (AttrC, Maybe CTag)) -> CT s (Maybe CTag)
forall a b. (a -> b) -> a -> b
$ \ac :: AttrC
ac -> AttrC -> Ident -> CTag -> (AttrC, Maybe CTag)
addDefTagC AttrC
ac Ident
ide CTag
tag
    case Maybe CTag
otag of
      Nothing      -> do
                        CTag -> CT s ()
forall s. CTag -> CT s ()
assertIfEnumThenFull CTag
tag
                        Maybe CTag -> CT s (Maybe CTag)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CTag
forall a. Maybe a
Nothing                  -- no collision
      Just prevTag :: CTag
prevTag -> case CTag -> CTag -> Maybe (CTag, Ident)
isRefinedOrUse CTag
prevTag CTag
tag of
                         Nothing                 -> Maybe CTag -> CT s (Maybe CTag)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CTag
otag
                         Just (fullTag :: CTag
fullTag, foreIde :: Ident
foreIde) -> do
                           (AttrC -> (AttrC, Maybe CTag)) -> CT s (Maybe CTag)
forall a s. (AttrC -> (AttrC, a)) -> CT s a
transAttrCCT ((AttrC -> (AttrC, Maybe CTag)) -> CT s (Maybe CTag))
-> (AttrC -> (AttrC, Maybe CTag)) -> CT s (Maybe CTag)
forall a b. (a -> b) -> a -> b
$ \ac :: AttrC
ac -> AttrC -> Ident -> CTag -> (AttrC, Maybe CTag)
addDefTagC AttrC
ac Ident
ide CTag
fullTag
                           Ident
foreIde Ident -> CDef -> CT s ()
forall s. Ident -> CDef -> CT s ()
`refersToDef` CTag -> CDef
TagCD CTag
fullTag
                           Maybe CTag -> CT s (Maybe CTag)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CTag
forall a. Maybe a
Nothing               -- transparent for env
  where
    -- compute whether we have the case of a non-conflicting redefined tag
    -- definition, and if so, return the full definition and the foreward 
    -- definition's tag identifier
    --
    --  * the first argument contains the _previous_ definition
    --
    --  * in the case of a structure, a foreward definition after a full
    --   definition is allowed, so we have to handle this case; enumerations
    --   don't allow foreward definitions
    --
    --  * there may also be multiple foreward definition; if we have two of
    --   them here, one is arbitrarily selected to take the role of the full
    --   definition 
    --
    isRefinedOrUse :: CTag -> CTag -> Maybe (CTag, Ident)
isRefinedOrUse     (StructUnionCT (CStruct _ (Just ide :: Ident
ide) [] _))
                   tag :: CTag
tag@(StructUnionCT (CStruct _ (Just _  ) _  _)) = 
      (CTag, Ident) -> Maybe (CTag, Ident)
forall a. a -> Maybe a
Just (CTag
tag, Ident
ide)
    isRefinedOrUse tag :: CTag
tag@(StructUnionCT (CStruct _ (Just _  ) _  _))
                       (StructUnionCT (CStruct _ (Just ide :: Ident
ide) [] _)) = 
      (CTag, Ident) -> Maybe (CTag, Ident)
forall a. a -> Maybe a
Just (CTag
tag, Ident
ide)
    isRefinedOrUse tag :: CTag
tag@(EnumCT        (CEnum (Just _  ) _  _))
                       (EnumCT        (CEnum (Just ide :: Ident
ide) [] _))     = 
      (CTag, Ident) -> Maybe (CTag, Ident)
forall a. a -> Maybe a
Just (CTag
tag, Ident
ide)
    isRefinedOrUse _ _                                             = Maybe (CTag, Ident)
forall a. Maybe a
Nothing

-- find an definition in the tag name space (EXPORTED)
--
findTag     :: Ident -> CT s (Maybe CTag)
findTag :: Ident -> CT s (Maybe CTag)
findTag ide :: Ident
ide  = (AttrC -> Maybe CTag) -> CT s (Maybe CTag)
forall a s. (AttrC -> a) -> CT s a
readAttrCCT ((AttrC -> Maybe CTag) -> CT s (Maybe CTag))
-> (AttrC -> Maybe CTag) -> CT s (Maybe CTag)
forall a b. (a -> b) -> a -> b
$ \ac :: AttrC
ac -> AttrC -> Ident -> Maybe CTag
lookupDefTagC AttrC
ac Ident
ide

-- find an definition in the tag name space; if nothing found, try 
-- whether there is a shadow identifier that matches (EXPORTED)
--
findTagShadow     :: Ident -> CT s (Maybe (CTag, Ident))
findTagShadow :: Ident -> CT s (Maybe (CTag, Ident))
findTagShadow ide :: Ident
ide  = (AttrC -> Maybe (CTag, Ident)) -> CT s (Maybe (CTag, Ident))
forall a s. (AttrC -> a) -> CT s a
readAttrCCT ((AttrC -> Maybe (CTag, Ident)) -> CT s (Maybe (CTag, Ident)))
-> (AttrC -> Maybe (CTag, Ident)) -> CT s (Maybe (CTag, Ident))
forall a b. (a -> b) -> a -> b
$ \ac :: AttrC
ac -> AttrC -> Ident -> Maybe (CTag, Ident)
lookupDefTagCShadow AttrC
ac Ident
ide

-- enrich the object and tag name space with identifiers obtained by dropping
-- the given prefix from the identifiers already in the name space (EXPORTED)
--
--  * if a new identifier would collides with an existing one, the new one is
--   discarded, ie, all associations that existed before the transformation
--   started are still in effect after the transformation
-- 
applyPrefixToNameSpaces        :: String -> CT s ()
applyPrefixToNameSpaces :: String -> CT s ()
applyPrefixToNameSpaces prefix :: String
prefix  = 
  (AttrC -> (AttrC, ())) -> CT s ()
forall a s. (AttrC -> (AttrC, a)) -> CT s a
transAttrCCT ((AttrC -> (AttrC, ())) -> CT s ())
-> (AttrC -> (AttrC, ())) -> CT s ()
forall a b. (a -> b) -> a -> b
$ \ac :: AttrC
ac -> (AttrC -> String -> AttrC
applyPrefix AttrC
ac String
prefix, ())

-- definition attribute
--

-- get the definition of an identifier (EXPORTED) 
--
--  * the attribute must be defined, ie, a definition must be associated with
--   the given identifier
--
getDefOf     :: Ident -> CT s CDef
getDefOf :: Ident -> CT s CDef
getDefOf ide :: Ident
ide  = do
                  CDef
def <- (AttrC -> CDef) -> CT s CDef
forall a s. (AttrC -> a) -> CT s a
readAttrCCT ((AttrC -> CDef) -> CT s CDef) -> (AttrC -> CDef) -> CT s CDef
forall a b. (a -> b) -> a -> b
$ \ac :: AttrC
ac -> AttrC -> Ident -> CDef
getDefOfIdentC AttrC
ac Ident
ide
                  Bool -> CT s CDef -> CT s CDef
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool -> Bool
not (Bool -> Bool) -> (CDef -> Bool) -> CDef -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDef -> Bool
forall a. Attr a => a -> Bool
isUndef (CDef -> Bool) -> CDef -> Bool
forall a b. (a -> b) -> a -> b
$ CDef
def) (CT s CDef -> CT s CDef) -> CT s CDef -> CT s CDef
forall a b. (a -> b) -> a -> b
$
                    CDef -> CT s CDef
forall (m :: * -> *) a. Monad m => a -> m a
return CDef
def

-- set the definition of an identifier (EXPORTED) 
--
refersToDef         :: Ident -> CDef -> CT s ()
refersToDef :: Ident -> CDef -> CT s ()
refersToDef ide :: Ident
ide def :: CDef
def  = (AttrC -> (AttrC, ())) -> CT s ()
forall a s. (AttrC -> (AttrC, a)) -> CT s a
transAttrCCT ((AttrC -> (AttrC, ())) -> CT s ())
-> (AttrC -> (AttrC, ())) -> CT s ()
forall a b. (a -> b) -> a -> b
$ \akl :: AttrC
akl -> (AttrC -> Ident -> CDef -> AttrC
setDefOfIdentC AttrC
akl Ident
ide CDef
def, ())

-- update the definition of an identifier (EXPORTED) 
--
refersToNewDef         :: Ident -> CDef -> CT s ()
refersToNewDef :: Ident -> CDef -> CT s ()
refersToNewDef ide :: Ident
ide def :: CDef
def  = 
  (AttrC -> (AttrC, ())) -> CT s ()
forall a s. (AttrC -> (AttrC, a)) -> CT s a
transAttrCCT ((AttrC -> (AttrC, ())) -> CT s ())
-> (AttrC -> (AttrC, ())) -> CT s ()
forall a b. (a -> b) -> a -> b
$ \akl :: AttrC
akl -> (AttrC -> Ident -> CDef -> AttrC
updDefOfIdentC AttrC
akl Ident
ide CDef
def, ())

-- get the declarator of an identifier (EXPORTED)
--
getDeclOf     :: Ident -> CT s CDecl
getDeclOf :: Ident -> CT s CDecl
getDeclOf ide :: Ident
ide  = 
  do
    CT s ()
forall s. CT s ()
traceEnter
    CDef
def <- Ident -> CT s CDef
forall s. Ident -> CT s CDef
getDefOf Ident
ide
    case CDef
def of
      UndefCD    -> String -> CT s CDecl
forall a. String -> a
interr "CTrav.getDeclOf: Undefined!"
      DontCareCD -> String -> CT s CDecl
forall a. String -> a
interr "CTrav.getDeclOf: Don't care!"
      TagCD _    -> String -> CT s CDecl
forall a. String -> a
interr "CTrav.getDeclOf: Illegal tag!"
      ObjCD obj :: CObj
obj  -> case CObj
obj of
                      TypeCO    decl :: CDecl
decl -> CT s ()
forall s. CT s ()
traceTypeCO CT s () -> CT s CDecl -> CT s CDecl
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                                        CDecl -> CT s CDecl
forall (m :: * -> *) a. Monad m => a -> m a
return CDecl
decl
                      ObjCO     decl :: CDecl
decl -> CT s ()
forall s. CT s ()
traceObjCO CT s () -> CT s CDecl -> CT s CDecl
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                                        CDecl -> CT s CDecl
forall (m :: * -> *) a. Monad m => a -> m a
return CDecl
decl
                      EnumCO    _ _  -> CT s CDecl
forall a. a
illegalEnum
                      BuiltinCO      -> CT s CDecl
forall a. a
illegalBuiltin
  where
    illegalEnum :: a
illegalEnum    = String -> a
forall a. String -> a
interr "CTrav.getDeclOf: Illegal enum!"
    illegalBuiltin :: a
illegalBuiltin = String -> a
forall a. String -> a
interr "CTrav.getDeclOf: Attempted to get declarator of \
                            \builtin entity!"
                     -- if the latter ever becomes necessary, we have to
                     -- change the representation of builtins and give them
                     -- some dummy declarator
    traceEnter :: CT s ()
traceEnter  = String -> CT s ()
forall s. String -> CT s ()
traceCTrav (String -> CT s ()) -> String -> CT s ()
forall a b. (a -> b) -> a -> b
$ 
                    "Entering `getDeclOf' for `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Ident -> String
identToLexeme Ident
ide 
                    String -> String -> String
forall a. [a] -> [a] -> [a]
++ "'...\n"
    traceTypeCO :: CT s ()
traceTypeCO = String -> CT s ()
forall s. String -> CT s ()
traceCTrav (String -> CT s ()) -> String -> CT s ()
forall a b. (a -> b) -> a -> b
$ 
                    "...found a type object.\n"
    traceObjCO :: CT s ()
traceObjCO  = String -> CT s ()
forall s. String -> CT s ()
traceCTrav (String -> CT s ()) -> String -> CT s ()
forall a b. (a -> b) -> a -> b
$ 
                    "...found a vanilla object.\n"


-- convenience functions
--

-- find a type object in the object name space; returns `nothing' if the
-- identifier is not defined (EXPORTED)
--
--  * if the second argument is `True', use `findObjShadow'
--
findTypeObjMaybe                :: Ident -> Bool -> CT s (Maybe (CObj, Ident))
findTypeObjMaybe :: Ident -> Bool -> CT s (Maybe (CObj, Ident))
findTypeObjMaybe ide :: Ident
ide useShadows :: Bool
useShadows  = 
  do
    Maybe (CObj, Ident)
oobj <- if Bool
useShadows 
            then Ident -> CT s (Maybe (CObj, Ident))
forall s. Ident -> CT s (Maybe (CObj, Ident))
findObjShadow Ident
ide 
            else (Maybe CObj -> Maybe (CObj, Ident))
-> PreCST SwitchBoard (CState s) (Maybe CObj)
-> CT s (Maybe (CObj, Ident))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((CObj -> (CObj, Ident)) -> Maybe CObj -> Maybe (CObj, Ident)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\obj :: CObj
obj -> (CObj
obj, Ident
ide))) (PreCST SwitchBoard (CState s) (Maybe CObj)
 -> CT s (Maybe (CObj, Ident)))
-> PreCST SwitchBoard (CState s) (Maybe CObj)
-> CT s (Maybe (CObj, Ident))
forall a b. (a -> b) -> a -> b
$ Ident -> PreCST SwitchBoard (CState s) (Maybe CObj)
forall s. Ident -> CT s (Maybe CObj)
findObj Ident
ide
    case Maybe (CObj, Ident)
oobj of
      Just obj :: (CObj, Ident)
obj@(TypeCO _ , _) -> Maybe (CObj, Ident) -> CT s (Maybe (CObj, Ident))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (CObj, Ident) -> CT s (Maybe (CObj, Ident)))
-> Maybe (CObj, Ident) -> CT s (Maybe (CObj, Ident))
forall a b. (a -> b) -> a -> b
$ (CObj, Ident) -> Maybe (CObj, Ident)
forall a. a -> Maybe a
Just (CObj, Ident)
obj
      Just obj :: (CObj, Ident)
obj@(BuiltinCO, _) -> Maybe (CObj, Ident) -> CT s (Maybe (CObj, Ident))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (CObj, Ident) -> CT s (Maybe (CObj, Ident)))
-> Maybe (CObj, Ident) -> CT s (Maybe (CObj, Ident))
forall a b. (a -> b) -> a -> b
$ (CObj, Ident) -> Maybe (CObj, Ident)
forall a. a -> Maybe a
Just (CObj, Ident)
obj
      Just _                  -> Ident -> CT s (Maybe (CObj, Ident))
forall s a. Ident -> CT s a
typedefExpectedErr Ident
ide
      Nothing                 -> Maybe (CObj, Ident) -> CT s (Maybe (CObj, Ident))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (CObj, Ident) -> CT s (Maybe (CObj, Ident)))
-> Maybe (CObj, Ident) -> CT s (Maybe (CObj, Ident))
forall a b. (a -> b) -> a -> b
$ Maybe (CObj, Ident)
forall a. Maybe a
Nothing

-- find a type object in the object name space; raises an error and exception
-- if the identifier is not defined (EXPORTED)
--
--  * if the second argument is `True', use `findObjShadow'
--
findTypeObj                :: Ident -> Bool -> CT s (CObj, Ident)
findTypeObj :: Ident -> Bool -> CT s (CObj, Ident)
findTypeObj ide :: Ident
ide useShadows :: Bool
useShadows  = do
  Maybe (CObj, Ident)
oobj <- Ident -> Bool -> CT s (Maybe (CObj, Ident))
forall s. Ident -> Bool -> CT s (Maybe (CObj, Ident))
findTypeObjMaybe Ident
ide Bool
useShadows
  case Maybe (CObj, Ident)
oobj of
    Nothing  -> Ident -> CT s (CObj, Ident)
forall s a. Ident -> CT s a
unknownObjErr Ident
ide
    Just obj :: (CObj, Ident)
obj -> (CObj, Ident) -> CT s (CObj, Ident)
forall (m :: * -> *) a. Monad m => a -> m a
return (CObj, Ident)
obj

-- find an object, function, or enumerator in the object name space; raises an
-- error and exception if the identifier is not defined (EXPORTED)
--
--  * if the second argument is `True', use `findObjShadow'
--
findValueObj                :: Ident -> Bool -> CT s (CObj, Ident)
findValueObj :: Ident -> Bool -> CT s (CObj, Ident)
findValueObj ide :: Ident
ide useShadows :: Bool
useShadows  = 
  do
    Maybe (CObj, Ident)
oobj <- if Bool
useShadows 
            then Ident -> CT s (Maybe (CObj, Ident))
forall s. Ident -> CT s (Maybe (CObj, Ident))
findObjShadow Ident
ide 
            else (Maybe CObj -> Maybe (CObj, Ident))
-> PreCST SwitchBoard (CState s) (Maybe CObj)
-> CT s (Maybe (CObj, Ident))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((CObj -> (CObj, Ident)) -> Maybe CObj -> Maybe (CObj, Ident)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\obj :: CObj
obj -> (CObj
obj, Ident
ide))) (PreCST SwitchBoard (CState s) (Maybe CObj)
 -> CT s (Maybe (CObj, Ident)))
-> PreCST SwitchBoard (CState s) (Maybe CObj)
-> CT s (Maybe (CObj, Ident))
forall a b. (a -> b) -> a -> b
$ Ident -> PreCST SwitchBoard (CState s) (Maybe CObj)
forall s. Ident -> CT s (Maybe CObj)
findObj Ident
ide
    case Maybe (CObj, Ident)
oobj of
      Just obj :: (CObj, Ident)
obj@(ObjCO  _  , _) -> (CObj, Ident) -> CT s (CObj, Ident)
forall (m :: * -> *) a. Monad m => a -> m a
return (CObj, Ident)
obj
      Just obj :: (CObj, Ident)
obj@(EnumCO _ _, _) -> (CObj, Ident) -> CT s (CObj, Ident)
forall (m :: * -> *) a. Monad m => a -> m a
return (CObj, Ident)
obj
      Just _                   -> Position -> CT s (CObj, Ident)
forall s a. Position -> CT s a
unexpectedTypedefErr (Ident -> Position
forall a. Pos a => a -> Position
posOf Ident
ide)
      Nothing                  -> Ident -> CT s (CObj, Ident)
forall s a. Ident -> CT s a
unknownObjErr Ident
ide

-- find a function in the object name space; raises an error and exception if
-- the identifier is not defined (EXPORTED) 
--
--  * if the second argument is `True', use `findObjShadow'
--
findFunObj               :: Ident -> Bool -> CT s  (CObj, Ident)
findFunObj :: Ident -> Bool -> CT s (CObj, Ident)
findFunObj ide :: Ident
ide useShadows :: Bool
useShadows = 
  do
    (obj :: CObj
obj, ide' :: Ident
ide') <- Ident -> Bool -> CT s (CObj, Ident)
forall s. Ident -> Bool -> CT s (CObj, Ident)
findValueObj Ident
ide Bool
useShadows
    case CObj
obj of
      EnumCO _ _  -> Position -> CT s (CObj, Ident)
forall s a. Position -> CT s a
funExpectedErr (Ident -> Position
forall a. Pos a => a -> Position
posOf Ident
ide)
      ObjCO  decl :: CDecl
decl -> do
                       let declr :: CDeclr
declr = Ident
ide' Ident -> CDecl -> CDeclr
`declrFromDecl` CDecl
decl
                       Position -> CDeclr -> CT s ()
forall s. Position -> CDeclr -> CT s ()
assertFunDeclr (Ident -> Position
forall a. Pos a => a -> Position
posOf Ident
ide) CDeclr
declr
                       (CObj, Ident) -> CT s (CObj, Ident)
forall (m :: * -> *) a. Monad m => a -> m a
return (CObj
obj, Ident
ide')


-- C structure tree query routines
-- -------------------------------

-- test if this is a type definition specification (EXPORTED)
--
isTypedef                   :: CDecl -> Bool
isTypedef :: CDecl -> Bool
isTypedef (CDecl specs :: [CDeclSpec]
specs _ _)  = 
  Bool -> Bool
not (Bool -> Bool) -> ([()] -> Bool) -> [()] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [()] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([()] -> Bool) -> [()] -> Bool
forall a b. (a -> b) -> a -> b
$ [() | CStorageSpec (CTypedef _) <- [CDeclSpec]
specs]

-- discard all declarators but the one declaring the given identifier
-- (EXPORTED) 
--
--  * the declaration must contain the identifier
--
simplifyDecl :: Ident -> CDecl -> CDecl
ide :: Ident
ide simplifyDecl :: Ident -> CDecl -> CDecl
`simplifyDecl` (CDecl specs :: [CDeclSpec]
specs declrs :: [(Maybe CDeclr, Maybe CInit, Maybe CExpr)]
declrs at :: Attrs
at) =
  case ((Maybe CDeclr, Maybe CInit, Maybe CExpr) -> Bool)
-> [(Maybe CDeclr, Maybe CInit, Maybe CExpr)]
-> Maybe (Maybe CDeclr, Maybe CInit, Maybe CExpr)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Maybe CDeclr, Maybe CInit, Maybe CExpr) -> Ident -> Bool
forall b c. (Maybe CDeclr, b, c) -> Ident -> Bool
`declrPlusNamed` Ident
ide) [(Maybe CDeclr, Maybe CInit, Maybe CExpr)]
declrs of
    Nothing    -> CDecl
forall a. a
err
    Just declr :: (Maybe CDeclr, Maybe CInit, Maybe CExpr)
declr -> [CDeclSpec]
-> [(Maybe CDeclr, Maybe CInit, Maybe CExpr)] -> Attrs -> CDecl
CDecl [CDeclSpec]
specs [(Maybe CDeclr, Maybe CInit, Maybe CExpr)
declr] Attrs
at
  where
    (Just declr :: CDeclr
declr, _, _) declrPlusNamed :: (Maybe CDeclr, b, c) -> Ident -> Bool
`declrPlusNamed` ide :: Ident
ide = CDeclr
declr CDeclr -> Ident -> Bool
`declrNamed` Ident
ide
    _                  `declrPlusNamed` _   = Bool
False
    --
    err :: a
err = String -> a
forall a. String -> a
interr (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ "CTrav.simplifyDecl: Wrong C object!\n\
                   \  Looking for `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Ident -> String
identToLexeme Ident
ide String -> String -> String
forall a. [a] -> [a] -> [a]
++ "' in decl \
                   \at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Position -> String
forall a. Show a => a -> String
show (Attrs -> Position
forall a. Pos a => a -> Position
posOf Attrs
at)

-- extract the declarator that declares the given identifier (EXPORTED)
--
--  * the declaration must contain the identifier
--
declrFromDecl            :: Ident -> CDecl -> CDeclr
ide :: Ident
ide declrFromDecl :: Ident -> CDecl -> CDeclr
`declrFromDecl` decl :: CDecl
decl  = 
  let CDecl _ [(Just declr :: CDeclr
declr, _, _)] _ = Ident
ide Ident -> CDecl -> CDecl
`simplifyDecl` CDecl
decl
  in
  CDeclr
declr

-- tests whether the given declarator has the given name (EXPORTED)
--
declrNamed             :: CDeclr -> Ident -> Bool
declr :: CDeclr
declr declrNamed :: CDeclr -> Ident -> Bool
`declrNamed` ide :: Ident
ide  = CDeclr -> Maybe Ident
declrName CDeclr
declr Maybe Ident -> Maybe Ident -> Bool
forall a. Eq a => a -> a -> Bool
== Ident -> Maybe Ident
forall a. a -> Maybe a
Just Ident
ide

-- get the declarator of a declaration that has at most one declarator
-- (EXPORTED) 
--
declaredDeclr                              :: CDecl -> Maybe CDeclr
declaredDeclr :: CDecl -> Maybe CDeclr
declaredDeclr (CDecl _ []               _)  = Maybe CDeclr
forall a. Maybe a
Nothing
declaredDeclr (CDecl _ [(odeclr :: Maybe CDeclr
odeclr, _, _)] _)  = Maybe CDeclr
odeclr
declaredDeclr decl :: CDecl
decl                          = 
  String -> Maybe CDeclr
forall a. String -> a
interr (String -> Maybe CDeclr) -> String -> Maybe CDeclr
forall a b. (a -> b) -> a -> b
$ "CTrav.declaredDeclr: Too many declarators!\n\
           \  Declaration at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Position -> String
forall a. Show a => a -> String
show (CDecl -> Position
forall a. Pos a => a -> Position
posOf CDecl
decl)

-- get the name declared by a declaration that has exactly one declarator
-- (EXPORTED) 
--
declaredName      :: CDecl -> Maybe Ident
declaredName :: CDecl -> Maybe Ident
declaredName decl :: CDecl
decl  = CDecl -> Maybe CDeclr
declaredDeclr CDecl
decl Maybe CDeclr -> (CDeclr -> Maybe Ident) -> Maybe Ident
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CDeclr -> Maybe Ident
declrName

-- obtains the member definitions and the tag of a struct (EXPORTED)
--
--  * member definitions are expanded
--
structMembers :: CStructUnion -> ([CDecl], CStructTag)
structMembers :: CStructUnion -> ([CDecl], CStructTag)
structMembers (CStruct tag :: CStructTag
tag _ members :: [CDecl]
members _) = ([[CDecl]] -> [CDecl]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[CDecl]] -> [CDecl])
-> ([CDecl] -> [[CDecl]]) -> [CDecl] -> [CDecl]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CDecl -> [CDecl]) -> [CDecl] -> [[CDecl]]
forall a b. (a -> b) -> [a] -> [b]
map CDecl -> [CDecl]
expandDecl ([CDecl] -> [CDecl]) -> [CDecl] -> [CDecl]
forall a b. (a -> b) -> a -> b
$ [CDecl]
members,
                                           CStructTag
tag)

-- expand declarators declaring more than one identifier into multiple
-- declarators, eg, `int x, y;' becomes `int x; int y;' (EXPORTED)
--
expandDecl                        :: CDecl -> [CDecl]
expandDecl :: CDecl -> [CDecl]
expandDecl (CDecl specs :: [CDeclSpec]
specs decls :: [(Maybe CDeclr, Maybe CInit, Maybe CExpr)]
decls at :: Attrs
at)  = 
  ((Maybe CDeclr, Maybe CInit, Maybe CExpr) -> CDecl)
-> [(Maybe CDeclr, Maybe CInit, Maybe CExpr)] -> [CDecl]
forall a b. (a -> b) -> [a] -> [b]
map (\decl :: (Maybe CDeclr, Maybe CInit, Maybe CExpr)
decl -> [CDeclSpec]
-> [(Maybe CDeclr, Maybe CInit, Maybe CExpr)] -> Attrs -> CDecl
CDecl [CDeclSpec]
specs [(Maybe CDeclr, Maybe CInit, Maybe CExpr)
decl] Attrs
at) [(Maybe CDeclr, Maybe CInit, Maybe CExpr)]
decls

-- get a struct's name (EXPORTED)
--
structName                      :: CStructUnion -> Maybe Ident
structName :: CStructUnion -> Maybe Ident
structName (CStruct _ oide :: Maybe Ident
oide _ _)  = Maybe Ident
oide

-- get an enum's name (EXPORTED)
--
enumName                  :: CEnum -> Maybe Ident
enumName :: CEnum -> Maybe Ident
enumName (CEnum oide :: Maybe Ident
oide _ _)  = Maybe Ident
oide

-- get a tag's name (EXPORTED)
--
--  * fail if the tag is anonymous
--
tagName     :: CTag -> Ident
tagName :: CTag -> Ident
tagName tag :: CTag
tag  =
  case CTag
tag of
   StructUnionCT struct :: CStructUnion
struct -> Ident -> (Ident -> Ident) -> Maybe Ident -> Ident
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Ident
forall a. a
err Ident -> Ident
forall a. a -> a
id (Maybe Ident -> Ident) -> Maybe Ident -> Ident
forall a b. (a -> b) -> a -> b
$ CStructUnion -> Maybe Ident
structName CStructUnion
struct
   EnumCT        enum :: CEnum
enum   -> Ident -> (Ident -> Ident) -> Maybe Ident -> Ident
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Ident
forall a. a
err Ident -> Ident
forall a. a -> a
id (Maybe Ident -> Ident) -> Maybe Ident -> Ident
forall a b. (a -> b) -> a -> b
$ CEnum -> Maybe Ident
enumName   CEnum
enum
  where
    err :: a
err = String -> a
forall a. String -> a
interr "CTrav.tagName: Anonymous tag definition"

-- checks whether the given declarator defines an object that is a pointer to
-- some other type (EXPORTED)
--
--  * as far as parameter passing is concerned, arrays are also pointer
--
isPtrDeclr                                 :: CDeclr -> Bool
isPtrDeclr :: CDeclr -> Bool
isPtrDeclr (CPtrDeclr _ (CVarDeclr _ _)   _)  = Bool
True
isPtrDeclr (CPtrDeclr _ declr :: CDeclr
declr             _)  = CDeclr -> Bool
isPtrDeclr CDeclr
declr
isPtrDeclr (CArrDeclr (CVarDeclr _ _) _ _ _)  = Bool
True
isPtrDeclr (CArrDeclr declr :: CDeclr
declr _ _           _)  = CDeclr -> Bool
isPtrDeclr CDeclr
declr
isPtrDeclr (CFunDeclr declr :: CDeclr
declr _ _           _)  = CDeclr -> Bool
isPtrDeclr CDeclr
declr
isPtrDeclr _                                  = Bool
False

-- checks whether the given declarator defines an object that is an array of
-- some other type (EXPORTED)
--
--  * difference between arrays and pure pointers is important for size
--   calculations
--
isArrDeclr                                 :: CDeclr -> Bool
isArrDeclr :: CDeclr -> Bool
isArrDeclr (CArrDeclr declr :: CDeclr
declr _ _         _)  = Bool
True
isArrDeclr _                                = Bool
False

-- drops the first pointer level from the given declarator (EXPORTED)
--
--  * the declarator must declare a pointer object
--
-- FIXME: this implementation isn't nice, because we retain the `CVarDeclr'
--        unchanged; as the declarator is changed, we should maybe make this
--        into an anonymous declarator and also change its attributes
--
dropPtrDeclr                                          :: CDeclr -> CDeclr
dropPtrDeclr :: CDeclr -> CDeclr
dropPtrDeclr (CPtrDeclr qs :: [CTypeQual]
qs declr :: CDeclr
declr@(CVarDeclr _ _) ats :: Attrs
ats)  = CDeclr
declr
dropPtrDeclr (CPtrDeclr qs :: [CTypeQual]
qs  declr :: CDeclr
declr                ats :: Attrs
ats)  = 
  let declr' :: CDeclr
declr' = CDeclr -> CDeclr
dropPtrDeclr CDeclr
declr
  in
  [CTypeQual] -> CDeclr -> Attrs -> CDeclr
CPtrDeclr [CTypeQual]
qs CDeclr
declr' Attrs
ats
dropPtrDeclr (CArrDeclr declr :: CDeclr
declr@(CVarDeclr _ _) _ _ _)   = CDeclr
declr
dropPtrDeclr (CArrDeclr declr :: CDeclr
declr                tq :: [CTypeQual]
tq e :: Maybe CExpr
e ats :: Attrs
ats) =
  let declr' :: CDeclr
declr' = CDeclr -> CDeclr
dropPtrDeclr CDeclr
declr
  in
  CDeclr -> [CTypeQual] -> Maybe CExpr -> Attrs -> CDeclr
CArrDeclr CDeclr
declr' [CTypeQual]
tq Maybe CExpr
e Attrs
ats
dropPtrDeclr (CFunDeclr declr :: CDeclr
declr args :: [CDecl]
args vari :: Bool
vari         ats :: Attrs
ats)   =
  let declr' :: CDeclr
declr' = CDeclr -> CDeclr
dropPtrDeclr CDeclr
declr
  in
  CDeclr -> [CDecl] -> Bool -> Attrs -> CDeclr
CFunDeclr CDeclr
declr' [CDecl]
args Bool
vari Attrs
ats
dropPtrDeclr _                                         =
  String -> CDeclr
forall a. String -> a
interr "CTrav.dropPtrDeclr: No pointer!"

-- checks whether the given declaration defines a pointer object (EXPORTED)
--
--  * there may only be a single declarator in the declaration
--
isPtrDecl                                  :: CDecl -> Bool
isPtrDecl :: CDecl -> Bool
isPtrDecl (CDecl _ []                   _)  = Bool
False
isPtrDecl (CDecl _ [(Just declr :: CDeclr
declr, _, _)] _)  = CDeclr -> Bool
isPtrDeclr CDeclr
declr
isPtrDecl _                                 =
  String -> Bool
forall a. String -> a
interr "CTrav.isPtrDecl: There was more than one declarator!"

-- checks whether the given declarator defines a function object (EXPORTED)
--
isFunDeclr                                   :: CDeclr -> Bool
isFunDeclr :: CDeclr -> Bool
isFunDeclr (CPtrDeclr _ declr :: CDeclr
declr             _)  = CDeclr -> Bool
isFunDeclr CDeclr
declr
isFunDeclr (CArrDeclr declr :: CDeclr
declr _ _           _)  = CDeclr -> Bool
isFunDeclr CDeclr
declr
isFunDeclr (CFunDeclr (CVarDeclr _ _) _ _ _)  = Bool
True
isFunDeclr (CFunDeclr declr :: CDeclr
declr _ _           _)  = CDeclr -> Bool
isFunDeclr CDeclr
declr
isFunDeclr _                                  = Bool
False

-- extract the structure from the type specifiers of a declaration (EXPORTED)
--
structFromDecl                       :: Position -> CDecl -> CT s CStructUnion
structFromDecl :: Position -> CDecl -> CT s CStructUnion
structFromDecl pos :: Position
pos (CDecl specs :: [CDeclSpec]
specs _ _)  =
  case [CTypeSpec] -> CTypeSpec
forall a. [a] -> a
head [CTypeSpec
ts | CTypeSpec ts :: CTypeSpec
ts <- [CDeclSpec]
specs] of
    CSUType su :: CStructUnion
su _ -> Position -> CTag -> CT s CStructUnion
forall s. Position -> CTag -> CT s CStructUnion
extractStruct Position
pos (CStructUnion -> CTag
StructUnionCT CStructUnion
su)
    _            -> Position -> CT s CStructUnion
forall s a. Position -> CT s a
structExpectedErr Position
pos

-- extracts the arguments from a function declaration (must be a unique
-- declarator) and constructs a declaration for the result of the function
-- (EXPORTED) 
--
--  * the boolean result indicates whether the function is variadic
--
funResultAndArgs :: CDecl -> ([CDecl], CDecl, Bool)
funResultAndArgs :: CDecl -> ([CDecl], CDecl, Bool)
funResultAndArgs (CDecl specs :: [CDeclSpec]
specs [(Just declr :: CDeclr
declr, _, _)] _) =
  let (args :: [CDecl]
args, declr' :: CDeclr
declr', variadic :: Bool
variadic) = CDeclr -> ([CDecl], CDeclr, Bool)
funArgs CDeclr
declr
      result :: CDecl
result                   = [CDeclSpec]
-> [(Maybe CDeclr, Maybe CInit, Maybe CExpr)] -> Attrs -> CDecl
CDecl [CDeclSpec]
specs [(CDeclr -> Maybe CDeclr
forall a. a -> Maybe a
Just CDeclr
declr', Maybe CInit
forall a. Maybe a
Nothing, Maybe CExpr
forall a. Maybe a
Nothing)]
                                       (Position -> Attrs
newAttrsOnlyPos Position
nopos)
  in
  ([CDecl]
args, CDecl
result, Bool
variadic)
  where
    funArgs :: CDeclr -> ([CDecl], CDeclr, Bool)
funArgs (CFunDeclr var :: CDeclr
var@(CVarDeclr _ _) args :: [CDecl]
args variadic :: Bool
variadic  _) = 
      ([CDecl]
args, CDeclr
var, Bool
variadic)
    funArgs (CPtrDeclr qs :: [CTypeQual]
qs declr :: CDeclr
declr                          at :: Attrs
at) = 
      let (args :: [CDecl]
args, declr' :: CDeclr
declr', variadic :: Bool
variadic) = CDeclr -> ([CDecl], CDeclr, Bool)
funArgs CDeclr
declr
      in
      ([CDecl]
args, [CTypeQual] -> CDeclr -> Attrs -> CDeclr
CPtrDeclr [CTypeQual]
qs CDeclr
declr' Attrs
at, Bool
variadic)
    funArgs (CArrDeclr declr :: CDeclr
declr tqs :: [CTypeQual]
tqs oe :: Maybe CExpr
oe                      at :: Attrs
at) =
      let (args :: [CDecl]
args, declr' :: CDeclr
declr', variadic :: Bool
variadic) = CDeclr -> ([CDecl], CDeclr, Bool)
funArgs CDeclr
declr
      in
      ([CDecl]
args, CDeclr -> [CTypeQual] -> Maybe CExpr -> Attrs -> CDeclr
CArrDeclr CDeclr
declr' [CTypeQual]
tqs Maybe CExpr
oe Attrs
at, Bool
variadic)
    funArgs (CFunDeclr declr :: CDeclr
declr args :: [CDecl]
args var :: Bool
var                    at :: Attrs
at) =
      let (args :: [CDecl]
args, declr' :: CDeclr
declr', variadic :: Bool
variadic) = CDeclr -> ([CDecl], CDeclr, Bool)
funArgs CDeclr
declr
      in
      ([CDecl]
args, CDeclr -> [CDecl] -> Bool -> Attrs -> CDeclr
CFunDeclr CDeclr
declr' [CDecl]
args Bool
var Attrs
at, Bool
variadic)
    funArgs _                                           =
      String -> ([CDecl], CDeclr, Bool)
forall a. String -> a
interr "CTrav.funResultAndArgs: Illegal declarator!"

-- name chasing
--

-- find the declarator identified by the given identifier; if the declarator
-- is itself only a `typedef'ed name, the operation recursively searches for
-- the declarator associated with that name (this is called ``typedef
-- chasing'') (EXPORTED)
--
--  * if `ind = True', we have to hop over one indirection
--
--  * remove all declarators except the one we just looked up
--
chaseDecl         :: Ident -> Bool -> CT s CDecl
--
--  * cycles are no issue, as they cannot occur in a correct C header (we would 
--   have spotted the problem during name analysis)
--
chaseDecl :: Ident -> Bool -> CT s CDecl
chaseDecl ide :: Ident
ide ind :: Bool
ind  = 
  do
    CT s ()
forall s. CT s ()
traceEnter
    CDecl
cdecl     <- Ident -> CT s CDecl
forall s. Ident -> CT s CDecl
getDeclOf Ident
ide
    let sdecl :: CDecl
sdecl  = Ident
ide Ident -> CDecl -> CDecl
`simplifyDecl` CDecl
cdecl
    case CDecl -> Bool -> Maybe (Ident, Bool)
extractAlias CDecl
sdecl Bool
ind of
      Just    (ide' :: Ident
ide', ind' :: Bool
ind') -> Ident -> Bool -> CT s CDecl
forall s. Ident -> Bool -> CT s CDecl
chaseDecl Ident
ide' Bool
ind'
      Nothing              -> CDecl -> CT s CDecl
forall (m :: * -> *) a. Monad m => a -> m a
return CDecl
sdecl
  where
    traceEnter :: CT s ()
traceEnter = String -> CT s ()
forall s. String -> CT s ()
traceCTrav (String -> CT s ()) -> String -> CT s ()
forall a b. (a -> b) -> a -> b
$ 
                   "Entering `chaseDecl' for `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Ident -> String
identToLexeme Ident
ide 
                   String -> String -> String
forall a. [a] -> [a] -> [a]
++ "' " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (if Bool
ind then "" else "not ") 
                   String -> String -> String
forall a. [a] -> [a] -> [a]
++ "following indirections...\n"

-- find type object in object name space and then chase it (EXPORTED)
--
--  * see also `chaseDecl'
--
--  * also create an object association from the given identifier to the object
--   that it _directly_ represents
--
--  * if the third argument is `True', use `findObjShadow'
--
findAndChaseDecl                    :: Ident -> Bool -> Bool -> CT s CDecl
findAndChaseDecl :: Ident -> Bool -> Bool -> CT s CDecl
findAndChaseDecl ide :: Ident
ide ind :: Bool
ind useShadows :: Bool
useShadows  =
  do
    (obj :: CObj
obj, ide' :: Ident
ide') <- Ident -> Bool -> CT s (CObj, Ident)
forall s. Ident -> Bool -> CT s (CObj, Ident)
findTypeObj Ident
ide Bool
useShadows   -- is there an object def?
    Ident
ide  Ident -> CDef -> CT s ()
forall s. Ident -> CDef -> CT s ()
`refersToNewDef` CObj -> CDef
ObjCD CObj
obj
    Ident
ide' Ident -> CDef -> CT s ()
forall s. Ident -> CDef -> CT s ()
`refersToNewDef` CObj -> CDef
ObjCD CObj
obj             -- assoc needed for chasing
    Ident -> Bool -> CT s CDecl
forall s. Ident -> Bool -> CT s CDecl
chaseDecl Ident
ide' Bool
ind

-- given a declaration (which must have exactly one declarator), if the
-- declarator is an alias, chase it to the actual declaration (EXPORTED)
--
checkForAlias      :: CDecl -> CT s (Maybe CDecl)
checkForAlias :: CDecl -> CT s (Maybe CDecl)
checkForAlias decl :: CDecl
decl  =
  case CDecl -> Bool -> Maybe (Ident, Bool)
extractAlias CDecl
decl Bool
False of
    Nothing        -> Maybe CDecl -> CT s (Maybe CDecl)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CDecl
forall a. Maybe a
Nothing
    Just (ide' :: Ident
ide', _) -> (CDecl -> Maybe CDecl)
-> PreCST SwitchBoard (CState s) CDecl -> CT s (Maybe CDecl)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CDecl -> Maybe CDecl
forall a. a -> Maybe a
Just (PreCST SwitchBoard (CState s) CDecl -> CT s (Maybe CDecl))
-> PreCST SwitchBoard (CState s) CDecl -> CT s (Maybe CDecl)
forall a b. (a -> b) -> a -> b
$ Ident -> Bool -> PreCST SwitchBoard (CState s) CDecl
forall s. Ident -> Bool -> CT s CDecl
chaseDecl Ident
ide' Bool
False

-- given a declaration (which must have exactly one declarator), if the
-- declarator is an alias, yield the alias name; *no* chasing (EXPORTED)
--
checkForOneAliasName      :: CDecl -> Maybe Ident
checkForOneAliasName :: CDecl -> Maybe Ident
checkForOneAliasName decl :: CDecl
decl  = ((Ident, Bool) -> Ident) -> Maybe (Ident, Bool) -> Maybe Ident
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Ident, Bool) -> Ident
forall a b. (a, b) -> a
fst (Maybe (Ident, Bool) -> Maybe Ident)
-> Maybe (Ident, Bool) -> Maybe Ident
forall a b. (a -> b) -> a -> b
$ CDecl -> Bool -> Maybe (Ident, Bool)
extractAlias CDecl
decl Bool
False


-- smart lookup
--

-- for the given identifier, either find an enumeration in the tag name space
-- or a type definition referring to an enumeration in the object name space;
-- raises an error and exception if the identifier is not defined (EXPORTED)
--
--  * if the second argument is `True', use `findTagShadow'
--
lookupEnum               :: Ident -> Bool -> CT s CEnum
lookupEnum :: Ident -> Bool -> CT s CEnum
lookupEnum ide :: Ident
ide useShadows :: Bool
useShadows =
  do
    Maybe CTag
otag <- if Bool
useShadows 
            then (Maybe (CTag, Ident) -> Maybe CTag)
-> PreCST SwitchBoard (CState s) (Maybe (CTag, Ident))
-> PreCST SwitchBoard (CState s) (Maybe CTag)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (((CTag, Ident) -> CTag) -> Maybe (CTag, Ident) -> Maybe CTag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CTag, Ident) -> CTag
forall a b. (a, b) -> a
fst) (PreCST SwitchBoard (CState s) (Maybe (CTag, Ident))
 -> PreCST SwitchBoard (CState s) (Maybe CTag))
-> PreCST SwitchBoard (CState s) (Maybe (CTag, Ident))
-> PreCST SwitchBoard (CState s) (Maybe CTag)
forall a b. (a -> b) -> a -> b
$ Ident -> PreCST SwitchBoard (CState s) (Maybe (CTag, Ident))
forall s. Ident -> CT s (Maybe (CTag, Ident))
findTagShadow Ident
ide
            else Ident -> PreCST SwitchBoard (CState s) (Maybe CTag)
forall s. Ident -> CT s (Maybe CTag)
findTag Ident
ide
    case Maybe CTag
otag of
      Just (StructUnionCT _   ) -> Ident -> CT s CEnum
forall s a. Ident -> CT s a
enumExpectedErr Ident
ide  -- wrong tag definition
      Just (EnumCT        enum :: CEnum
enum) -> CEnum -> CT s CEnum
forall (m :: * -> *) a. Monad m => a -> m a
return CEnum
enum          -- enum tag definition
      Nothing                   -> do                   -- no tag definition
        (CDecl specs :: [CDeclSpec]
specs _ _) <- Ident -> Bool -> Bool -> CT s CDecl
forall s. Ident -> Bool -> Bool -> CT s CDecl
findAndChaseDecl Ident
ide Bool
False Bool
useShadows
        case [CTypeSpec] -> CTypeSpec
forall a. [a] -> a
head [CTypeSpec
ts | CTypeSpec ts :: CTypeSpec
ts <- [CDeclSpec]
specs] of
          CEnumType enum :: CEnum
enum _ -> CEnum -> CT s CEnum
forall (m :: * -> *) a. Monad m => a -> m a
return CEnum
enum
          _                -> Ident -> CT s CEnum
forall s a. Ident -> CT s a
enumExpectedErr Ident
ide

-- for the given identifier, either find a struct/union in the tag name space
-- or a type definition referring to a struct/union in the object name space;
-- raises an error and exception if the identifier is not defined (EXPORTED)
--
--  * if `ind = True', the identifier names a reference type to the searched
--   for struct/union
--
--  * typedef chasing is used only if there is no tag of the same name or an
--   indirection (ie, `ind = True') is explicitly required
--
--  * if the third argument is `True', use `findTagShadow'
--
--  * when finding a forward definition of a tag, follow it to the real
--   definition
--
lookupStructUnion :: Ident -> Bool -> Bool -> CT s CStructUnion
lookupStructUnion :: Ident -> Bool -> Bool -> CT s CStructUnion
lookupStructUnion ide :: Ident
ide ind :: Bool
ind useShadows :: Bool
useShadows
  | Bool
ind       = CT s CStructUnion
forall s. PreCST SwitchBoard (CState s) CStructUnion
chase
  | Bool
otherwise =
    do
      Maybe CTag
otag <- if Bool
useShadows 
              then (Maybe (CTag, Ident) -> Maybe CTag)
-> PreCST SwitchBoard (CState s) (Maybe (CTag, Ident))
-> PreCST SwitchBoard (CState s) (Maybe CTag)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (((CTag, Ident) -> CTag) -> Maybe (CTag, Ident) -> Maybe CTag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CTag, Ident) -> CTag
forall a b. (a, b) -> a
fst) (PreCST SwitchBoard (CState s) (Maybe (CTag, Ident))
 -> PreCST SwitchBoard (CState s) (Maybe CTag))
-> PreCST SwitchBoard (CState s) (Maybe (CTag, Ident))
-> PreCST SwitchBoard (CState s) (Maybe CTag)
forall a b. (a -> b) -> a -> b
$ Ident -> PreCST SwitchBoard (CState s) (Maybe (CTag, Ident))
forall s. Ident -> CT s (Maybe (CTag, Ident))
findTagShadow Ident
ide
              else Ident -> PreCST SwitchBoard (CState s) (Maybe CTag)
forall s. Ident -> CT s (Maybe CTag)
findTag Ident
ide
      CT s CStructUnion
-> (CTag -> CT s CStructUnion) -> Maybe CTag -> CT s CStructUnion
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CT s CStructUnion
forall s. PreCST SwitchBoard (CState s) CStructUnion
chase (Position -> CTag -> CT s CStructUnion
forall s. Position -> CTag -> CT s CStructUnion
extractStruct (Ident -> Position
forall a. Pos a => a -> Position
posOf Ident
ide)) Maybe CTag
otag  -- `chase' if `Nothing'
  where
    chase :: PreCST SwitchBoard (CState s) CStructUnion
chase =
      do
        CDecl
decl <- Ident -> Bool -> Bool -> CT s CDecl
forall s. Ident -> Bool -> Bool -> CT s CDecl
findAndChaseDecl Ident
ide Bool
ind Bool
useShadows
        Position -> CDecl -> PreCST SwitchBoard (CState s) CStructUnion
forall s. Position -> CDecl -> CT s CStructUnion
structFromDecl (Ident -> Position
forall a. Pos a => a -> Position
posOf Ident
ide) CDecl
decl

-- for the given identifier, check for the existance of both a type definition
-- or a struct, union, or enum definition (EXPORTED)
--
--  * if a typedef and a tag exists, the typedef takes precedence
--
--  * typedefs are chased
--
--  * if the second argument is `True', look for shadows, too
--
lookupDeclOrTag                :: Ident -> Bool -> CT s (Either CDecl CTag)
lookupDeclOrTag :: Ident -> Bool -> CT s (Either CDecl CTag)
lookupDeclOrTag ide :: Ident
ide useShadows :: Bool
useShadows  = do
  Maybe (CObj, Ident)
oobj <- Ident -> Bool -> CT s (Maybe (CObj, Ident))
forall s. Ident -> Bool -> CT s (Maybe (CObj, Ident))
findTypeObjMaybe Ident
ide Bool
useShadows
  case Maybe (CObj, Ident)
oobj of
    Just (_, ide :: Ident
ide) -> (CDecl -> Either CDecl CTag)
-> PreCST SwitchBoard (CState s) CDecl -> CT s (Either CDecl CTag)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CDecl -> Either CDecl CTag
forall a b. a -> Either a b
Left (PreCST SwitchBoard (CState s) CDecl -> CT s (Either CDecl CTag))
-> PreCST SwitchBoard (CState s) CDecl -> CT s (Either CDecl CTag)
forall a b. (a -> b) -> a -> b
$ Ident -> Bool -> Bool -> PreCST SwitchBoard (CState s) CDecl
forall s. Ident -> Bool -> Bool -> CT s CDecl
findAndChaseDecl Ident
ide Bool
False Bool
False 
                                                   -- already did check shadows
    Nothing       -> do
                       Maybe CTag
otag <- if Bool
useShadows 
                               then (Maybe (CTag, Ident) -> Maybe CTag)
-> PreCST SwitchBoard (CState s) (Maybe (CTag, Ident))
-> PreCST SwitchBoard (CState s) (Maybe CTag)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (((CTag, Ident) -> CTag) -> Maybe (CTag, Ident) -> Maybe CTag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CTag, Ident) -> CTag
forall a b. (a, b) -> a
fst) (PreCST SwitchBoard (CState s) (Maybe (CTag, Ident))
 -> PreCST SwitchBoard (CState s) (Maybe CTag))
-> PreCST SwitchBoard (CState s) (Maybe (CTag, Ident))
-> PreCST SwitchBoard (CState s) (Maybe CTag)
forall a b. (a -> b) -> a -> b
$ Ident -> PreCST SwitchBoard (CState s) (Maybe (CTag, Ident))
forall s. Ident -> CT s (Maybe (CTag, Ident))
findTagShadow Ident
ide
                               else Ident -> PreCST SwitchBoard (CState s) (Maybe CTag)
forall s. Ident -> CT s (Maybe CTag)
findTag Ident
ide
                       case Maybe CTag
otag of
                         Nothing  -> Ident -> CT s (Either CDecl CTag)
forall s a. Ident -> CT s a
unknownObjErr Ident
ide
                         Just tag :: CTag
tag -> Either CDecl CTag -> CT s (Either CDecl CTag)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either CDecl CTag -> CT s (Either CDecl CTag))
-> Either CDecl CTag -> CT s (Either CDecl CTag)
forall a b. (a -> b) -> a -> b
$ CTag -> Either CDecl CTag
forall a b. b -> Either a b
Right CTag
tag


-- auxiliary routines (internal)
--

-- if the given declaration (which may have at most one declarator) is a
-- `typedef' alias, yield the referenced name
--
--  * a `typedef' alias has one of the following forms
--
--     <specs> at  x, ...;
--     <specs> at *x, ...;
--
--   where `at' is the alias type, which has been defined by a `typedef', and
--   <specs> are arbitrary specifiers and qualifiers.  Note that `x' may be a
--   variable, a type name (if `typedef' is in <specs>), or be entirely
--   omitted.
--
--  * if `ind = True', the alias may be via an indirection
--
--  * if `ind = True' and the alias is _not_ over an indirection, yield `True'; 
--   otherwise `False' (ie, the ability to hop over an indirection is consumed)
--
--  * this may be an anonymous declaration, ie, the name in `CVarDeclr' may be
--   omitted or there may be no declarator at all
--
extractAlias :: CDecl -> Bool -> Maybe (Ident, Bool)
extractAlias :: CDecl -> Bool -> Maybe (Ident, Bool)
extractAlias decl :: CDecl
decl@(CDecl specs :: [CDeclSpec]
specs _ _) ind :: Bool
ind =
  case [CTypeSpec
ts | CTypeSpec ts :: CTypeSpec
ts <- [CDeclSpec]
specs] of
    [CTypeDef ide' :: Ident
ide' _] ->                        -- type spec is aliased ident
      case CDecl -> Maybe CDeclr
declaredDeclr CDecl
decl of
        Nothing                                -> (Ident, Bool) -> Maybe (Ident, Bool)
forall a. a -> Maybe a
Just (Ident
ide', Bool
ind)
        Just (CVarDeclr _ _                  ) -> (Ident, Bool) -> Maybe (Ident, Bool)
forall a. a -> Maybe a
Just (Ident
ide', Bool
ind)
        Just (CPtrDeclr [_] (CVarDeclr _ _) _)
          | Bool
ind                                -> (Ident, Bool) -> Maybe (Ident, Bool)
forall a. a -> Maybe a
Just (Ident
ide', Bool
False)
          | Bool
otherwise                          -> Maybe (Ident, Bool)
forall a. Maybe a
Nothing
        _                                      -> Maybe (Ident, Bool)
forall a. Maybe a
Nothing
    _                 -> Maybe (Ident, Bool)
forall a. Maybe a
Nothing

-- if the given tag is a forward declaration of a structure, follow the
-- reference to the full declaration
--
--  * the recursive call is not dangerous as there can't be any cycles
--
extractStruct                        :: Position -> CTag -> CT s CStructUnion
extractStruct :: Position -> CTag -> CT s CStructUnion
extractStruct pos :: Position
pos (EnumCT        _ )  = Position -> CT s CStructUnion
forall s a. Position -> CT s a
structExpectedErr Position
pos
extractStruct pos :: Position
pos (StructUnionCT su :: CStructUnion
su)  =
  case CStructUnion
su of
    CStruct _ (Just ide' :: Ident
ide') [] _ -> do            -- found forward definition
                                    CDef
def <- Ident -> CT s CDef
forall s. Ident -> CT s CDef
getDefOf Ident
ide'
                                    case CDef
def of
                                      TagCD tag :: CTag
tag -> Position -> CTag -> CT s CStructUnion
forall s. Position -> CTag -> CT s CStructUnion
extractStruct Position
pos CTag
tag
                                      _         -> CT s CStructUnion
forall a. a
err
    _                          -> CStructUnion -> CT s CStructUnion
forall (m :: * -> *) a. Monad m => a -> m a
return CStructUnion
su
  where
    err :: a
err = String -> a
forall a. String -> a
interr "CTrav.extractStruct: Illegal reference!"

-- yield the name declared by a declarator if any
--
declrName                          :: CDeclr -> Maybe Ident
declrName :: CDeclr -> Maybe Ident
declrName (CVarDeclr oide :: Maybe Ident
oide       _)  = Maybe Ident
oide
declrName (CPtrDeclr _ declr :: CDeclr
declr    _)  = CDeclr -> Maybe Ident
declrName CDeclr
declr
declrName (CArrDeclr declr :: CDeclr
declr  _ _ _)  = CDeclr -> Maybe Ident
declrName CDeclr
declr
declrName (CFunDeclr declr :: CDeclr
declr  _ _ _)  = CDeclr -> Maybe Ident
declrName CDeclr
declr

-- raise an error if the given declarator does not declare a C function or if
-- the function is supposed to return an array (the latter is illegal in C)
--
assertFunDeclr :: Position -> CDeclr -> CT s ()
assertFunDeclr :: Position -> CDeclr -> CT s ()
assertFunDeclr pos :: Position
pos (CArrDeclr (CFunDeclr (CVarDeclr _ _) _ _ _) _ _ _) =
  Position -> CT s ()
forall s a. Position -> CT s a
illegalFunResultErr Position
pos
assertFunDeclr pos :: Position
pos            (CFunDeclr (CVarDeclr _ _) _ _ _)        =
  CT s ()
forall e s. PreCST e s ()
nop -- everything is ok
assertFunDeclr pos :: Position
pos            (CFunDeclr declr :: CDeclr
declr           _ _ _)        =
  Position -> CDeclr -> CT s ()
forall s. Position -> CDeclr -> CT s ()
assertFunDeclr Position
pos CDeclr
declr
assertFunDeclr pos :: Position
pos            (CPtrDeclr _ declr :: CDeclr
declr             _)        =
  Position -> CDeclr -> CT s ()
forall s. Position -> CDeclr -> CT s ()
assertFunDeclr Position
pos CDeclr
declr
assertFunDeclr pos :: Position
pos            (CArrDeclr declr :: CDeclr
declr           _ _ _)        =
  Position -> CDeclr -> CT s ()
forall s. Position -> CDeclr -> CT s ()
assertFunDeclr Position
pos CDeclr
declr
assertFunDeclr pos :: Position
pos _                                                 = 
  Position -> CT s ()
forall s a. Position -> CT s a
funExpectedErr Position
pos

-- raise an error if the given tag defines an enumeration, but does not fully
-- define it
--
assertIfEnumThenFull                          :: CTag -> CT s ()
assertIfEnumThenFull :: CTag -> CT s ()
assertIfEnumThenFull (EnumCT (CEnum _ [] at :: Attrs
at))  = Position -> CT s ()
forall s a. Position -> CT s a
enumForwardErr (Attrs -> Position
forall a. Pos a => a -> Position
posOf Attrs
at)
assertIfEnumThenFull _                         = CT s ()
forall e s. PreCST e s ()
nop

-- trace for this module
--
traceCTrav :: String -> CT s ()
traceCTrav :: String -> CT s ()
traceCTrav  = (Traces -> Bool) -> String -> CT s ()
forall s. (Traces -> Bool) -> String -> CST s ()
putTraceStr Traces -> Bool
traceCTravSW


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

unknownObjErr     :: Ident -> CT s a
unknownObjErr :: Ident -> CT s a
unknownObjErr ide :: Ident
ide  =
  Position -> [String] -> CT s a
forall s a. Position -> [String] -> CT s a
raiseErrorCTExc (Ident -> Position
forall a. Pos a => a -> Position
posOf Ident
ide) 
    ["Unknown identifier!",
     "Cannot find a definition for `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Ident -> String
identToLexeme Ident
ide String -> String -> String
forall a. [a] -> [a] -> [a]
++ "' in the \
     \header file."]

typedefExpectedErr      :: Ident -> CT s a
typedefExpectedErr :: Ident -> CT s a
typedefExpectedErr ide :: Ident
ide  =   
  Position -> [String] -> CT s a
forall s a. Position -> [String] -> CT s a
raiseErrorCTExc (Ident -> Position
forall a. Pos a => a -> Position
posOf Ident
ide) 
    ["Expected type definition!",
     "The identifier `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Ident -> String
identToLexeme Ident
ide String -> String -> String
forall a. [a] -> [a] -> [a]
++ "' needs to be a C type name."]

unexpectedTypedefErr     :: Position -> CT s a
unexpectedTypedefErr :: Position -> CT s a
unexpectedTypedefErr pos :: Position
pos  =   
  Position -> [String] -> CT s a
forall s a. Position -> [String] -> CT s a
raiseErrorCTExc Position
pos 
    ["Unexpected type name!",
     "An object, function, or enum constant is required here."]

illegalFunResultErr      :: Position -> CT s a
illegalFunResultErr :: Position -> CT s a
illegalFunResultErr pos :: Position
pos  =
  Position -> [String] -> CT s a
forall s a. Position -> [String] -> CT s a
raiseErrorCTExc Position
pos ["Function cannot return an array!",
                       "ANSI C does not allow functions to return an array."]

funExpectedErr      :: Position -> CT s a
funExpectedErr :: Position -> CT s a
funExpectedErr pos :: Position
pos  =
  Position -> [String] -> CT s a
forall s a. Position -> [String] -> CT s a
raiseErrorCTExc Position
pos 
    ["Function expected!",
     "A function is needed here, but this declarator does not declare",
     "a function."]

enumExpectedErr     :: Ident -> CT s a
enumExpectedErr :: Ident -> CT s a
enumExpectedErr ide :: Ident
ide  =
  Position -> [String] -> CT s a
forall s a. Position -> [String] -> CT s a
raiseErrorCTExc (Ident -> Position
forall a. Pos a => a -> Position
posOf Ident
ide) 
    ["Expected enum!",
     "Expected `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Ident -> String
identToLexeme Ident
ide String -> String -> String
forall a. [a] -> [a] -> [a]
++ "' to denote an enum; instead found",
     "a struct, union, or object."]

structExpectedErr     :: Position -> CT s a
structExpectedErr :: Position -> CT s a
structExpectedErr pos :: Position
pos  =
  Position -> [String] -> CT s a
forall s a. Position -> [String] -> CT s a
raiseErrorCTExc Position
pos
    ["Expected a struct!",
     "Expected a structure or union; instead found an enum or basic type."]

enumForwardErr     :: Position -> CT s a
enumForwardErr :: Position -> CT s a
enumForwardErr pos :: Position
pos  =
  Position -> [String] -> CT s a
forall s a. Position -> [String] -> CT s a
raiseErrorCTExc Position
pos 
    ["Forward definition of enumeration!",
     "ANSI C does not permit foreward definitions of enumerations!"]