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

import Control.Monad
import Data.Bits
import Data.List (foldl')
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 =
  forall (m :: * -> *). MonadName m => m Name
genName forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Name
name ->
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. CConstant a -> CExpression a
CConst forall a b. (a -> b) -> a -> b
$ forall a. CInteger -> a -> CConstant a
CIntConst (Integer -> CInteger
cInteger Integer
i) (Position -> Name -> NodeInfo
mkNodeInfo (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
_) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ MachineDesc -> Integer
voidSize MachineDesc
md
sizeofType MachineDesc
md n
_ (DirectType (TyIntegral IntType
it) TypeQuals
_ Attributes
_) = forall (m :: * -> *) a. Monad m => a -> m a
return 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
_) = forall (m :: * -> *) a. Monad m => a -> m a
return 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
_) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Integer
2 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
_) = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadTrav m =>
MachineDesc -> CompTypeRef -> m (Integer, Integer)
compSizeAndAlign MachineDesc
md CompTypeRef
ctr
sizeofType MachineDesc
md n
_ (DirectType (TyEnum EnumTypeRef
_) TypeQuals
_ Attributes
_) = forall (m :: * -> *) a. Monad m => a -> m a
return 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
_) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ MachineDesc -> BuiltinType -> Integer
builtinSize MachineDesc
md BuiltinType
b
sizeofType MachineDesc
md n
_ (PtrType Type
_ TypeQuals
_ Attributes
_)  = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ MachineDesc -> Integer
ptrSize MachineDesc
md
sizeofType MachineDesc
md n
_ (ArrayType Type
_ (UnknownArraySize Bool
_) TypeQuals
_ Attributes
_) = forall (m :: * -> *) a. Monad m => a -> m a
return 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 CExpr
sz' <- forall (m :: * -> *).
MonadTrav m =>
MachineDesc -> Map Ident CExpr -> CExpr -> m CExpr
constEval MachineDesc
md forall k a. Map k a
Map.empty CExpr
sz
     case CExpr
sz' of
       CConst (CIntConst CInteger
i NodeInfo
_) ->
         do Integer
s <- forall (m :: * -> *) n.
(MonadTrav m, CNode n) =>
MachineDesc -> n -> Type -> m Integer
sizeofType MachineDesc
md n
n Type
bt
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CInteger -> Integer
getCInteger CInteger
i forall a. Num a => a -> a -> a
* Integer
s
       CExpr
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return 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
_) = 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
_) = forall (m :: * -> *) a. Monad m => a -> m a
return 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
_) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ MachineDesc -> Integer
voidAlign MachineDesc
md
alignofType MachineDesc
md n
_ (DirectType (TyIntegral IntType
it) TypeQuals
_ Attributes
_) = forall (m :: * -> *) a. Monad m => a -> m a
return 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
_) = forall (m :: * -> *) a. Monad m => a -> m a
return 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
_) = forall (m :: * -> *) a. Monad m => a -> m a
return 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
_) = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadTrav m =>
MachineDesc -> CompTypeRef -> m (Integer, Integer)
compSizeAndAlign MachineDesc
md CompTypeRef
ctr
alignofType MachineDesc
md n
_ (DirectType (TyEnum EnumTypeRef
_) TypeQuals
_ Attributes
_) = forall (m :: * -> *) a. Monad m => a -> m a
return 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
_) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ MachineDesc -> BuiltinType -> Integer
builtinAlign MachineDesc
md BuiltinType
b
alignofType MachineDesc
md n
_ (PtrType Type
_ TypeQuals
_ Attributes
_)  = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ MachineDesc -> Integer
ptrAlign MachineDesc
md
alignofType MachineDesc
md n
_ (ArrayType Type
_ (UnknownArraySize Bool
_) TypeQuals
_ Attributes
_) = forall (m :: * -> *) a. Monad m => a -> m a
return 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
_) = 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
_) = 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 = forall (m :: * -> *) a. MonadCError m => NodeInfo -> String -> m a
astError (forall a. CNode a => a -> NodeInfo
nodeInfo n
n) forall a b. (a -> b) -> a -> b
$
                 String
"can't find alignment of type: " forall a. [a] -> [a] -> [a]
++ (Doc -> String
render forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 DefTable
dt <- forall (m :: * -> *). MonadSymtab m => m DefTable
getDefTable
     case SUERef -> DefTable -> Maybe TagEntry
lookupTag (forall a. HasSUERef a => a -> SUERef
sueRef CompTypeRef
ctr) DefTable
dt of
       Just (Left TagFwdDecl
_)   -> forall (m :: * -> *) a. MonadCError m => NodeInfo -> String -> m a
astError (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 = forall a b. (a -> b) -> [a] -> [b]
map forall n. Declaration n => n -> Type
declType [MemberDecl]
ms
            [Integer]
sizes <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *) n.
(MonadTrav m, CNode n) =>
MachineDesc -> n -> Type -> m Integer
sizeofType MachineDesc
md NodeInfo
ni) [Type]
ts
            [Integer]
aligns <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *) n.
(MonadTrav m, CNode n) =>
MachineDesc -> n -> Type -> m Integer
alignofType MachineDesc
md NodeInfo
ni) [Type]
ts
            let alignment :: Integer
alignment = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Integer
1 forall a. a -> [a] -> [a]
: [Integer]
aligns)
                size :: Integer
size = case CompTyKind
tag of
                  CompTyKind
UnionTag -> Integer -> Integer -> Integer
roundToAlignment Integer
alignment (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Integer
0 forall a. a -> [a] -> [a]
: [Integer]
sizes))
                  CompTyKind
