{-# 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
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)
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"
roundToAlignment
:: Integer
-> Integer
-> Integer
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)
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)
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