    {-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving  #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Language.C.Analysis.SemError
    -- Copyright   :  (c) 2008 Benedikt Huber
    -- License     :  BSD-style
    -- Maintainer  :  benedikt.huber@gmail.com
    -- Stability   :  alpha
    -- Portability :  ghc
    --
    -- Errors in the semantic analysis
    -----------------------------------------------------------------------------
    module Language.C.Analysis.SemError (
    InvalidASTError(..), invalidAST,
    BadSpecifierError(..), badSpecifierError,
    TypeMismatch(..), typeMismatch,
    RedefError(..), RedefInfo(..), RedefKind(..), redefinition,
    )
    where

    -- this means we cannot use SemError in SemRep, but use rich types here
    import Language.C.Analysis.SemRep

    import Language.C.Data.Error
    import Language.C.Data.Node

    -- here are the errors available

    -- | InvalidASTError is caused by the violation of an invariant in the AST
    newtype InvalidASTError = InvalidAST ErrorInfo

    instance Error InvalidASTError where
        errorInfo :: InvalidASTError -> ErrorInfo
    errorInfo (InvalidAST ErrorInfo
    ei) = ErrorInfo
    ei
        changeErrorLevel :: InvalidASTError -> ErrorLevel -> InvalidASTError
    changeErrorLevel (InvalidAST ErrorInfo
    ei) ErrorLevel
    lvl' = ErrorInfo -> InvalidASTError
    InvalidAST (ErrorInfo -> ErrorLevel -> ErrorInfo
    forall e. Error e => e -> ErrorLevel -> e
    changeErrorLevel ErrorInfo
    ei ErrorLevel
    lvl')

    -- | BadSpecifierError is caused by an invalid combination of specifiers
    newtype BadSpecifierError = BadSpecifierError ErrorInfo

    instance Error BadSpecifierError where
        errorInfo :: BadSpecifierError -> ErrorInfo
    errorInfo (BadSpecifierError ErrorInfo
    ei) = ErrorInfo
    ei
        changeErrorLevel :: BadSpecifierError -> ErrorLevel -> BadSpecifierError
    changeErrorLevel (BadSpecifierError ErrorInfo
    ei) ErrorLevel
    lvl' = ErrorInfo -> BadSpecifierError
    BadSpecifierError (ErrorInfo -> ErrorLevel -> ErrorInfo
    forall e. Error e => e -> ErrorLevel -> e
    changeErrorLevel ErrorInfo
    ei ErrorLevel
    lvl')

    -- | RedefError is caused by an invalid redefinition of the same identifier or type
    data RedefError = RedefError ErrorLevel RedefInfo

    data RedefInfo = RedefInfo String RedefKind NodeInfo NodeInfo
    data RedefKind = DuplicateDef | DiffKindRedecl | ShadowedDef | DisagreeLinkage |
                     NoLinkageOld
    data TypeMismatch = TypeMismatch String (NodeInfo,Type) (NodeInfo,Type)

    -- Invalid AST
    -- ~~~~~~~~~~~

    instance Show InvalidASTError  where show :: InvalidASTError -> String
    show = String -> InvalidASTError -> String
    forall e. Error e => String -> e -> String
    showError String
    "AST invariant violated"

    invalidAST :: NodeInfo -> String -> InvalidASTError
    invalidAST :: NodeInfo -> String -> InvalidASTError
    invalidAST NodeInfo
    node_info String
    msg = ErrorInfo -> InvalidASTError
    InvalidAST (ErrorLevel -> String -> NodeInfo -> ErrorInfo
    mkErrorInfo ErrorLevel
    LevelError String
    msg NodeInfo
    node_info)

    -- Bad specifier (e.g. static for a parameter, or extern when there is an initializer)
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    instance Show BadSpecifierError     where show :: BadSpecifierError -> String
    show = String -> BadSpecifierError -> String
    forall e. Error e => String -> e -> String
    showError String
    "Bad specifier"

    badSpecifierError :: NodeInfo -> String -> BadSpecifierError
    badSpecifierError :: NodeInfo -> String -> BadSpecifierError
    badSpecifierError NodeInfo
    node_info String
    msg = ErrorInfo -> BadSpecifierError
    BadSpecifierError (ErrorLevel -> String -> NodeInfo -> ErrorInfo
    mkErrorInfo ErrorLevel
    LevelError String
    msg NodeInfo
    node_info)

    -- Type mismatch
    -- ~~~~~~~~~~~~~
    typeMismatch :: String -> (NodeInfo, Type) -> (NodeInfo,Type) -> TypeMismatch
    typeMismatch :: String -> (NodeInfo, Type) -> (NodeInfo, Type) -> TypeMismatch
    typeMismatch = String -> (NodeInfo, Type) -> (NodeInfo, Type) -> TypeMismatch
    TypeMismatch

    instance Show TypeMismatch where
        show :: TypeMismatch -> String
    show TypeMismatch
    tm = String -> ErrorInfo -> String
    forall e. Error e => String -> e -> String
    showError String
    "Type mismatch" (TypeMismatch -> ErrorInfo
    typeMismatchInfo TypeMismatch
    tm)
    instance Error TypeMismatch where
        errorInfo :: TypeMismatch -> ErrorInfo
    errorInfo = TypeMismatch -> ErrorInfo
    typeMismatchInfo
    typeMismatchInfo :: TypeMismatch -> ErrorInfo
    typeMismatchInfo :: TypeMismatch -> ErrorInfo
    typeMismatchInfo (TypeMismatch String
    reason (NodeInfo
    node1,Type
    _ty2) (NodeInfo, Type)
    _t2) =
        ErrorLevel -> Position -> [String] -> ErrorInfo
    ErrorInfo ErrorLevel
    LevelError (NodeInfo -> Position
    posOfNode NodeInfo
    node1) [String
    reason]

    -- Redefinitions
    -- ~~~~~~~~~~~~~

    instance Show RedefError  where
        show :: RedefError -> String
    show (RedefError ErrorLevel
    lvl RedefInfo
    info) = String -> ErrorInfo -> String
    showErrorInfo (RedefInfo -> String
    redefErrLabel RedefInfo
    info) (ErrorLevel -> RedefInfo -> ErrorInfo
    redefErrorInfo ErrorLevel
    lvl RedefInfo
    info)
    instance Error RedefError where
        errorInfo :: RedefError -> ErrorInfo
    errorInfo (RedefError ErrorLevel
    lvl RedefInfo
    info) = ErrorLevel -> RedefInfo -> ErrorInfo
    redefErrorInfo ErrorLevel
    lvl RedefInfo
    info
        changeErrorLevel :: RedefError -> ErrorLevel -> RedefError
    changeErrorLevel (RedefError ErrorLevel
    _lvl RedefInfo
    info) ErrorLevel
    lvl' = ErrorLevel -> RedefInfo -> RedefError
    RedefError ErrorLevel
    lvl' RedefInfo
    info

    redefErrLabel :: RedefInfo -> String
    redefErrLabel :: RedefInfo -> String
    redefErrLabel  (RedefInfo String
    ident RedefKind
    _ NodeInfo
    _ NodeInfo
    _) = String
    ident String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " redefined"

    redefErrorInfo :: ErrorLevel -> RedefInfo -> ErrorInfo
    redefErrorInfo :: ErrorLevel -> RedefInfo -> ErrorInfo
    redefErrorInfo ErrorLevel
    lvl info :: RedefInfo
    info@(RedefInfo String
    _ RedefKind
    _ NodeInfo
    node NodeInfo
    old_node) =
        ErrorLevel -> Position -> [String] -> ErrorInfo
    ErrorInfo ErrorLevel
    lvl (NodeInfo -> Position
    posOfNode NodeInfo
    node) ([RedefInfo -> String
    redefErrReason RedefInfo
    info] [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ NodeInfo -> [String]
    prevDeclMsg NodeInfo
    old_node)

    redefErrReason :: RedefInfo -> String
    redefErrReason :: RedefInfo -> String
    redefErrReason (RedefInfo String
    ident RedefKind
    DuplicateDef NodeInfo
    _ NodeInfo
    _) = String
    "duplicate definition of " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ident
    redefErrReason (RedefInfo String
    ident RedefKind
    ShadowedDef NodeInfo
    _ NodeInfo
    _)   = String
    "this declaration of " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ident String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " shadows a previous one"
    redefErrReason (RedefInfo String
    ident RedefKind
    DiffKindRedecl NodeInfo
    _ NodeInfo
    _) = String
    ident String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " previously declared as a different kind of symbol"
    redefErrReason (RedefInfo String
    ident RedefKind
    DisagreeLinkage NodeInfo
    _ NodeInfo
    _) = String
    ident String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " previously declared with different linkage"
    redefErrReason (RedefInfo String
    ident RedefKind
    NoLinkageOld NodeInfo
    _ NodeInfo
    _) = String
    ident String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " previously declared without linkage"

    prevDeclMsg :: NodeInfo -> [String]
    prevDeclMsg :: NodeInfo -> [String]
    prevDeclMsg NodeInfo
    old_node = [String
    "The previous declaration was here: ", Position -> String
    forall a. Show a => a -> String
    show (NodeInfo -> Position
    posOfNode NodeInfo
    old_node)]

    redefinition :: ErrorLevel -> String -> RedefKind -> NodeInfo -> NodeInfo -> RedefError
    redefinition :: ErrorLevel
    -> String -> RedefKind -> NodeInfo -> NodeInfo -> RedefError
    redefinition ErrorLevel
    lvl String
    ctx RedefKind
    kind NodeInfo
    new NodeInfo
    old = ErrorLevel -> RedefInfo -> RedefError
    RedefError ErrorLevel
    lvl (String -> RedefKind -> NodeInfo -> NodeInfo -> RedefInfo
    RedefInfo String
    ctx RedefKind
    kind NodeInfo
    new NodeInfo
    old)