{-# 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 CExpr
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 CExpr
sz' of
       CConst (CIntConst CInteger
i NodeInfo
_) ->
         do Integer
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
            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
$ CInteger -> Integer
getCInteger CInteger
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
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 DefTable
dt <- m DefTable
forall (m :: * -> *). MonadSymtab m => m DefTable
getDefTable
     case SUERef -> DefTable -> Maybe TagEntry
lookupTag (CompTypeRef -> SUERef
forall a. HasSUERef a => a -> SUERef
sueRef CompTypeRef
ctr) DefTable
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
            [Integer]
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
            [Integer]
aligns <- (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
alignofType MachineDesc
md NodeInfo
ni) [Type]
ts
            let alignment :: Integer
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 :: Integer
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
            (Integer, Integer) -> m (Integer, Integer)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
size, Integer
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 CExpr
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
     Maybe CExpr
me2' <- m (Maybe CExpr)
-> (CExpr -> m (Maybe CExpr)) -> Maybe CExpr -> m (Maybe CExpr)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe CExpr -> m (Maybe CExpr)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CExpr
forall a. Maybe a
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) Maybe CExpr
me2
     CExpr
e3'  <- 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
e3
     case CExpr -> Maybe Bool
boolValue CExpr
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 CExpr
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
     CExpr
e2' <- 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
e2
     Type
t <- [StmtCtx] -> ExprSide -> CExpr -> m Type
forall (m :: * -> *).
MonadTrav m =>
[StmtCtx] -> ExprSide -> CExpr -> m Type
tExpr [] ExprSide
RValue CExpr
e
     Int
bytes <- Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> m Integer -> m Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` MachineDesc -> CExpr -> Type -> m Integer
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) -> 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 CExpr
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
     Type
t <- [StmtCtx] -> ExprSide -> CExpr -> m Type
forall (m :: * -> *).
MonadTrav m =>
[StmtCtx] -> ExprSide -> CExpr -> m Type
tExpr [] ExprSide
RValue CExpr
e
     Int
bytes <- Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> m Integer -> m Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` MachineDesc -> CExpr -> Type -> m Integer
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' -> 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 CExpr
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
     Type
t <- CDeclaration NodeInfo -> m Type
forall (m :: * -> *).
MonadTrav m =>
CDeclaration NodeInfo -> m Type
analyseTypeDecl CDeclaration NodeInfo
d
     Int
bytes <- Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> m Integer -> m Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` MachineDesc -> CDeclaration NodeInfo -> Type -> m Integer
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 -> 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 Type
t <- [StmtCtx] -> ExprSide -> CExpr -> m Type
forall (m :: * -> *).
MonadTrav m =>
[StmtCtx] -> ExprSide -> CExpr -> m Type
tExpr [] ExprSide
RValue CExpr
e
     Integer
sz <- MachineDesc -> CExpr -> Type -> m Integer
forall (m :: * -> *) n.
(MonadTrav m, CNode n) =>
MachineDesc -> n -> Type -> m Integer
sizeofType MachineDesc
md CExpr
e Type
t
     NodeInfo -> Integer -> m CExpr
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 <- CDeclaration NodeInfo -> m Type
forall (m :: * -> *).
MonadTrav m =>
CDeclaration NodeInfo -> m Type
analyseTypeDecl CDeclaration NodeInfo
d
     Integer
sz <- MachineDesc -> CDeclaration NodeInfo -> Type -> m Integer
forall (m :: * -> *) n.
(MonadTrav m, CNode n) =>
MachineDesc -> n -> Type -> m Integer
sizeofType MachineDesc
md CDeclaration NodeInfo
d Type
t
     NodeInfo -> Integer -> m CExpr
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 <- [StmtCtx] -> ExprSide -> CExpr -> m Type
forall (m :: * -> *).
MonadTrav m =>
[StmtCtx] -> ExprSide -> CExpr -> m Type
tExpr [] ExprSide
RValue CExpr
e
     Integer
sz <- MachineDesc -> CExpr -> Type -> m Integer
forall (m :: * -> *) n.
(MonadTrav m, CNode n) =>
MachineDesc -> n -> Type -> m Integer
alignofType MachineDesc
md CExpr
e Type
t
     NodeInfo -> Integer -> m CExpr
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 <- CDeclaration NodeInfo -> m Type
forall (m :: * -> *).
MonadTrav m =>
CDeclaration NodeInfo -> m Type
analyseTypeDecl CDeclaration NodeInfo
d
     Integer
sz <- MachineDesc -> CDeclaration NodeInfo -> Type -> m Integer
forall (m :: * -> *) n.
(MonadTrav m, CNode n) =>
MachineDesc -> n -> Type -> m Integer
alignofType MachineDesc
md CDeclaration NodeInfo
d Type
t
     NodeInfo -> Integer -> m CExpr
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
_) | 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 Type
t <- [StmtCtx] -> ExprSide -> CExpr -> m Type
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 <- m DefTable
forall (m :: * -> *). MonadSymtab m => m DefTable
getDefTable
            case SUERef -> DefTable -> Maybe TagEntry
lookupTag (EnumTypeRef -> SUERef
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' <- (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
                   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'
              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 CExpr
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'
             Map Ident CExpr -> m (Map Ident CExpr)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Ident CExpr -> m (Map Ident CExpr))
-> Map Ident CExpr -> m (Map Ident CExpr)
forall a b. (a -> b) -> a -> b
$ Ident -> CExpr -> Map Ident CExpr -> Map Ident CExpr
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 = CExpr -> m CExpr
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return CExpr
e