{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
module What4.Expr.App where
import qualified Control.Exception as Ex
import Control.Lens hiding (asIndex, (:>), Empty)
import Control.Monad
import Control.Monad.ST
import qualified Data.BitVector.Sized as BV
import Data.Foldable
import Data.Hashable
import qualified Data.HashTable.Class as H (toList)
import qualified Data.HashTable.ST.Basic as H
import Data.Kind
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.Parameterized.Classes
import Data.Parameterized.Context as Ctx
import qualified Data.Parameterized.HashTable as PH
import Data.Parameterized.NatRepr
import Data.Parameterized.Nonce
import Data.Parameterized.Some
import Data.Parameterized.TH.GADT
import Data.Parameterized.TraversableFC
import Data.Ratio (numerator, denominator)
import qualified Data.Sequence as Seq
import Data.Set (Set)
import qualified Data.Set as Set
import Data.STRef
import Data.String
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Word (Word64)
import GHC.Generics (Generic)
import LibBF (BigFloat)
import qualified LibBF as BF
import Numeric.Natural
import Prettyprinter hiding (Unbounded)
import What4.BaseTypes
import What4.Concrete
import What4.Interface
import What4.ProgramLoc
import qualified What4.SemiRing as SR
import qualified What4.SpecialFunctions as SFn
import qualified What4.Expr.ArrayUpdateMap as AUM
import What4.Expr.BoolMap (BoolMap, Polarity(..), BoolMapView(..), Wrap(..))
import qualified What4.Expr.BoolMap as BM
import What4.Expr.MATLAB
import What4.Expr.WeightedSum (WeightedSum, SemiRingProduct)
import qualified What4.Expr.WeightedSum as WSum
import qualified What4.Expr.StringSeq as SSeq
import What4.Expr.UnaryBV (UnaryBV)
import qualified What4.Expr.UnaryBV as UnaryBV
import What4.Utils.AbstractDomains
import What4.Utils.Arithmetic
import qualified What4.Utils.BVDomain as BVD
import What4.Utils.Complex
import What4.Utils.IncrHash
import qualified What4.Utils.AnnotatedMap as AM
data NonceAppExpr t (tp :: BaseType)
= NonceAppExprCtor { forall t (tp :: BaseType). NonceAppExpr t tp -> Nonce t tp
nonceExprId :: {-# UNPACK #-} !(Nonce t tp)
, forall t (tp :: BaseType). NonceAppExpr t tp -> ProgramLoc
nonceExprLoc :: !ProgramLoc
, forall t (tp :: BaseType).
NonceAppExpr t tp -> NonceApp t (Expr t) tp
nonceExprApp :: !(NonceApp t (Expr t) tp)
, forall t (tp :: BaseType). NonceAppExpr t tp -> AbstractValue tp
nonceExprAbsValue :: !(AbstractValue tp)
}
data AppExpr t (tp :: BaseType)
= AppExprCtor { forall t (tp :: BaseType). AppExpr t tp -> Nonce t tp
appExprId :: {-# UNPACK #-} !(Nonce t tp)
, forall t (tp :: BaseType). AppExpr t tp -> ProgramLoc
appExprLoc :: !ProgramLoc
, forall t (tp :: BaseType). AppExpr t tp -> App (Expr t) tp
appExprApp :: !(App (Expr t) tp)
, forall t (tp :: BaseType). AppExpr t tp -> AbstractValue tp
appExprAbsValue :: !(AbstractValue tp)
}
data Expr t (tp :: BaseType) where
SemiRingLiteral :: !(SR.SemiRingRepr sr) -> !(SR.Coefficient sr) -> !ProgramLoc -> Expr t (SR.SemiRingBase sr)
BoolExpr :: !Bool -> !ProgramLoc -> Expr t BaseBoolType
FloatExpr :: !(FloatPrecisionRepr fpp) -> !BigFloat -> !ProgramLoc -> Expr t (BaseFloatType fpp)
StringExpr :: !(StringLiteral si) -> !ProgramLoc -> Expr t (BaseStringType si)
AppExpr :: {-# UNPACK #-} !(AppExpr t tp) -> Expr t tp
NonceAppExpr :: {-# UNPACK #-} !(NonceAppExpr t tp) -> Expr t tp
BoundVarExpr :: !(ExprBoundVar t tp) -> Expr t tp
data BVOrNote w = BVOrNote !IncrHash !(BVD.BVDomain w)
newtype BVOrSet e w = BVOrSet (AM.AnnotatedMap (Wrap e (BaseBVType w)) (BVOrNote w) ())
data App (e :: BaseType -> Type) (tp :: BaseType) where
BaseIte ::
!(BaseTypeRepr tp) ->
!Integer ->
!(e BaseBoolType) ->
!(e tp) ->
!(e tp) ->
App e tp
BaseEq ::
!(BaseTypeRepr tp) ->
!(e tp) ->
!(e tp) ->
App e BaseBoolType
NotPred :: !(e BaseBoolType) -> App e BaseBoolType
ConjPred :: !(BoolMap e) -> App e BaseBoolType
SemiRingSum ::
{-# UNPACK #-} !(WeightedSum e sr) ->
App e (SR.SemiRingBase sr)
SemiRingProd ::
{-# UNPACK #-} !(SemiRingProduct e sr) ->
App e (SR.SemiRingBase sr)
SemiRingLe
:: !(SR.OrderedSemiRingRepr sr)
-> !(e (SR.SemiRingBase sr))
-> !(e (SR.SemiRingBase sr))
-> App e BaseBoolType
RealIsInteger :: !(e BaseRealType) -> App e BaseBoolType
IntDiv :: !(e BaseIntegerType) -> !(e BaseIntegerType) -> App e BaseIntegerType
IntMod :: !(e BaseIntegerType) -> !(e BaseIntegerType) -> App e BaseIntegerType
IntAbs :: !(e BaseIntegerType) -> App e BaseIntegerType
IntDivisible :: !(e BaseIntegerType) -> Natural -> App e BaseBoolType
RealDiv :: !(e BaseRealType) -> !(e BaseRealType) -> App e BaseRealType
RealSqrt :: !(e BaseRealType) -> App e BaseRealType
RealSpecialFunction ::
!(SFn.SpecialFunction args) ->
!(SFn.SpecialFnArgs e BaseRealType args) ->
App e (BaseRealType)
BVTestBit :: (1 <= w)
=> !Natural
-> !(e (BaseBVType w))
-> App e BaseBoolType
BVSlt :: (1 <= w)
=> !(e (BaseBVType w))
-> !(e (BaseBVType w))
-> App e BaseBoolType
BVUlt :: (1 <= w)
=> !(e (BaseBVType w))
-> !(e (BaseBVType w))
-> App e BaseBoolType
BVOrBits :: (1 <= w) => !(NatRepr w) -> !(BVOrSet e w) -> App e (BaseBVType w)
BVUnaryTerm :: (1 <= n)
=> !(UnaryBV (e BaseBoolType) n)
-> App e (BaseBVType n)
BVConcat :: (1 <= u, 1 <= v, 1 <= (u+v))
=> !(NatRepr (u+v))
-> !(e (BaseBVType u))
-> !(e (BaseBVType v))
-> App e (BaseBVType (u+v))
BVSelect :: (1 <= n, idx + n <= w)
=> !(NatRepr idx)
-> !(NatRepr n)
-> !(e (BaseBVType w))
-> App e (BaseBVType n)
BVFill :: (1 <= w)
=> !(NatRepr w)
-> !(e BaseBoolType)
-> App e (BaseBVType w)
BVUdiv :: (1 <= w)
=> !(NatRepr w)
-> !(e (BaseBVType w))
-> !(e (BaseBVType w))
-> App e (BaseBVType w)
BVUrem :: (1 <= w)
=> !(NatRepr w)
-> !(e (BaseBVType w))
-> !(e (BaseBVType w))
-> App e (BaseBVType w)
BVSdiv :: (1 <= w)
=> !(NatRepr w)
-> !(e (BaseBVType w))
-> !(e (BaseBVType w))
-> App e (BaseBVType w)
BVSrem :: (1 <= w)
=> !(NatRepr w)
-> !(e (BaseBVType w))
-> !(e (BaseBVType w))
-> App e (BaseBVType w)
BVShl :: (1 <= w)
=> !(NatRepr w)
-> !(e (BaseBVType w))
-> !(e (BaseBVType w))
-> App e (BaseBVType w)
BVLshr :: (1 <= w)
=> !(NatRepr w)
-> !(e (BaseBVType w))
-> !(e (BaseBVType w))
-> App e (BaseBVType w)
BVAshr :: (1 <= w)
=> !(NatRepr w)
-> !(e (BaseBVType w))
-> !(e (BaseBVType w))
-> App e (BaseBVType w)
BVRol :: (1 <= w)
=> !(NatRepr w)
-> !(e (BaseBVType w))
-> !(e (BaseBVType w))
-> App e (BaseBVType w)
BVRor :: (1 <= w)
=> !(NatRepr w)
-> !(e (BaseBVType w))
-> !(e (BaseBVType w))
-> App e (BaseBVType w)
BVZext :: (1 <= w, w+1 <= r, 1 <= r)
=> !(NatRepr r)
-> !(e (BaseBVType w))
-> App e (BaseBVType r)
BVSext :: (1 <= w, w+1 <= r, 1 <= r)
=> !(NatRepr r)
-> !(e (BaseBVType w))
-> App e (BaseBVType r)
BVPopcount ::
(1 <= w) =>
!(NatRepr w) ->
!(e (BaseBVType w)) ->
App e (BaseBVType w)
BVCountTrailingZeros ::
(1 <= w) =>
!(NatRepr w) ->
!(e (BaseBVType w)) ->
App e (BaseBVType w)
BVCountLeadingZeros ::
(1 <= w) =>
!(NatRepr w) ->
!(e (BaseBVType w)) ->
App e (BaseBVType w)
FloatNeg
:: !(FloatPrecisionRepr fpp)
-> !(e (BaseFloatType fpp))
-> App e (BaseFloatType fpp)
FloatAbs
:: !(FloatPrecisionRepr fpp)
-> !(e (BaseFloatType fpp))
-> App e (BaseFloatType fpp)
FloatSqrt
:: !(FloatPrecisionRepr fpp)
-> !RoundingMode
-> !(e (BaseFloatType fpp))
-> App e (BaseFloatType fpp)
FloatAdd
:: !(FloatPrecisionRepr fpp)
-> !RoundingMode
-> !(e (BaseFloatType fpp))
-> !(e (BaseFloatType fpp))
-> App e (BaseFloatType fpp)
FloatSub
:: !(FloatPrecisionRepr fpp)
-> !RoundingMode
-> !(e (BaseFloatType fpp))
-> !(e (BaseFloatType fpp))
-> App e (BaseFloatType fpp)
FloatMul
:: !(FloatPrecisionRepr fpp)
-> !RoundingMode
-> !(e (BaseFloatType fpp))
-> !(e (BaseFloatType fpp))
-> App e (BaseFloatType fpp)
FloatDiv
:: !(FloatPrecisionRepr fpp)
-> !RoundingMode
-> !(e (BaseFloatType fpp))
-> !(e (BaseFloatType fpp))
-> App e (BaseFloatType fpp)
FloatRem
:: !(FloatPrecisionRepr fpp)
-> !(e (BaseFloatType fpp))
-> !(e (BaseFloatType fpp))
-> App e (BaseFloatType fpp)
FloatFMA
:: !(FloatPrecisionRepr fpp)
-> !RoundingMode
-> !(e (BaseFloatType fpp))
-> !(e (BaseFloatType fpp))
-> !(e (BaseFloatType fpp))
-> App e (BaseFloatType fpp)
FloatFpEq
:: !(e (BaseFloatType fpp))
-> !(e (BaseFloatType fpp))
-> App e BaseBoolType
FloatLe
:: !(e (BaseFloatType fpp))
-> !(e (BaseFloatType fpp))
-> App e BaseBoolType
FloatLt
:: !(e (BaseFloatType fpp))
-> !(e (BaseFloatType fpp))
-> App e BaseBoolType
FloatIsNaN :: !(e (BaseFloatType fpp)) -> App e BaseBoolType
FloatIsInf :: !(e (BaseFloatType fpp)) -> App e BaseBoolType
FloatIsZero :: !(e (BaseFloatType fpp)) -> App e BaseBoolType
FloatIsPos :: !(e (BaseFloatType fpp)) -> App e BaseBoolType
FloatIsNeg :: !(e (BaseFloatType fpp)) -> App e BaseBoolType
FloatIsSubnorm :: !(e (BaseFloatType fpp)) -> App e BaseBoolType
FloatIsNorm :: !(e (BaseFloatType fpp)) -> App e BaseBoolType
FloatCast
:: !(FloatPrecisionRepr fpp)
-> !RoundingMode
-> !(e (BaseFloatType fpp'))
-> App e (BaseFloatType fpp)
FloatRound
:: !(FloatPrecisionRepr fpp)
-> !RoundingMode
-> !(e (BaseFloatType fpp))
-> App e (BaseFloatType fpp)
FloatFromBinary
:: (2 <= eb, 2 <= sb)
=> !(FloatPrecisionRepr (FloatingPointPrecision eb sb))
-> !(e (BaseBVType (eb + sb)))
-> App e (BaseFloatType (FloatingPointPrecision eb sb))
FloatToBinary
:: (2 <= eb, 2 <= sb, 1 <= eb + sb)
=> !(FloatPrecisionRepr (FloatingPointPrecision eb sb))
-> !(e (BaseFloatType (FloatingPointPrecision eb sb)))
-> App e (BaseBVType (eb + sb))
BVToFloat
:: (1 <= w)
=> !(FloatPrecisionRepr fpp)
-> !RoundingMode
-> !(e (BaseBVType w))
-> App e (BaseFloatType fpp)
SBVToFloat
:: (1 <= w)
=> !(FloatPrecisionRepr fpp)
-> !RoundingMode
-> !(e (BaseBVType w))
-> App e (BaseFloatType fpp)
RealToFloat
:: !(FloatPrecisionRepr fpp)
-> !RoundingMode
-> !(e BaseRealType)
-> App e (BaseFloatType fpp)
FloatToBV
:: (1 <= w)
=> !(NatRepr w)
-> !RoundingMode
-> !(e (BaseFloatType fpp))
-> App e (BaseBVType w)
FloatToSBV
:: (1 <= w)
=> !(NatRepr w)
-> !RoundingMode
-> !(e (BaseFloatType fpp))
-> App e (BaseBVType w)
FloatToReal :: !(e (BaseFloatType fpp)) -> App e BaseRealType
FloatSpecialFunction ::
!(FloatPrecisionRepr fpp) ->
!(SFn.SpecialFunction args) ->
!(SFn.SpecialFnArgs e (BaseFloatType fpp) args) ->
App e (BaseFloatType fpp)
ArrayMap :: !(Ctx.Assignment BaseTypeRepr (i ::> itp))
-> !(BaseTypeRepr tp)
-> !(AUM.ArrayUpdateMap e (i ::> itp) tp)
-> !(e (BaseArrayType (i::> itp) tp))
-> App e (BaseArrayType (i ::> itp) tp)
ConstantArray :: !(Ctx.Assignment BaseTypeRepr (i ::> tp))
-> !(BaseTypeRepr b)
-> !(e b)
-> App e (BaseArrayType (i::>tp) b)
UpdateArray :: !(BaseTypeRepr b)
-> !(Ctx.Assignment BaseTypeRepr (i::>tp))
-> !(e (BaseArrayType (i::>tp) b))
-> !(Ctx.Assignment e (i::>tp))
-> !(e b)
-> App e (BaseArrayType (i::>tp) b)
SelectArray :: !(BaseTypeRepr b)
-> !(e (BaseArrayType (i::>tp) b))
-> !(Ctx.Assignment e (i::>tp))
-> App e b
CopyArray ::
(1 <= w) =>
!(NatRepr w) ->
!(BaseTypeRepr a) ->
!(e (BaseArrayType (SingleCtx (BaseBVType w)) a)) ->
!(e (BaseBVType w)) ->
!(e (BaseArrayType (SingleCtx (BaseBVType w)) a)) ->
!(e (BaseBVType w)) ->
!(e (BaseBVType w)) ->
!(e (BaseBVType w)) ->
!(e (BaseBVType w)) ->
App e (BaseArrayType (SingleCtx (BaseBVType w)) a)
SetArray ::
(1 <= w) =>
!(NatRepr w) ->
!(BaseTypeRepr a) ->
!(e (BaseArrayType (SingleCtx (BaseBVType w)) a)) ->
!(e (BaseBVType w)) ->
!(e a) ->
!(e (BaseBVType w)) ->
!(e (BaseBVType w)) ->
App e (BaseArrayType (SingleCtx (BaseBVType w)) a)
EqualArrayRange ::
(1 <= w) =>
!(NatRepr w) ->
!(BaseTypeRepr a) ->
!(e (BaseArrayType (SingleCtx (BaseBVType w)) a)) ->
!(e (BaseBVType w)) ->
!(e (BaseArrayType (SingleCtx (BaseBVType w)) a)) ->
!(e (BaseBVType w)) ->
!(e (BaseBVType w)) ->
!(e (BaseBVType w)) ->
!(e (BaseBVType w)) ->
App e BaseBoolType
IntegerToReal :: !(e BaseIntegerType) -> App e BaseRealType
RealToInteger :: !(e BaseRealType) -> App e BaseIntegerType
BVToInteger :: (1 <= w) => !(e (BaseBVType w)) -> App e BaseIntegerType
SBVToInteger :: (1 <= w) => !(e (BaseBVType w)) -> App e BaseIntegerType
IntegerToBV :: (1 <= w) => !(e BaseIntegerType) -> NatRepr w -> App e (BaseBVType w)
RoundReal :: !(e BaseRealType) -> App e BaseIntegerType
RoundEvenReal :: !(e BaseRealType) -> App e BaseIntegerType
FloorReal :: !(e BaseRealType) -> App e BaseIntegerType
CeilReal :: !(e BaseRealType) -> App e BaseIntegerType
Cplx :: {-# UNPACK #-} !(Complex (e BaseRealType)) -> App e BaseComplexType
RealPart :: !(e BaseComplexType) -> App e BaseRealType
ImagPart :: !(e BaseComplexType) -> App e BaseRealType
StringContains :: !(e (BaseStringType si))
-> !(e (BaseStringType si))
-> App e BaseBoolType
StringIsPrefixOf :: !(e (BaseStringType si))
-> !(e (BaseStringType si))
-> App e BaseBoolType
StringIsSuffixOf :: !(e (BaseStringType si))
-> !(e (BaseStringType si))
-> App e BaseBoolType
StringIndexOf :: !(e (BaseStringType si))
-> !(e (BaseStringType si))
-> !(e BaseIntegerType)
-> App e BaseIntegerType
StringSubstring :: !(StringInfoRepr si)
-> !(e (BaseStringType si))
-> !(e BaseIntegerType)
-> !(e BaseIntegerType)
-> App e (BaseStringType si)
StringAppend :: !(StringInfoRepr si)
-> !(SSeq.StringSeq e si)
-> App e (BaseStringType si)
StringLength :: !(e (BaseStringType si))
-> App e BaseIntegerType
StructCtor :: !(Ctx.Assignment BaseTypeRepr flds)
-> !(Ctx.Assignment e flds)
-> App e (BaseStructType flds)
StructField :: !(e (BaseStructType flds))
-> !(Ctx.Index flds tp)
-> !(BaseTypeRepr tp)
-> App e tp
data VarKind
= QuantifierVarKind
| LatchVarKind
| UninterpVarKind
data ExprBoundVar t (tp :: BaseType) =
BVar { forall t (tp :: BaseType). ExprBoundVar t tp -> Nonce t tp
bvarId :: {-# UNPACK #-} !(Nonce t tp)
, forall t (tp :: BaseType). ExprBoundVar t tp -> ProgramLoc
bvarLoc :: !ProgramLoc
, forall t (tp :: BaseType). ExprBoundVar t tp -> SolverSymbol
bvarName :: !SolverSymbol
, forall t (tp :: BaseType). ExprBoundVar t tp -> BaseTypeRepr tp
bvarType :: !(