StructTag ->
                    let sizeAndNextAlignment :: [(Integer, Integer)]
sizeAndNextAlignment =
                          forall a b. [a] -> [b] -> [(a, b)]
zip [Integer]
sizes (forall a. [a] -> [a]
tail [Integer]
aligns forall a. [a] -> [a] -> [a]
++ [Integer
alignment])
                        offsets :: Integer
offsets = 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 forall a. Num a => a -> a -> a
+ Integer
memberSize))
                          Integer
0
                          [(Integer, Integer)]
sizeAndNextAlignment
                    in Integer
offsets
            forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
size, Integer
alignment)
       Just (Right (EnumDef EnumType
_)) -> forall (m :: * -> *) a. Monad m => a -> m a
return 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         -> forall (m :: * -> *) a. MonadCError m => NodeInfo -> String -> m a
astError (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 forall a. Num a => a -> a -> a
* ((Integer
value forall a. Num a => a -> a -> a
+ (Integer
alignment forall a. Num a => a -> a -> a
- Integer
1)) 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 forall a. Num a => a -> a -> a
+ Integer
i2
intOp CBinaryOp
CSubOp Integer
i1 Integer
i2 = Integer
i1 forall a. Num a => a -> a -> a
- Integer
i2
intOp CBinaryOp
CMulOp Integer
i1 Integer
i2 = Integer
i1 forall a. Num a => a -> a -> a
* Integer
i2
intOp CBinaryOp
CDivOp Integer
i1 Integer
i2 = Integer
i1 forall a. Integral a => a -> a -> a
`div` Integer
i2
intOp CBinaryOp
CRmdOp Integer
i1 Integer
i2 = Integer
i1 forall a. Integral a => a -> a -> a
`mod` Integer
i2
intOp CBinaryOp
CShlOp Integer
i1 Integer
i2 = Integer
i1 forall a. Bits a => a -> Int -> a
`shiftL` forall a. Num a => Integer -> a
fromInteger Integer
i2
intOp CBinaryOp
CShrOp Integer
i1 Integer
i2 = Integer
i1 forall a. Bits a => a -> Int -> a
`shiftR` forall a. Num a => Integer -> a
fromInteger Integer
i2
intOp CBinaryOp
CLeOp  Integer
i1 Integer
i2 = forall a. Integral a => a -> Integer
toInteger forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum forall a b. (a -> b) -> a -> b
$ Integer
i1 forall a. Ord a => a -> a -> Bool
< Integer
i2
intOp CBinaryOp
CGrOp  Integer
i1 Integer
i2 = forall a. Integral a => a -> Integer
toInteger forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum forall a b. (a -> b) -> a -> b
$ Integer
i1 forall a. Ord a => a -> a -> Bool
> Integer
i2
intOp CBinaryOp
CLeqOp Integer
i1 Integer
i2 = forall a. Integral a => a -> Integer
toInteger forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum forall a b. (a -> b) -> a -> b
$ Integer
i1 forall a. Ord a => a -> a -> Bool
<= Integer
i2
intOp CBinaryOp
CGeqOp Integer
i1 Integer
i2 = forall a. Integral a => a -> Integer
toInteger forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum forall a b. (a -> b) -> a -> b
$ Integer
i1 forall a. Ord a => a -> a -> Bool
>= Integer
i2
intOp CBinaryOp
CEqOp  Integer
i1 Integer
i2 = forall a. Integral a => a -> Integer
toInteger forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum forall a b. (a -> b) -> a -> b
$ Integer
i1 forall a. Eq a => a -> a -> Bool
== Integer
i2
intOp CBinaryOp
CNeqOp Integer
i1 Integer
i2 = forall a. Integral a => a -> Integer
toInteger forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum forall a b. (a -> b) -> a -> b
$ Integer
i1 forall a. Eq a => a -> a -> Bool
/= Integer
i2
intOp CBinaryOp
CAndOp Integer
i1 Integer
i2 = Integer
i1 forall a. Bits a => a -> a -> a
.&. Integer
i2
intOp CBinaryOp
CXorOp Integer
i1 Integer
i2 = Integer
i1 forall a. Bits a => a -> a -> a
`xor` Integer
i2
intOp CBinaryOp
COrOp  Integer
i1 Integer
i2 = Integer
i1 forall a. Bits a => a -> a -> a
.|. Integer
i2
intOp CBinaryOp
CLndOp Integer
i1 Integer
i2 = forall a. Integral a => a -> Integer
toInteger forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum forall a b. (a -> b) -> a -> b
$ (Integer
i1 forall a. Eq a => a -> a -> Bool
/= Integer
0) Bool -> Bool -> Bool
&& (Integer
i2 forall a. Eq a => a -> a -> Bool
/= Integer
0)
intOp CBinaryOp
CLorOp Integer
i1 Integer
i2 = forall a. Integral a => a -> Integer
toInteger forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum forall a b. (a -> b) -> a -> b
$ (Integer
i1 forall a. Eq a => a -> a -> Bool
/= Integer
0) Bool -> Bool -> Bool
|| (Integer
i2 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 = forall a. a -> Maybe a
Just Integer
i
intUnOp CUnaryOp
CMinOp  Integer
i = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ -Integer
i
intUnOp CUnaryOp
CCompOp Integer
i = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Bits a => a -> a
complement Integer
i
intUnOp CUnaryOp
CNegOp  Integer
i = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> Integer
toInteger forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum forall a b. (a -> b) -> a -> b
$ Integer
i forall a. Eq a => a -> a -> Bool
== Integer
0
intUnOp CUnaryOp
_       Integer
_ = forall a. Maybe a
Nothing

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

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

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