    {-# LANGUAGE RelaxedPolyRec #-}
    module Language.C.Analysis.ConstEval where

    import Prelude hiding (Foldable(..))
    import Control.Monad
    import Data.Bits
    import Data.Foldable
    import Data.Maybe
    import qualified Data.Map as Map
    import Language.C.Syntax.AST
    import Language.C.Syntax.Constants
    import {-# SOURCE #-} Language.C.Analysis.AstAnalysis (tExpr, ExprSide(..))
    import Language.C.Analysis.Debug ()
    import Language.C.Analysis.DeclAnalysis
    import Language.C.Analysis.DefTable
    import Language.C.Data
    import Language.C.Pretty
    import Language.C.Analysis.SemRep
    import Language.C.Analysis.TravMonad
    import Language.C.Analysis.TypeUtils
    import Text.PrettyPrint.HughesPJ

    data MachineDesc =
      MachineDesc
      { MachineDesc -> IntType -> Integer
    iSize        :: IntType -> Integer
      , MachineDesc -> FloatType -> Integer
    fSize        :: FloatType -> Integer
      , MachineDesc -> BuiltinType -> Integer
    builtinSize  :: BuiltinType -> Integer
      , MachineDesc -> Integer
    ptrSize      :: Integer
      , MachineDesc -> Integer
    voidSize     :: Integer
      , MachineDesc -> IntType -> Integer
    iAlign       :: IntType -> Integer
      , MachineDesc -> FloatType -> Integer
    fAlign       :: FloatType -> Integer
      , MachineDesc -> BuiltinType -> Integer
    builtinAlign :: BuiltinType -> Integer
      , MachineDesc -> Integer
    ptrAlign     :: Integer
      , MachineDesc -> Integer
    voidAlign    :: Integer
      }

    intExpr :: (Pos n, MonadName m) => n -> Integer -> m CExpr
    intExpr :: forall n (m :: * -> *).
    (Pos n, MonadName m) =>
    n -> Integer -> m CExpr
    intExpr n
    n Integer
    i =
      m Name
    forall (m :: * -> *). MonadName m => m Name
    genName m Name -> (Name -> m CExpr) -> m CExpr
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \Name
    name ->
        CExpr -> m CExpr
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CExpr -> m CExpr) -> CExpr -> m CExpr
    forall a b. (a -> b) -> a -> b
    $ CConstant NodeInfo -> CExpr
    forall a. CConstant a -> CExpression a
    CConst (CConstant NodeInfo -> CExpr) -> CConstant NodeInfo -> CExpr
    forall a b. (a -> b) -> a -> b
    $ CInteger -> NodeInfo -> CConstant NodeInfo
    forall a. CInteger -> a -> CConstant a
    CIntConst (Integer -> CInteger
    cInteger Integer
    i) (Position -> Name -> NodeInfo
    mkNodeInfo (n -> Position
    forall a. Pos a => a -> Position
    posOf n
    n) Name
    name)

    sizeofType :: (MonadTrav m, CNode n) => MachineDesc -> n -> Type -> m Integer
    sizeofType :: forall (m :: * -> *) n.
    (MonadTrav m, CNode n) =>
    MachineDesc -> n -> Type -> m Integer
    sizeofType MachineDesc
    md n
    _ (DirectType TypeName
    TyVoid TypeQuals
    _ Attributes
    _) = Integer -> m Integer
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer -> m Integer) -> Integer -> m Integer
    forall a b. (a -> b) -> a -> b
    $ MachineDesc -> Integer
    voidSize MachineDesc
    md
    sizeofType MachineDesc
    md n
    _ (DirectType (TyIntegral IntType
    it) TypeQuals
    _ Attributes
    _) = Integer -> m Integer
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer -> m Integer) -> Integer -> m Integer
    forall a b. (a -> b) -> a -> b
    $ MachineDesc -> IntType -> Integer
    iSize MachineDesc
    md IntType
    it
    sizeofType MachineDesc
    md n
    _ (DirectType (TyFloating FloatType
    ft) TypeQuals
    _ Attributes
    _) = Integer -> m Integer
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer -> m Integer) -> Integer -> m Integer
    forall a b. (a -> b) -> a -> b
    $ MachineDesc -> FloatType -> Integer
    fSize MachineDesc
    md FloatType
    ft
    sizeofType MachineDesc
    md n
    _ (DirectType (TyComplex FloatType
    ft) TypeQuals
    _ Attributes
    _) = Integer -> m Integer
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer -> m Integer) -> Integer -> m Integer
    forall a b. (a -> b) -> a -> b
    $ Integer
    2 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * MachineDesc -> FloatType -> Integer
    fSize MachineDesc
    md FloatType
    ft
    sizeofType MachineDesc
    md n
    _ (DirectType (TyComp CompTypeRef
    ctr) TypeQuals
    _ Attributes
    _) = (Integer, Integer) -> Integer
    forall a b. (a, b) -> a
    fst ((Integer, Integer) -> Integer)
    -> m (Integer, Integer) -> m Integer
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> MachineDesc -> CompTypeRef -> m (Integer, Integer)
    forall (m :: * -> *).
    MonadTrav m =>
    MachineDesc -> CompTypeRef -> m (Integer, Integer)
    compSizeAndAlign MachineDesc
    md CompTypeRef
    ctr
    sizeofType MachineDesc
    md n
    _ (DirectType (TyEnum EnumTypeRef
    _) TypeQuals
    _ Attributes
    _) = Integer -> m Integer
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer -> m Integer) -> Integer -> m Integer
    forall a b. (a -> b) -> a -> b
    $ MachineDesc -> IntType -> Integer
    iSize MachineDesc
    md IntType
    TyInt
    sizeofType MachineDesc
    md n
    _ (DirectType (TyBuiltin BuiltinType
    b) TypeQuals
    _ Attributes
    _) = Integer -> m Integer
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer -> m Integer) -> Integer -> m Integer
    forall a b. (a -> b) -> a -> b
    $ MachineDesc -> BuiltinType -> Integer
    builtinSize MachineDesc
    md BuiltinType
    b
    sizeofType MachineDesc
    md n
    _ (PtrType Type
    _ TypeQuals
    _ Attributes
    _)  = Integer -> m Integer
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer -> m Integer) -> Integer -> m Integer
    forall a b. (a -> b) -> a -> b
    $ MachineDesc -> Integer
    ptrSize MachineDesc
    md
    sizeofType MachineDesc
    md n
    _ (ArrayType Type
    _ (UnknownArraySize Bool
    _) TypeQuals
    _ Attributes
    _) = Integer -> m Integer
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer -> m Integer) -> Integer -> m Integer
    forall a b. (a -> b) -> a -> b
    $ MachineDesc -> Integer
    ptrSize MachineDesc
    md
    sizeofType MachineDesc
    md n
    n (ArrayType Type
    bt (ArraySize Bool
    _ CExpr
    sz) TypeQuals
    _ Attributes
    _) =
      do sz' <- MachineDesc -> Map Ident CExpr -> CExpr -> m CExpr
    forall (m :: * -> *).
    MonadTrav m =>
    MachineDesc -> Map Ident CExpr -> CExpr -> m CExpr
    constEval MachineDesc
    md Map Ident CExpr
    forall k a. Map k a
    Map.empty CExpr
    sz
         case sz' of
           CConst (CIntConst CInteger
    i NodeInfo
    _) ->
             do s <- MachineDesc -> n -> Type -> m Integer
    forall (m :: * -> *) n.
    (MonadTrav m, CNode n) =>
    MachineDesc -> n -> Type -> m Integer
    sizeofType MachineDesc
    md n
    n Type
    bt
                return $ getCInteger i * s
           CExpr
    _ -> Integer -> m Integer
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer -> m Integer) -> Integer -> m Integer
    forall a b. (a -> b) -> a -> b
    $ MachineDesc -> Integer
    ptrSize MachineDesc
    md
                {-
                astError (nodeInfo sz) $
                "array size is not a constant: " ++ (render . pretty) sz
                -}
    sizeofType MachineDesc
    md n
    n (TypeDefType (TypeDefRef Ident
    _ Type
    t NodeInfo
    _) TypeQuals
    _ Attributes
    _) = MachineDesc -> n -> Type -> m Integer
    forall (m :: * -> *) n.
    (MonadTrav m, CNode n) =>
    MachineDesc -> n -> Type -> m Integer
    sizeofType MachineDesc
    md n
    n Type
    t
    sizeofType MachineDesc
    md n
    _ (FunctionType FunType
    _ Attributes
    _) = Integer -> m Integer
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer -> m Integer) -> Integer -> m Integer
    forall a b. (a -> b) -> a -> b
    $ MachineDesc -> Integer
    ptrSize MachineDesc
    md

    alignofType :: (MonadTrav m, CNode n) => MachineDesc -> n -> Type -> m Integer
    alignofType :: forall (m :: * -> *) n.
    (MonadTrav m, CNode n) =>
    MachineDesc -> n -> Type -> m Integer
    alignofType MachineDesc
    md n
    _ (DirectType TypeName
    TyVoid TypeQuals
    _ Attributes
    _) = Integer -> m Integer
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer -> m Integer) -> Integer -> m Integer
    forall a b. (a -> b) -> a -> b
    $ MachineDesc -> Integer
    voidAlign MachineDesc
    md
    alignofType MachineDesc
    md n
    _ (DirectType (TyIntegral IntType
    it) TypeQuals
    _ Attributes
    _) = Integer -> m Integer
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer -> m Integer) -> Integer -> m Integer
    forall a b. (a -> b) -> a -> b
    $ MachineDesc -> IntType -> Integer
    iAlign MachineDesc
    md IntType
    it
    alignofType MachineDesc
    md n
    _ (DirectType (TyFloating FloatType
    ft) TypeQuals
    _ Attributes
    _) = Integer -> m Integer
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer -> m Integer) -> Integer -> m Integer
    forall a b. (a -> b) -> a -> b
    $ MachineDesc -> FloatType -> Integer
    fAlign MachineDesc
    md FloatType
    ft
    alignofType MachineDesc
    md n
    _ (DirectType (TyComplex FloatType
    ft) TypeQuals
    _ Attributes
    _) = Integer -> m Integer
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer -> m Integer) -> Integer -> m Integer
    forall a b. (a -> b) -> a -> b
    $ MachineDesc -> FloatType -> Integer
    fAlign MachineDesc
    md FloatType
    ft
    alignofType MachineDesc
    md n
    _ (DirectType (TyComp CompTypeRef
    ctr) TypeQuals
    _ Attributes
    _) = (Integer, Integer) -> Integer
    forall a b. (a, b) -> b
    snd ((Integer, Integer) -> Integer)
    -> m (Integer, Integer) -> m Integer
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> MachineDesc -> CompTypeRef -> m (Integer, Integer)
    forall (m :: * -> *).
    MonadTrav m =>
    MachineDesc -> CompTypeRef -> m (Integer, Integer)
    compSizeAndAlign MachineDesc
    md CompTypeRef
    ctr
    alignofType MachineDesc
    md n
    _ (DirectType (TyEnum EnumTypeRef
    _) TypeQuals
    _ Attributes
    _) = Integer -> m Integer
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer -> m Integer) -> Integer -> m Integer
    forall a b. (a -> b) -> a -> b
    $ MachineDesc -> IntType -> Integer
    iAlign MachineDesc
    md IntType
    TyInt
    alignofType MachineDesc
    md n
    _ (DirectType (TyBuiltin BuiltinType
    b) TypeQuals
    _ Attributes
    _) = Integer -> m Integer
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer -> m Integer) -> Integer -> m Integer
    forall a b. (a -> b) -> a -> b
    $ MachineDesc -> BuiltinType -> Integer
    builtinAlign MachineDesc
    md BuiltinType
    b
    alignofType MachineDesc
    md n
    _ (PtrType Type
    _ TypeQuals
    _ Attributes
    _)  = Integer -> m Integer
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer -> m Integer) -> Integer -> m Integer
    forall a b. (a -> b) -> a -> b
    $ MachineDesc -> Integer
    ptrAlign MachineDesc
    md
    alignofType MachineDesc
    md n
    _ (ArrayType Type
    _ (UnknownArraySize Bool
    _) TypeQuals
    _ Attributes
    _) = Integer -> m Integer
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer -> m Integer) -> Integer -> m Integer
    forall a b. (a -> b) -> a -> b
    $ MachineDesc -> Integer
    ptrAlign MachineDesc
    md
    alignofType MachineDesc
    md n
    n (ArrayType Type
    bt (ArraySize Bool
    _ CExpr
    _) TypeQuals
    _ Attributes
    _) = MachineDesc -> n -> Type -> m Integer
    forall (m :: * -> *) n.
    (MonadTrav m, CNode n) =>
    MachineDesc -> n -> Type -> m Integer
    alignofType MachineDesc
    md n
    n Type
    bt
    alignofType MachineDesc
    md n
    n (TypeDefType (TypeDefRef Ident
    _ Type
    t NodeInfo
    _) TypeQuals
    _ Attributes
    _) = MachineDesc -> n -> Type -> m Integer
    forall (m :: * -> *) n.
    (MonadTrav m, CNode n) =>
    MachineDesc -> n -> Type -> m Integer
    alignofType MachineDesc
    md n
    n Type
    t
    alignofType MachineDesc
    _ n
    n Type
    t = NodeInfo -> String -> m Integer
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> String -> m a
    astError (n -> NodeInfo
    forall a. CNode a => a -> NodeInfo
    nodeInfo n
    n) (String -> m Integer) -> String -> m Integer
    forall a b. (a -> b) -> a -> b
    $
                     String
    "can't find alignment of type: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (Doc -> String
    render (Doc -> String) -> (Type -> Doc) -> Type -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Type -> Doc
    forall p. Pretty p => p -> Doc
    pretty) Type
    t

    compSizeAndAlign
      :: MonadTrav m =>
         MachineDesc ->
         CompTypeRef ->
         m (Integer, Integer)
         -- ^ (size, alignment)
    compSizeAndAlign :: forall (m :: * -> *).
    MonadTrav m =>
    MachineDesc -> CompTypeRef -> m (Integer, Integer)
    compSizeAndAlign MachineDesc
    md CompTypeRef
    ctr =
      do dt <- m DefTable
    forall (m :: * -> *). MonadSymtab m => m DefTable
    getDefTable
         case lookupTag (sueRef ctr) dt of
           Just (Left TagFwdDecl
    _)   -> NodeInfo -> String -> m (Integer, Integer)
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> String -> m a
    astError (CompTypeRef -> NodeInfo
    forall a. CNode a => a -> NodeInfo
    nodeInfo CompTypeRef
    ctr)
                              String
    "composite declared but not defined"
           Just (Right (CompDef (CompType SUERef
    _ CompTyKind
    tag [MemberDecl]
    ms Attributes
    _ NodeInfo
    ni))) ->
             do let ts :: [Type]
    ts = (MemberDecl -> Type) -> [MemberDecl] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map MemberDecl -> Type
    forall n. Declaration n => n -> Type
    declType [MemberDecl]
    ms
                sizes <- (Type -> m Integer) -> [Type] -> m [Integer]
    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 (MachineDesc -> NodeInfo -> Type -> m Integer
    forall (m :: * -> *) n.
    (MonadTrav m, CNode n) =>
    MachineDesc -> n -> Type -> m Integer
    sizeofType MachineDesc
    md NodeInfo
    ni) [Type]
    ts
                aligns <- mapM (alignofType md ni) ts
                let alignment = [Integer] -> Integer
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum (Integer
    1 Integer -> [Integer] -> [Integer]
    forall a. a -> [a] -> [a]
    : [Integer]
    aligns)
                    size = case CompTyKind
    tag of
                      CompTyKind
    UnionTag -> Integer -> Integer -> Integer
    roundToAlignment Integer
    alignment ([Integer] -> Integer
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum (Integer
    0 Integer -> [Integer] -> [Integer]
    forall a. a -> [a] -> [a]
    : [Integer]
    sizes))
                      CompTyKind
    StructTag ->
                        let sizeAndNextAlignment :: [(Integer, Integer)]
    sizeAndNextAlignment =
                              [Integer] -> [Integer] -> [(Integer, Integer)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Integer]
    sizes (Int -> [Integer] -> [Integer]
    forall a. Int -> [a] -> [a]
    drop Int
    1 [Integer]
    aligns [Integer] -> [Integer] -> [Integer]
    forall a. [a] -> [a] -> [a]
    ++ [Integer
    alignment])
                            offsets :: Integer
    offsets = (Integer -> (Integer, Integer) -> Integer)
    -> Integer -> [(Integer, Integer)] -> Integer
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl'
                              (\Integer
    offset (Integer
    memberSize, Integer
    nextAlign)
                               -> Integer -> Integer -> Integer
    roundToAlignment Integer
    nextAlign (Integer
    offset Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Integer
    memberSize))
                              Integer
    0
                              [(Integer, Integer)]
    sizeAndNextAlignment
                        in Integer
    offsets
                return (size, alignment)
           Just (Right (EnumDef EnumType
    _)) -> (Integer, Integer) -> m (Integer, Integer)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Integer, Integer) -> m (Integer, Integer))
    -> (Integer, Integer) -> m (Integer, Integer)
    forall a b. (a -> b) -> a -> b
    $ (MachineDesc -> IntType -> Integer
    iSize MachineDesc
    md IntType
    TyInt, MachineDesc -> IntType -> Integer
    iAlign MachineDesc
    md IntType
    TyInt)
           Maybe TagEntry
    Nothing         -> NodeInfo -> String -> m (Integer, Integer)
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> String -> m a
    astError (CompTypeRef -> NodeInfo
    forall a. CNode a => a -> NodeInfo
    nodeInfo CompTypeRef
    ctr) String
    "unknown composite"

    -- | Find the next multiple of an alignment
    roundToAlignment
      :: Integer
      -- ^ The alignment
      -> Integer
      -- ^ The value to align
      -> Integer
      -- ^ The next multiple of alignment
    roundToAlignment :: Integer -> Integer -> Integer
    roundToAlignment Integer
    alignment Integer
    value =
      Integer
    alignment Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * ((Integer
    value Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + (Integer
    alignment Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - Integer
    1)) Integer -> Integer -> Integer
    forall a. Integral a => a -> a -> a
    `quot` Integer
    alignment)

    {- Expression evaluation -}

    -- Use the withWordBytes function to wrap the results around to the
    -- correct word size
    intOp :: CBinaryOp -> Integer -> Integer -> Integer
    intOp :: CBinaryOp -> Integer -> Integer -> Integer
    intOp CBinaryOp
    CAddOp Integer
    i1 Integer
    i2 = Integer
    i1 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Integer
    i2
    intOp CBinaryOp
    CSubOp Integer
    i1 Integer
    i2 = Integer
    i1 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - Integer
    i2
    intOp CBinaryOp
    CMulOp Integer
    i1 Integer
    i2 = Integer
    i1 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * Integer
    i2
    intOp CBinaryOp
    CDivOp Integer
    i1 Integer
    i2 = Integer
    i1 Integer -> Integer -> Integer
    forall a. Integral a => a -> a -> a
    `div` Integer
    i2
    intOp CBinaryOp
    CRmdOp Integer
    i1 Integer
    i2 = Integer
    i1 Integer -> Integer -> Integer
    forall a. Integral a => a -> a -> a
    `mod` Integer
    i2
    intOp CBinaryOp
    CShlOp Integer
    i1 Integer
    i2 = Integer
    i1 Integer -> Int -> Integer
    forall a. Bits a => a -> Int -> a
    `shiftL` Integer -> Int
    forall a. Num a => Integer -> a
    fromInteger Integer
    i2
    intOp CBinaryOp
    CShrOp Integer
    i1 Integer
    i2 = Integer
    i1 Integer -> Int -> Integer
    forall a. Bits a => a -> Int -> a
    `shiftR` Integer -> Int
    forall a. Num a => Integer -> a
    fromInteger Integer
    i2
    intOp CBinaryOp
    CLeOp  Integer
    i1 Integer
    i2 = Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Int -> Integer) -> Int -> Integer
    forall a b. (a -> b) -> a -> b
    $ Bool -> Int
    forall a. Enum a => a -> Int
    fromEnum (Bool -> Int) -> Bool -> Int
    forall a b. (a -> b) -> a -> b
    $ Integer
    i1 Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < Integer
    i2
    intOp CBinaryOp
    CGrOp  Integer
    i1 Integer
    i2 = Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Int -> Integer) -> Int -> Integer
    forall a b. (a -> b) -> a -> b
    $ Bool -> Int
    forall a. Enum a => a -> Int
    fromEnum (Bool -> Int) -> Bool -> Int
    forall a b. (a -> b) -> a -> b
    $ Integer
    i1 Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    > Integer
    i2
    intOp CBinaryOp
    CLeqOp Integer
    i1 Integer
    i2 = Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Int -> Integer) -> Int -> Integer
    forall a b. (a -> b) -> a -> b
    $ Bool -> Int
    forall a. Enum a => a -> Int
    fromEnum (Bool -> Int) -> Bool -> Int
    forall a b. (a -> b) -> a -> b
    $ Integer
    i1 Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Integer
    i2
    intOp CBinaryOp
    CGeqOp Integer
    i1 Integer
    i2 = Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Int -> Integer) -> Int -> Integer
    forall a b. (a -> b) -> a -> b
    $ Bool -> Int
    forall a. Enum a => a -> Int
    fromEnum (Bool -> Int) -> Bool -> Int
    forall a b. (a -> b) -> a -> b
    $ Integer
    i1 Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Integer
    i2
    intOp CBinaryOp
    CEqOp  Integer
    i1 Integer
    i2 = Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Int -> Integer) -> Int -> Integer
    forall a b. (a -> b) -> a -> b
    $ Bool -> Int
    forall a. Enum a => a -> Int
    fromEnum (Bool -> Int) -> Bool -> Int
    forall a b. (a -> b) -> a -> b
    $ Integer
    i1 Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == Integer
    i2
    intOp CBinaryOp
    CNeqOp Integer
    i1 Integer
    i2 = Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Int -> Integer) -> Int -> Integer
    forall a b. (a -> b) -> a -> b
    $ Bool -> Int
    forall a. Enum a => a -> Int
    fromEnum (Bool -> Int) -> Bool -> Int
    forall a b. (a -> b) -> a -> b
    $ Integer
    i1 Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Integer
    i2
    intOp CBinaryOp
    CAndOp Integer
    i1 Integer
    i2 = Integer
    i1 Integer -> Integer -> Integer
    forall a. Bits a => a -> a -> a
    .&. Integer
    i2
    intOp CBinaryOp
    CXorOp Integer
    i1 Integer
    i2 = Integer
    i1 Integer -> Integer -> Integer
    forall a. Bits a => a -> a -> a
    `xor` Integer
    i2
    intOp CBinaryOp
    COrOp  Integer
    i1 Integer
    i2 = Integer
    i1 Integer -> Integer -> Integer
    forall a. Bits a => a -> a -> a
    .|. Integer
    i2
    intOp CBinaryOp
    CLndOp Integer
    i1 Integer
    i2 = Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Int -> Integer) -> Int -> Integer
    forall a b. (a -> b) -> a -> b
    $ Bool -> Int
    forall a. Enum a => a -> Int
    fromEnum (Bool -> Int) -> Bool -> Int
    forall a b. (a -> b) -> a -> b
    $ (Integer
    i1 Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Integer
    0) Bool -> Bool -> Bool
    && (Integer
    i2 Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Integer
    0)
    intOp CBinaryOp
    CLorOp Integer
    i1 Integer
    i2 = Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Int -> Integer) -> Int -> Integer
    forall a b. (a -> b) -> a -> b
    $ Bool -> Int
    forall a. Enum a => a -> Int
    fromEnum (Bool -> Int) -> Bool -> Int
    forall a b. (a -> b) -> a -> b
    $ (Integer
    i1 Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Integer
    0) Bool -> Bool -> Bool
    || (Integer
    i2 Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Integer
    0)

    -- Use the withWordBytes function to wrap the results around to the
    -- correct word size
    intUnOp :: CUnaryOp -> Integer -> Maybe Integer
    intUnOp :: CUnaryOp -> Integer -> Maybe Integer
    intUnOp CUnaryOp
    CPlusOp Integer
    i = Integer -> Maybe Integer
    forall a. a -> Maybe a
    Just Integer
    i
    intUnOp CUnaryOp
    CMinOp  Integer
    i = Integer -> Maybe Integer
    forall a. a -> Maybe a
    Just (Integer -> Maybe Integer) -> Integer -> Maybe Integer
    forall a b. (a -> b) -> a -> b
    $ -Integer
    i
    intUnOp CUnaryOp
    CCompOp Integer
    i = Integer -> Maybe Integer
    forall a. a -> Maybe a
    Just (Integer -> Maybe Integer) -> Integer -> Maybe Integer
    forall a b. (a -> b) -> a -> b
    $ Integer -> Integer
    forall a. Bits a => a -> a
    complement Integer
    i
    intUnOp CUnaryOp
    CNegOp  Integer
    i = Integer -> Maybe Integer
    forall a. a -> Maybe a
    Just (Integer -> Maybe Integer) -> Integer -> Maybe Integer
    forall a b. (a -> b) -> a -> b
    $ Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Int -> Integer) -> Int -> Integer
    forall a b. (a -> b) -> a -> b
    $ Bool -> Int
    forall a. Enum a => a -> Int
    fromEnum (Bool -> Int) -> Bool -> Int
    forall a b. (a -> b) -> a -> b
    $ Integer
    i Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == Integer
    0
    intUnOp CUnaryOp
    _       Integer
    _ = Maybe Integer
    forall a. Maybe a
    Nothing

    withWordBytes :: Int -> Integer -> Integer
    withWordBytes :: Int -> Integer -> Integer
    withWordBytes Int
    bytes Integer
    n = Integer
    n Integer -> Integer -> Integer
    forall a. Integral a => a -> a -> a
    `rem` (Integer
    1 Integer -> Int -> Integer
    forall a. Bits a => a -> Int -> a
    `shiftL` (Int
    bytes Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    3))

    boolValue :: CExpr -> Maybe Bool
    boolValue :: CExpr -> Maybe Bool
    boolValue (CConst (CIntConst CInteger
    i NodeInfo
    _))  = Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
    forall a b. (a -> b) -> a -> b
    $ CInteger -> Integer
    getCInteger CInteger
    i Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Integer
    0
    boolValue (CConst (CCharConst CChar
    c NodeInfo
    _)) = Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
    forall a b. (a -> b) -> a -> b
    $ CChar -> Integer
    getCCharAsInt CChar
    c Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Integer
    0
    boolValue (CConst (CStrConst CString
    _ NodeInfo
    _))  = Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    True
    boolValue CExpr
    _                         = Maybe Bool
    forall a. Maybe a
    Nothing

    intValue :: CExpr -> Maybe Integer
    intValue :: CExpr -> Maybe Integer
    intValue (CConst (CIntConst CInteger
    i NodeInfo
    _))  = Integer -> Maybe Integer
    forall a. a -> Maybe a
    Just (Integer -> Maybe Integer) -> Integer -> Maybe Integer
    forall a b. (a -> b) -> a -> b
    $ CInteger -> Integer
    getCInteger CInteger
    i
    intValue (CConst (CCharConst CChar
    c NodeInfo
    _)) = Integer -> Maybe Integer
    forall a. a -> Maybe a
    Just (Integer -> Maybe Integer) -> Integer -> Maybe Integer
    forall a b. (a -> b) -> a -> b
    $ CChar -> Integer
    getCCharAsInt CChar
    c
    intValue CExpr
    _                         = Maybe Integer
    forall a. Maybe a
    Nothing

    constEval :: (MonadTrav m) =>
                 MachineDesc -> Map.Map Ident CExpr -> CExpr -> m CExpr
    constEval :: forall (m :: * -> *).
    MonadTrav m =>
    MachineDesc -> Map Ident CExpr -> CExpr -> m CExpr
    constEval MachineDesc
    md Map Ident CExpr
    env (CCond CExpr
    e1 Maybe CExpr
    me2 CExpr
    e3 NodeInfo
    ni) =
      do e1'  <- MachineDesc -> Map Ident CExpr -> CExpr -> m CExpr
    forall (m :: * -> *).
    MonadTrav m =>
    MachineDesc -> Map Ident CExpr -> CExpr -> m CExpr
    constEval MachineDesc
    md Map Ident CExpr
    env CExpr
    e1
         me2' <- maybe (return Nothing) (\CExpr
    e -> CExpr -> Maybe CExpr
    forall a. a -> Maybe a
    Just (CExpr -> Maybe CExpr) -> m CExpr -> m (Maybe CExpr)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    `liftM` MachineDesc -> Map Ident CExpr -> CExpr -> m CExpr
    forall (m :: * -> *).
    MonadTrav m =>
    MachineDesc -> Map Ident CExpr -> CExpr -> m CExpr
    constEval MachineDesc
    md Map Ident CExpr
    env CExpr
    e) me2
         e3'  <- constEval md env e3
         case boolValue e1' of
           Just Bool
    True  -> CExpr -> m CExpr
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CExpr -> m CExpr) -> CExpr -> m CExpr
    forall a b. (a -> b) -> a -> b
    $ CExpr -> Maybe CExpr -> CExpr
    forall a. a -> Maybe a -> a
    fromMaybe CExpr
    e1' Maybe CExpr
    me2'
           Just Bool
    False -> CExpr -> m CExpr
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return CExpr
    e3'
           Maybe Bool
    Nothing    -> CExpr -> m CExpr
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CExpr -> m CExpr) -> CExpr -> m CExpr
    forall a b. (a -> b) -> a -> b
    $ CExpr -> Maybe CExpr -> CExpr -> NodeInfo -> CExpr
    forall a.
    CExpression a
    -> Maybe (CExpression a) -> CExpression a -> a -> CExpression a
    CCond CExpr
    e1' Maybe CExpr
    me2' CExpr
    e3' NodeInfo
    ni
    constEval MachineDesc
    md Map Ident CExpr
    env e :: CExpr
    e@(CBinary CBinaryOp
    op CExpr
    e1 CExpr
    e2 NodeInfo
    ni) =
      do e1' <- MachineDesc -> Map Ident CExpr -> CExpr -> m CExpr
    forall (m :: * -> *).
    MonadTrav m =>
    MachineDesc -> Map Ident CExpr -> CExpr -> m CExpr
    constEval MachineDesc
    md Map Ident CExpr
    env CExpr
    e1
         e2' <- constEval md env e2
         t <- tExpr [] RValue e
         bytes <- fromIntegral `liftM` sizeofType md e t
         case (intValue e1', intValue e2') of
           (Just Integer
    i1, Just Integer
    i2) -> NodeInfo -> Integer -> m CExpr
    forall n (m :: * -> *).
    (Pos n, MonadName m) =>
    n -> Integer -> m CExpr
    intExpr NodeInfo
    ni (Int -> Integer -> Integer
    withWordBytes Int
    bytes (CBinaryOp -> Integer -> Integer -> Integer
    intOp CBinaryOp
    op Integer
    i1 Integer
    i2))
           (Maybe Integer
    _, Maybe Integer
    _)             -> CExpr -> m CExpr
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CExpr -> m CExpr) -> CExpr -> m CExpr
    forall a b. (a -> b) -> a -> b
    $ CBinaryOp -> CExpr -> CExpr -> NodeInfo -> CExpr
    forall a.
    CBinaryOp -> CExpression a -> CExpression a -> a -> CExpression a
    CBinary CBinaryOp
    op CExpr
    e1' CExpr
    e2' NodeInfo
    ni
    constEval MachineDesc
    md Map Ident CExpr
    env (CUnary CUnaryOp
    op CExpr
    e NodeInfo
    ni) =
      do e' <- MachineDesc -> Map Ident CExpr -> CExpr -> m CExpr
    forall (m :: * -> *).
    MonadTrav m =>
    MachineDesc -> Map Ident CExpr -> CExpr -> m CExpr
    constEval MachineDesc
    md Map Ident CExpr
    env CExpr
    e
         t <- tExpr [] RValue e
         bytes <- fromIntegral `liftM` sizeofType md e t
         case intValue e' of
           Just Integer
    i  -> case CUnaryOp -> Integer -> Maybe Integer
    intUnOp CUnaryOp
    op Integer
    i of
                        Just Integer
    i' -> NodeInfo -> Integer -> m CExpr
    forall n (m :: * -> *).
    (Pos n, MonadName m) =>
    n -> Integer -> m CExpr
    intExpr NodeInfo
    ni (Int -> Integer -> Integer
    withWordBytes Int
    bytes Integer
    i')
                        Maybe Integer
    Nothing -> NodeInfo -> String -> m CExpr
    forall (m :: * -> *) a. MonadCError m => NodeInfo -> String -> m a
    astError NodeInfo
    ni
                                   String
    "invalid unary operator applied to constant"
           Maybe Integer
    Nothing -> CExpr -> m CExpr
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CExpr -> m CExpr) -> CExpr -> m CExpr
    forall a b. (a -> b) -> a -> b
    $ CUnaryOp -> CExpr -> NodeInfo -> CExpr
    forall a. CUnaryOp -> CExpression a -> a -> CExpression a
    CUnary CUnaryOp
    op CExpr
    e' NodeInfo
    ni
    constEval MachineDesc
    md Map Ident CExpr
    env (CCast CDeclaration NodeInfo
    d CExpr
    e NodeInfo
    ni) =
      do e' <- MachineDesc -> Map Ident CExpr -> CExpr -> m CExpr
    forall (m :: * -> *).
    MonadTrav m =>
    MachineDesc -> Map Ident CExpr -> CExpr -> m CExpr
    constEval MachineDesc
    md Map Ident CExpr
    env CExpr
    e
         t <- analyseTypeDecl d
         bytes <- fromIntegral `liftM` sizeofType md d t
         case intValue e' of
           Just Integer
    i -> NodeInfo -> Integer -> m CExpr
    forall n (m :: * -> *).
    (Pos n, MonadName m) =>
    n -> Integer -> m CExpr
    intExpr NodeInfo
    ni (Int -> Integer -> Integer
    withWordBytes Int
    bytes Integer
    i)
           Maybe Integer
    Nothing -> CExpr -> m CExpr
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CExpr -> m CExpr) -> CExpr -> m CExpr
    forall a b. (a -> b) -> a -> b
    $ CDeclaration NodeInfo -> CExpr -> NodeInfo -> CExpr
    forall a. CDeclaration a -> CExpression a -> a -> CExpression a
    CCast CDeclaration NodeInfo
    d CExpr
    e' NodeInfo
    ni
    constEval MachineDesc
    md Map Ident CExpr
    _ (CSizeofExpr CExpr
    e NodeInfo
    ni) =
      do t <- [StmtCtx] -> ExprSide -> CExpr -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpr -> m Type
    tExpr [] ExprSide
    RValue CExpr
    e
         sz <- sizeofType md e t
         intExpr ni sz
    constEval MachineDesc
    md Map Ident CExpr
    _ (CSizeofType CDeclaration NodeInfo
    d NodeInfo
    ni) =
      do t <- CDeclaration NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    CDeclaration NodeInfo -> m Type
    analyseTypeDecl CDeclaration NodeInfo
    d
         sz <- sizeofType md d t
         intExpr ni sz
    constEval MachineDesc
    md Map Ident CExpr
    _ (CAlignofExpr CExpr
    e NodeInfo
    ni) =
      do t <- [StmtCtx] -> ExprSide -> CExpr -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpr -> m Type
    tExpr [] ExprSide
    RValue CExpr
    e
         sz <- alignofType md e t
         intExpr ni sz
    constEval MachineDesc
    md Map Ident CExpr
    _ (CAlignofType CDeclaration NodeInfo
    d NodeInfo
    ni) =
      do t <- CDeclaration NodeInfo -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    CDeclaration NodeInfo -> m Type
    analyseTypeDecl CDeclaration NodeInfo
    d
         sz <- alignofType md d t
         intExpr ni sz
    constEval MachineDesc
    _ Map Ident CExpr
    env e :: CExpr
    e@(CVar Ident
    i NodeInfo
    _) | Ident -> Map Ident CExpr -> Bool
    forall k a. Ord k => k -> Map k a -> Bool
    Map.member Ident
    i Map Ident CExpr
    env =
      CExpr -> m CExpr
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CExpr -> m CExpr) -> CExpr -> m CExpr
    forall a b. (a -> b) -> a -> b
    $ CExpr -> Maybe CExpr -> CExpr
    forall a. a -> Maybe a -> a
    fromMaybe CExpr
    e (Maybe CExpr -> CExpr) -> Maybe CExpr -> CExpr
    forall a b. (a -> b) -> a -> b
    $ Ident -> Map Ident CExpr -> Maybe CExpr
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Ident
    i Map Ident CExpr
    env
    constEval MachineDesc
    md Map Ident CExpr
    env e :: CExpr
    e@(CVar Ident
    i NodeInfo
    _) =
      do t <- [StmtCtx] -> ExprSide -> CExpr -> m Type
    forall (m :: * -> *).
    MonadTrav m =>
    [StmtCtx] -> ExprSide -> CExpr -> m Type
    tExpr [] ExprSide
    RValue CExpr
    e
         case derefTypeDef t of
           DirectType (TyEnum EnumTypeRef
    etr) TypeQuals
    _ Attributes
    _ ->
             do dt <- m DefTable
    forall (m :: * -> *). MonadSymtab m => m DefTable
    getDefTable
                case lookupTag (sueRef etr) dt of
                  Just (Right (EnumDef (EnumType SUERef
    _ [Enumerator]
    es Attributes
    _ NodeInfo
    _))) ->
                    do env' <- (Map Ident CExpr -> Enumerator -> m (Map Ident CExpr))
    -> Map Ident CExpr -> [Enumerator] -> m (Map Ident CExpr)
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM Map Ident CExpr -> Enumerator -> m (Map Ident CExpr)
    forall {m :: * -> *}.
    MonadTrav m =>
    Map Ident CExpr -> Enumerator -> m (Map Ident CExpr)
    enumConst Map Ident CExpr
    env [Enumerator]
    es
                       return $ fromMaybe e $ Map.lookup i env'
                  Maybe TagEntry
    _ -> CExpr -> m CExpr
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return CExpr
    e
           Type
    _ -> CExpr -> m CExpr
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return CExpr
    e
      where enumConst :: Map Ident CExpr -> Enumerator -> m (Map Ident CExpr)
    enumConst Map Ident CExpr
    env' (Enumerator Ident
    n CExpr
    e' EnumType
    _ NodeInfo
    _) =
              do c <- MachineDesc -> Map Ident CExpr -> CExpr -> m CExpr
    forall (m :: * -> *).
    MonadTrav m =>
    MachineDesc -> Map Ident CExpr -> CExpr -> m CExpr
    constEval MachineDesc
    md Map Ident CExpr
    env' CExpr
    e'
                 return $ Map.insert n c env'
    constEval MachineDesc
    _ Map Ident CExpr
    _ CExpr
    e = CExpr -> m CExpr
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return CExpr
    e