{-|
Module      : What4.Expr.App
Copyright   : (c) Galois Inc, 2015-2020
License     : BSD3
Maintainer  : jhendrix@galois.com

This module defines datastructures that encode the basic
syntax formers used in What4.ExprBuilder.
-}
{-# 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 types

-- | This type represents 'Expr' values that were built from a
-- 'NonceApp'.
--
-- Parameter @t@ is a phantom type brand used to track nonces.
--
-- Selector functions are provided to destruct 'NonceAppExpr' values,
-- but the constructor is kept hidden. The preferred way to construct
-- an 'Expr' from a 'NonceApp' is to use 'sbNonceExpr'.
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)
                     }

-- | This type represents 'Expr' values that were built from an 'App'.
--
-- Parameter @t@ is a phantom type brand used to track nonces.
--
-- Selector functions are provided to destruct 'AppExpr' values, but
-- the constructor is kept hidden. The preferred way to construct an
-- 'Expr' from an 'App' is to use 'sbMakeExpr'.
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)
                }

-- | The main ExprBuilder expression datastructure.  The non-trivial @Expr@
-- values constructed by this module are uniquely identified by a
-- nonce value that is used to explicitly represent sub-term sharing.
-- When traversing the structure of an @Expr@ it is usually very important
-- to memoize computations based on the values of these identifiers to avoid
-- exponential blowups due to shared term structure.
--
-- Type parameter @t@ is a phantom type brand used to relate nonces to
-- a specific nonce generator (similar to the @s@ parameter of the
-- @ST@ monad). The type index @tp@ of kind 'BaseType' indicates the
-- type of the values denoted by the given expression.
--
-- Type @'Expr' t@ instantiates the type family @'SymExpr'
-- ('ExprBuilder' t st)@.
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)
  -- Application
  AppExpr :: {-# UNPACK #-} !(AppExpr t tp) -> Expr t tp
  -- An atomic predicate
  NonceAppExpr :: {-# UNPACK #-} !(NonceAppExpr t tp) -> Expr t tp
  -- A bound variable
  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) ())


-- | Type @'App' e tp@ encodes the top-level application of an 'Expr'
-- expression. It includes first-order expression forms that do not
-- bind variables (contrast with 'NonceApp').
--
-- Parameter @e@ is used everywhere a recursive sub-expression would
-- go. Uses of the 'App' type will tie the knot through this
-- parameter. Parameter @tp@ indicates the type of the expression.
data App (e :: BaseType -> Type) (tp :: BaseType) where

  ------------------------------------------------------------------------
  -- Generic operations

  BaseIte ::
    !(BaseTypeRepr tp) ->
    !Integer {- Total number of predicates in this ite tree -} ->
    !(e BaseBoolType) ->
    !(e tp) ->
    !(e tp) ->
    App e tp

  BaseEq ::
    !(BaseTypeRepr tp) ->
    !(e tp) ->
    !(e tp) ->
    App e BaseBoolType

  ------------------------------------------------------------------------
  -- Boolean operations

  -- Invariant: The argument to a NotPred must not be another NotPred.
  NotPred :: !(e BaseBoolType) -> App e BaseBoolType

  -- Invariant: The BoolMap must contain at least two elements. No
  -- element may be a NotPred; negated elements must be represented
  -- with Negative element polarity.
  ConjPred :: !(BoolMap e) -> App e BaseBoolType

  ------------------------------------------------------------------------
  -- Semiring operations

  SemiRingSum ::
    {-# UNPACK #-} !(WeightedSum e sr) ->
    App e (SR.SemiRingBase sr)

  -- A product of semiring values
  --
  -- The ExprBuilder should maintain the invariant that none of the values is
  -- a constant, and hence this denotes a non-linear expression.
  -- Multiplications by scalars should use the 'SemiRingSum' constructor.
  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

  ------------------------------------------------------------------------
  -- Basic arithmetic operations

  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

  -- Returns @sqrt(x)@, result is not defined if @x@ is negative.
  RealSqrt :: !(e BaseRealType) -> App e BaseRealType

  ------------------------------------------------------------------------
  -- Operations that introduce irrational numbers.

  RealSpecialFunction ::
    !(SFn.SpecialFunction args) ->
    !(SFn.SpecialFnArgs e BaseRealType args) ->
    App e (BaseRealType)

  --------------------------------
  -- Bitvector operations

  -- Return value of bit at given index.
  BVTestBit :: (1 <= w)
            => !Natural -- Index of bit to test
                        -- (least-significant bit has index 0)
            -> !(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)

  -- A unary representation of terms where an integer @i@ is mapped to a
  -- predicate that is true if the unsigned encoding of the value is greater
  -- than or equal to @i@.
  --
  -- The map contains a binding (i -> p_i) when the predicate
  --
  -- As an example, we can encode the value @1@ with the assignment:
  --   { 0 => true ; 2 => false }
  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)
              -- First bit to select from (least-significant bit has index 0)
           => !(NatRepr idx)
              -- Number of bits to select, counting up toward more significant bits
           -> !(NatRepr n)
              -- Bitvector to select from.
           -> !(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)) -- bitvector to rotate
        -> !(e (BaseBVType w)) -- rotate amount
        -> App e (BaseBVType w)

  BVRor :: (1 <= w)
        => !(NatRepr w)
        -> !(e (BaseBVType w))   -- bitvector to rotate
        -> !(e (BaseBVType w))   -- rotate amount
        -> 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)

  --------------------------------
  -- Float operations

  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)

  ------------------------------------------------------------------------
  -- Array operations

  -- Partial map from concrete indices to array values over another array.
  ArrayMap :: !(Ctx.Assignment BaseTypeRepr (i ::> itp))
           -> !(BaseTypeRepr tp)
                -- /\ The type of the array.
           -> !(AUM.ArrayUpdateMap e (i ::> itp) tp)
              -- /\ Maps indices that are updated to the associated value.
           -> !(e (BaseArrayType (i::> itp) tp))
              -- /\ The underlying array that has been updated.
           -> App e (BaseArrayType (i ::> itp) tp)

  -- Constant array
  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)) {- @dest_arr@ -} ->
    !(e (BaseBVType w)) {- @dest_idx@ -} ->
    !(e (BaseArrayType (SingleCtx (BaseBVType w)) a)) {- @src_arr@ -} ->
    !(e (BaseBVType w)) {- @src_idx@ -} ->
    !(e (BaseBVType w)) {- @len@ -} ->
    !(e (BaseBVType w)) {- @dest_idx + len@ -} ->
    !(e (BaseBVType w)) {- @src_idx + len@ -} ->
    App e (BaseArrayType (SingleCtx (BaseBVType w)) a)

  SetArray ::
    (1 <= w) =>
    !(NatRepr w) ->
    !(BaseTypeRepr a) ->
    !(e (BaseArrayType (SingleCtx (BaseBVType w)) a)) {- @arr@ -} ->
    !(e (BaseBVType w)) {- @idx@ -} ->
    !(e a) {- @val@ -}->
    !(e (BaseBVType w)) {- @len@ -} ->
    !(e (BaseBVType w)) {- @idx + len@ -} ->
    App e (BaseArrayType (SingleCtx (BaseBVType w)) a)

  EqualArrayRange ::
    (1 <= w) =>
    !(NatRepr w) ->
    !(BaseTypeRepr a) ->
    !(e (BaseArrayType (SingleCtx (BaseBVType w)) a)) {- @lhs_arr@ -} ->
    !(e (BaseBVType w)) {- @lhs_idx@ -} ->
    !(e (BaseArrayType (SingleCtx (BaseBVType w)) a)) {- @rhs_arr@ -} ->
    !(e (BaseBVType w)) {- @rhs_idx@ -} ->
    !(e (BaseBVType w)) {- @len@ -} ->
    !(e (BaseBVType w)) {- @lhs_idx + len@ -} ->
    !(e (BaseBVType w)) {- @rhs_idx + len@ -} ->
    App e BaseBoolType

  ------------------------------------------------------------------------
  -- Conversions.

  IntegerToReal :: !(e BaseIntegerType) -> App e BaseRealType

  -- Convert a real value to an integer
  --
  -- Not defined on non-integral reals.
  RealToInteger :: !(e BaseRealType) -> App e BaseIntegerType

  BVToInteger   :: (1 <= w) => !(e (BaseBVType w)) -> App e BaseIntegerType
  SBVToInteger  :: (1 <= w) => !(e (BaseBVType w)) -> App e BaseIntegerType

  -- Converts integer to a bitvector.  The number is interpreted modulo 2^n.
  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

  ------------------------------------------------------------------------
  -- Complex operations

  Cplx  :: {-# UNPACK #-} !(Complex (e BaseRealType)) -> App e BaseComplexType
  RealPart :: !(e BaseComplexType) -> App e BaseRealType
  ImagPart :: !(e BaseComplexType) -> App e BaseRealType

  ------------------------------------------------------------------------
  -- Strings

  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

  ------------------------------------------------------------------------
  -- Structs

  -- A struct with its fields.
  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

-- | The Kind of a bound variable.
data VarKind
  = QuantifierVarKind
    -- ^ A variable appearing in a quantifier.
  | LatchVarKind
    -- ^ A variable appearing as a latch input.
  | UninterpVarKind
    -- ^ A variable appearing in a uninterpreted constant

-- | Information about bound variables.
-- Parameter @t@ is a phantom type brand used to track nonces.
--
-- Type @'ExprBoundVar' t@ instantiates the type family
-- @'BoundVar' ('ExprBuilder' t st)@.
--
-- Selector functions are provided to destruct 'ExprBoundVar'
-- values, but the constructor is kept hidden. The preferred way to
-- construct a 'ExprBoundVar' is to use 'freshBoundVar'.
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 :: !(BaseTypeRepr tp)
       , forall t (tp :: BaseType). ExprBoundVar t tp -> VarKind
bvarKind :: !VarKind
       , forall t (tp :: BaseType).
ExprBoundVar t tp -> Maybe (AbstractValue tp)
bvarAbstractValue :: !(Maybe (AbstractValue tp))
       }

-- | Type @NonceApp t e tp@ encodes the top-level application of an
-- 'Expr'. It includes expression forms that bind variables (contrast
-- with 'App').
--
-- Parameter @t@ is a phantom type brand used to track nonces.
-- Parameter @e@ is used everywhere a recursive sub-expression would
-- go. Uses of the 'NonceApp' type will tie the knot through this
-- parameter. Parameter @tp@ indicates the type of the expression.
data NonceApp t (e :: BaseType -> Type) (tp :: BaseType) where
  Annotation ::
    !(BaseTypeRepr tp) ->
    !(Nonce t tp) ->
    !(e tp) ->
    NonceApp t e tp

  Forall :: !(ExprBoundVar t tp)
         -> !(e BaseBoolType)
         -> NonceApp t e BaseBoolType
  Exists :: !(ExprBoundVar t tp)
         -> !(e BaseBoolType)
         -> NonceApp t e BaseBoolType

  -- Create an array from a function
  ArrayFromFn :: !(ExprSymFn t (idx ::> itp) ret)
              -> NonceApp t e (BaseArrayType (idx ::> itp) ret)

  -- Create an array by mapping over one or more existing arrays.
  MapOverArrays :: !(ExprSymFn t (ctx::>d) r)
                -> !(Ctx.Assignment BaseTypeRepr (idx ::> itp))
                -> !(Ctx.Assignment (ArrayResultWrapper e (idx ::> itp)) (ctx::>d))
                -> NonceApp t e (BaseArrayType (idx ::> itp) r)

  -- This returns true if all the indices satisfying the given predicate equal true.
  ArrayTrueOnEntries
    :: !(ExprSymFn t (idx ::> itp) BaseBoolType)
    -> !(e (BaseArrayType (idx ::> itp) BaseBoolType))
    -> NonceApp t e BaseBoolType

  -- Apply a function to some arguments
  FnApp :: !(ExprSymFn t args ret)
        -> !(Ctx.Assignment e args)
        -> NonceApp t e ret

-- | This describes information about an undefined or defined function.
-- Parameter @t@ is a phantom type brand used to track nonces.
-- The @args@ and @ret@ parameters define the types of arguments
-- and the return type of the function.
data SymFnInfo t (args :: Ctx BaseType) (ret :: BaseType)
   = UninterpFnInfo !(Ctx.Assignment BaseTypeRepr args)
                    !(BaseTypeRepr ret)
     -- ^ Information about the argument type and return type of an uninterpreted function.

   | DefinedFnInfo !(Ctx.Assignment (ExprBoundVar t) args)
                   !(Expr t ret)
                   !UnfoldPolicy
     -- ^ Information about a defined function.
     -- Includes bound variables and an expression associated to a defined function,
     -- as well as a policy for when to unfold the body.

   | MatlabSolverFnInfo !(MatlabSolverFn (Expr t) args ret)
                        !(Ctx.Assignment (ExprBoundVar t) args)
                        !(Expr t ret)
     -- ^ This is a function that corresponds to a matlab solver function.
     --   It includes the definition as a ExprBuilder expr to
     --   enable export to other solvers.

-- | This represents a symbolic function in the simulator.
-- Parameter @t@ is a phantom type brand used to track nonces.
-- The @args@ and @ret@ parameters define the types of arguments
-- and the return type of the function.
--
-- Type @'ExprSymFn' t (Expr t)@ instantiates the type family @'SymFn'
-- ('ExprBuilder' t st)@.
data ExprSymFn t (args :: Ctx BaseType) (ret :: BaseType)
   = ExprSymFn { forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Nonce t (args ::> ret)
symFnId :: !(Nonce t (args ::> ret))
                 -- /\ A unique identifier for the function
                 , forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SolverSymbol
symFnName :: !SolverSymbol
                 -- /\ Name of the function
                 , forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SymFnInfo t args ret
symFnInfo :: !(SymFnInfo t args ret)
                 -- /\ Information about function
                 , forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> ProgramLoc
symFnLoc  :: !ProgramLoc
                 -- /\ Location where function was defined.
                 }

------------------------------------------------------------------------
-- Template Haskell–generated definitions

-- Dummy declaration splice to bring App into template haskell scope.
$(return [])

-- | Used to implement foldMapFc from traversal.
data Dummy (tp :: k)

instance Eq (Dummy tp) where
  Dummy tp
_ == :: Dummy tp -> Dummy tp -> Bool
== Dummy tp
_ = Bool
True
instance EqF Dummy where
  eqF :: forall (a :: k). Dummy a -> Dummy a -> Bool
eqF Dummy a
_ Dummy a
_ = Bool
True
instance TestEquality Dummy where
  testEquality :: forall (a :: k) (b :: k). Dummy a -> Dummy b -> Maybe (a :~: b)
testEquality Dummy a
x Dummy b
_y = case Dummy a
x of {}

instance Ord (Dummy tp) where
  compare :: Dummy tp -> Dummy tp -> Ordering
compare Dummy tp
_ Dummy tp
_ = Ordering
EQ
instance OrdF Dummy where
  compareF :: forall (x :: k) (y :: k). Dummy x -> Dummy y -> OrderingF x y
compareF Dummy x
x Dummy y
_y = case Dummy x
x of {}

instance HashableF Dummy where
  hashWithSaltF :: forall (tp :: k). Int -> Dummy tp -> Int
hashWithSaltF Int
_ Dummy tp
_ = Int
0

instance HasAbsValue Dummy where
  getAbsValue :: forall (tp :: BaseType). Dummy tp -> AbstractValue tp
getAbsValue Dummy tp
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"you made a magic Dummy value!"

instance FoldableFC App where
  foldMapFC :: forall (f :: BaseType -> Type) m.
Monoid m =>
(forall (x :: BaseType). f x -> m)
-> forall (x :: BaseType). App f x -> m
foldMapFC forall (x :: BaseType). f x -> m
f0 App f x
t = forall {k} a (b :: k). Const a b -> a
getConst (forall (m :: Type -> Type) (f :: BaseType -> Type)
       (e :: BaseType -> Type) (utp :: BaseType).
(Applicative m, OrdF f, Eq (f BaseBoolType), HashableF f,
 HasAbsValue f) =>
(forall (tp :: BaseType). e tp -> m (f tp))
-> App e utp -> m (App f utp)
traverseApp (forall {k} (f :: k -> Type) (tp :: k) a.
(f tp -> a) -> f tp -> Const a (Dummy tp)
g forall (x :: BaseType). f x -> m
f0) App f x
t)
    where g :: (f tp -> a) -> f tp -> Const a (Dummy tp)
          g :: forall {k} (f :: k -> Type) (tp :: k) a.
(f tp -> a) -> f tp -> Const a (Dummy tp)
g f tp -> a
f f tp
v = forall {k} a (b :: k). a -> Const a b
Const (f tp -> a
f f tp
v)

traverseApp :: (Applicative m, OrdF f, Eq (f (BaseBoolType)), HashableF f, HasAbsValue f)
            => (forall tp. e tp -> m (f tp))
            -> App e utp -> m ((App f) utp)
traverseApp :: forall (m :: Type -> Type) (f :: BaseType -> Type)
       (e :: BaseType -> Type) (utp :: BaseType).
(Applicative m, OrdF f, Eq (f BaseBoolType), HashableF f,
 HasAbsValue f) =>
(forall (tp :: BaseType). e tp -> m (f tp))
-> App e utp -> m (App f utp)
traverseApp =
  $(structuralTraversal [t|App|]
    [ ( ConType [t|UnaryBV|] `TypeApp` AnyType `TypeApp` AnyType
      , [|UnaryBV.instantiate|]
      )
    , ( ConType [t|Ctx.Assignment BaseTypeRepr|] `TypeApp` AnyType
      , [|(\_ -> pure) |]
      )
    , ( ConType [t|WeightedSum|] `TypeApp` AnyType `TypeApp` AnyType
      , [| WSum.traverseVars |]
      )
    , ( ConType [t|BVOrSet|] `TypeApp` AnyType `TypeApp` AnyType
      , [| traverseBVOrSet |]
      )
    , ( ConType [t|SemiRingProduct|] `TypeApp` AnyType `TypeApp` AnyType
      , [| WSum.traverseProdVars |]
      )
    , ( ConType [t|AUM.ArrayUpdateMap|] `TypeApp` AnyType `TypeApp` AnyType `TypeApp` AnyType
      , [| AUM.traverseArrayUpdateMap |]
      )
    , ( ConType [t|SSeq.StringSeq|] `TypeApp` AnyType `TypeApp` AnyType
      , [| SSeq.traverseStringSeq |]
      )
    , ( ConType [t|BoolMap|] `TypeApp` AnyType
      , [| BM.traverseVars |]
      )
    , ( ConType [t|Ctx.Assignment|] `TypeApp` AnyType `TypeApp` AnyType
      , [| traverseFC |]
      )
    , ( ConType [t|SFn.SpecialFnArgs|] `TypeApp` AnyType `TypeApp` AnyType `TypeApp` AnyType
      , [| SFn.traverseSpecialFnArgs |]
      )
    ]
   )

{-# NOINLINE appEqF #-}
-- | Check if two applications are equal.
appEqF ::
  (Eq (e BaseBoolType), Eq (e BaseRealType), HashableF e, HasAbsValue e, OrdF e) =>
  App e x -> App e y -> Maybe (x :~: y)
appEqF :: forall (e :: BaseType -> Type) (x :: BaseType) (y :: BaseType).
(Eq (e BaseBoolType), Eq (e BaseRealType), HashableF e,
 HasAbsValue e, OrdF e) =>
App e x -> App e y -> Maybe (x :~: y)
appEqF = $(structuralTypeEquality [t|App|]
           [ (TypeApp (ConType [t|NatRepr|]) AnyType, [|testEquality|])
           , (TypeApp (ConType [t|FloatPrecisionRepr|]) AnyType, [|testEquality|])
           , (TypeApp (ConType [t|BaseTypeRepr|]) AnyType, [|testEquality|])
           , (DataArg 0 `TypeApp` AnyType, [|testEquality|])
           , (ConType [t|UnaryBV|] `TypeApp` AnyType `TypeApp` AnyType
             , [|testEquality|])
           , (ConType [t|AUM.ArrayUpdateMap|] `TypeApp` AnyType `TypeApp` AnyType `TypeApp` AnyType
             , [|\x y -> if x == y then Just Refl else Nothing|])
           , (ConType [t|Ctx.Assignment|] `TypeApp` AnyType `TypeApp` AnyType
             , [|testEquality|])
           , (ConType [t|Ctx.Index|] `TypeApp` AnyType `TypeApp` AnyType
             , [|testEquality|])
           , (ConType [t|StringInfoRepr|] `TypeApp` AnyType
             , [|testEquality|])
           , (ConType [t|SR.SemiRingRepr|] `TypeApp` AnyType
             , [|testEquality|])
           , (ConType [t|SR.OrderedSemiRingRepr|] `TypeApp` AnyType
             , [|testEquality|])
           , (ConType [t|SFn.SpecialFunction|] `TypeApp` AnyType
             , [|testEquality|])
           , (ConType [t|WSum.WeightedSum|] `TypeApp` AnyType `TypeApp` AnyType
             , [|testEquality|])
           , (ConType [t|SemiRingProduct|] `TypeApp` AnyType `TypeApp` AnyType
             , [|testEquality|])
           ]
          )

instance (Eq (e BaseBoolType), Eq (e BaseRealType), HashableF e, HasAbsValue e, OrdF e) => Eq (App e tp) where
  App e tp
x == :: App e tp -> App e tp -> Bool
== App e tp
y = forall a. Maybe a -> Bool
isJust (forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality App e tp
x App e tp
y)

instance (Eq (e BaseBoolType), Eq (e BaseRealType), HashableF e, HasAbsValue e, OrdF e) => TestEquality (App e) where
  testEquality :: forall (a :: BaseType) (b :: BaseType).
App e a -> App e b -> Maybe (a :~: b)
testEquality = forall (e :: BaseType -> Type) (x :: BaseType) (y :: BaseType).
(Eq (e BaseBoolType), Eq (e BaseRealType), HashableF e,
 HasAbsValue e, OrdF e) =>
App e x -> App e y -> Maybe (x :~: y)
appEqF

{-# NOINLINE hashApp #-}
-- | Hash an an application.
hashApp ::
  (OrdF e, HashableF e, HasAbsValue e, Hashable (e BaseBoolType), Hashable (e BaseRealType)) =>
  Int -> App e s -> Int
hashApp :: forall (e :: BaseType -> Type) (s :: BaseType).
(OrdF e, HashableF e, HasAbsValue e, Hashable (e BaseBoolType),
 Hashable (e BaseRealType)) =>
Int -> App e s -> Int
hashApp = $(structuralHashWithSalt [t|App|]
               [(DataArg 0 `TypeApp` AnyType, [|hashWithSaltF|])]
           )

instance (OrdF e, HashableF e, HasAbsValue e, Hashable (e BaseBoolType), Hashable (e BaseRealType)) =>
  HashableF (App e) where
    hashWithSaltF :: forall (tp :: BaseType). Int -> App e tp -> Int
hashWithSaltF = forall (e :: BaseType -> Type) (s :: BaseType).
(OrdF e, HashableF e, HasAbsValue e, Hashable (e BaseBoolType),
 Hashable (e BaseRealType)) =>
Int -> App e s -> Int
hashApp


-- | Return 'true' if an app represents a non-linear operation.
-- Controls whether the non-linear counter ticks upward in the
-- 'Statistics'.
isNonLinearApp :: App e tp -> Bool
isNonLinearApp :: forall (e :: BaseType -> Type) (tp :: BaseType). App e tp -> Bool
isNonLinearApp App e tp
app = case App e tp
app of
  -- FIXME: These are just guesses; someone who knows what's actually
  -- slow in the solvers should correct them.

  SemiRingProd SemiRingProduct e sr
pd
    | SR.SemiRingBVRepr BVFlavorRepr fv
SR.BVBitsRepr NatRepr w
_ <- forall (f :: BaseType -> Type) (sr :: SemiRing).
SemiRingProduct f sr -> SemiRingRepr sr
WSum.prodRepr SemiRingProduct e sr
pd -> Bool
False
    | Bool
otherwise -> Bool
True

  IntDiv {} -> Bool
True
  IntMod {} -> Bool
True
  IntDivisible {} -> Bool
True

  RealDiv {} -> Bool
True
  RealSqrt {} -> Bool
True
  RealSpecialFunction{} -> Bool
True

  BVUdiv {} -> Bool
True
  BVUrem {} -> Bool
True
  BVSdiv {} -> Bool
True
  BVSrem {} -> Bool
True

  FloatSqrt {} -> Bool
True
  FloatMul {} -> Bool
True
  FloatDiv {} -> Bool
True
  FloatRem {} -> Bool
True
  FloatSpecialFunction{} -> Bool
True

  App e tp
_ -> Bool
False



instance TestEquality e => Eq (NonceApp t e tp) where
  NonceApp t e tp
x == :: NonceApp t e tp -> NonceApp t e tp -> Bool
== NonceApp t e tp
y = forall a. Maybe a -> Bool
isJust (forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NonceApp t e tp
x NonceApp t e tp
y)

instance TestEquality e => TestEquality (NonceApp t e) where
  testEquality :: forall (a :: BaseType) (b :: BaseType).
NonceApp t e a -> NonceApp t e b -> Maybe (a :~: b)
testEquality =
    $(structuralTypeEquality [t|NonceApp|]
           [ (DataArg 0 `TypeApp` AnyType, [|testEquality|])
           , (DataArg 1 `TypeApp` AnyType, [|testEquality|])
           , ( ConType [t|BaseTypeRepr|] `TypeApp` AnyType
             , [|testEquality|]
             )
           , ( ConType [t|Nonce|] `TypeApp` AnyType `TypeApp` AnyType
             , [|testEquality|]
             )
           , ( ConType [t|ExprBoundVar|] `TypeApp` AnyType `TypeApp` AnyType
             , [|testEquality|]
             )
           , ( ConType [t|ExprSymFn|] `TypeApp` AnyType `TypeApp` AnyType `TypeApp` AnyType
              , [|testExprSymFnEq|]
              )
           , ( ConType [t|Ctx.Assignment|] `TypeApp` AnyType `TypeApp` AnyType
             , [|testEquality|]
             )
           ]
          )

instance (HashableF e, TestEquality e) => HashableF (NonceApp t e) where
  hashWithSaltF :: forall (tp :: BaseType). Int -> NonceApp t e tp -> Int
hashWithSaltF = $(structuralHashWithSalt [t|NonceApp|]
                      [ (DataArg 1 `TypeApp` AnyType, [|hashWithSaltF|]) ])

traverseArrayResultWrapper
  :: Functor m
  => (forall tp . e tp -> m (f tp))
     -> ArrayResultWrapper e (idx ::> itp) c
     -> m (ArrayResultWrapper f (idx ::> itp) c)
traverseArrayResultWrapper :: forall (m :: Type -> Type) (e :: BaseType -> Type)
       (f :: BaseType -> Type) (idx :: Ctx BaseType) (itp :: BaseType)
       (c :: BaseType).
Functor m =>
(forall (tp :: BaseType). e tp -> m (f tp))
-> ArrayResultWrapper e (idx ::> itp) c
-> m (ArrayResultWrapper f (idx ::> itp) c)
traverseArrayResultWrapper forall (tp :: BaseType). e tp -> m (f tp)
f (ArrayResultWrapper e (BaseArrayType (idx ::> itp) c)
a) =
  forall (f :: BaseType -> Type) (idx :: Ctx BaseType)
       (tp :: BaseType).
f (BaseArrayType idx tp) -> ArrayResultWrapper f idx tp
ArrayResultWrapper forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (tp :: BaseType). e tp -> m (f tp)
f e (BaseArrayType (idx ::> itp) c)
a

traverseArrayResultWrapperAssignment
  :: Applicative m
  => (forall tp . e tp -> m (f tp))
     -> Ctx.Assignment (ArrayResultWrapper e (idx ::> itp)) c
     -> m (Ctx.Assignment (ArrayResultWrapper f (idx ::> itp)) c)
traverseArrayResultWrapperAssignment :: forall (m :: Type -> Type) (e :: BaseType -> Type)
       (f :: BaseType -> Type) (idx :: Ctx BaseType) (itp :: BaseType)
       (c :: Ctx BaseType).
Applicative m =>
(forall (tp :: BaseType). e tp -> m (f tp))
-> Assignment (ArrayResultWrapper e (idx ::> itp)) c
-> m (Assignment (ArrayResultWrapper f (idx ::> itp)) c)
traverseArrayResultWrapperAssignment forall (tp :: BaseType). e tp -> m (f tp)
f = forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
       (g :: k -> Type) (m :: Type -> Type).
(TraversableFC t, Applicative m) =>
(forall (x :: k). f x -> m (g x))
-> forall (x :: l). t f x -> m (t g x)
traverseFC (\ArrayResultWrapper e (idx ::> itp) x
e -> forall (m :: Type -> Type) (e :: BaseType -> Type)
       (f :: BaseType -> Type) (idx :: Ctx BaseType) (itp :: BaseType)
       (c :: BaseType).
Functor m =>
(forall (tp :: BaseType). e tp -> m (f tp))
-> ArrayResultWrapper e (idx ::> itp) c
-> m (ArrayResultWrapper f (idx ::> itp) c)
traverseArrayResultWrapper forall (tp :: BaseType). e tp -> m (f tp)
f ArrayResultWrapper e (idx ::> itp) x
e)

instance FunctorFC (NonceApp t)  where
  fmapFC :: forall (f :: BaseType -> Type) (g :: BaseType -> Type).
(forall (x :: BaseType). f x -> g x)
-> forall (x :: BaseType). NonceApp t f x -> NonceApp t g x
fmapFC = forall {k} {l} (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
       (g :: k -> Type).
TraversableFC t =>
(forall (x :: k). f x -> g x) -> forall (x :: l). t f x -> t g x
fmapFCDefault

instance FoldableFC (NonceApp t) where
  foldMapFC :: forall (f :: BaseType -> Type) m.
Monoid m =>
(forall (x :: BaseType). f x -> m)
-> forall (x :: BaseType). NonceApp t f x -> m
foldMapFC = forall {k} {l} (t :: (k -> Type) -> l -> Type) m (f :: k -> Type).
(TraversableFC t, Monoid m) =>
(forall (x :: k). f x -> m) -> forall (x :: l). t f x -> m
foldMapFCDefault

instance TraversableFC (NonceApp t) where
  traverseFC :: forall (f :: BaseType -> Type) (g :: BaseType -> Type)
       (m :: Type -> Type).
Applicative m =>
(forall (x :: BaseType). f x -> m (g x))
-> forall (x :: BaseType). NonceApp t f x -> m (NonceApp t g x)
traverseFC =
    $(structuralTraversal [t|NonceApp|]
      [ ( ConType [t|Ctx.Assignment|]
          `TypeApp` (ConType [t|ArrayResultWrapper|] `TypeApp` AnyType `TypeApp` AnyType)
          `TypeApp` AnyType
        , [|traverseArrayResultWrapperAssignment|]
        )
      , ( ConType [t|ExprSymFn|] `TypeApp` AnyType `TypeApp` AnyType `TypeApp` AnyType `TypeApp` AnyType
        , [|\_-> pure|]
        )
      , ( ConType [t|Ctx.Assignment|] `TypeApp` ConType [t|BaseTypeRepr|] `TypeApp` AnyType
        , [|\_ -> pure|]
        )
      , ( ConType [t|Ctx.Assignment|] `TypeApp` AnyType `TypeApp` AnyType
        , [|traverseFC|]
        )
      ]
     )

instance PolyEq (Expr t x) (Expr t y) where
  polyEqF :: Expr t x -> Expr t y -> Maybe (Expr t x :~: Expr t y)
polyEqF Expr t x
x Expr t y
y = do
    x :~: y
Refl <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality Expr t x
x Expr t y
y
    forall (m :: Type -> Type) a. Monad m => a -> m a
return forall {k} (a :: k). a :~: a
Refl

------------------------------------------------------------------------
-- Expr

-- | Destructor for the 'AppExpr' constructor.
{-# INLINE asApp #-}
asApp :: Expr t tp -> Maybe (App (Expr t) tp)
asApp :: forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp (AppExpr AppExpr t tp
a) = forall a. a -> Maybe a
Just (forall t (tp :: BaseType). AppExpr t tp -> App (Expr t) tp
appExprApp AppExpr t tp
a)
asApp Expr t tp
_ = forall a. Maybe a
Nothing

-- | Destructor for the 'NonceAppExpr' constructor.
{-# INLINE asNonceApp #-}
asNonceApp :: Expr t tp -> Maybe (NonceApp t (Expr t) tp)
asNonceApp :: forall t (tp :: BaseType).
Expr t tp -> Maybe (NonceApp t (Expr t) tp)
asNonceApp (NonceAppExpr NonceAppExpr t tp
a) = forall a. a -> Maybe a
Just (forall t (tp :: BaseType).
NonceAppExpr t tp -> NonceApp t (Expr t) tp
nonceExprApp NonceAppExpr t tp
a)
asNonceApp Expr t tp
_ = forall a. Maybe a
Nothing

exprLoc :: Expr t tp -> ProgramLoc
exprLoc :: forall t (tp :: BaseType). Expr t tp -> ProgramLoc
exprLoc (SemiRingLiteral SemiRingRepr sr
_ Coefficient sr
_ ProgramLoc
l) = ProgramLoc
l
exprLoc (BoolExpr Bool
_ ProgramLoc
l) = ProgramLoc
l
exprLoc (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
_ ProgramLoc
l) = ProgramLoc
l
exprLoc (StringExpr StringLiteral si
_ ProgramLoc
l) = ProgramLoc
l
exprLoc (NonceAppExpr NonceAppExpr t tp
a)  = forall t (tp :: BaseType). NonceAppExpr t tp -> ProgramLoc
nonceExprLoc NonceAppExpr t tp
a
exprLoc (AppExpr AppExpr t tp
a)   = forall t (tp :: BaseType). AppExpr t tp -> ProgramLoc
appExprLoc AppExpr t tp
a
exprLoc (BoundVarExpr ExprBoundVar t tp
v) = forall t (tp :: BaseType). ExprBoundVar t tp -> ProgramLoc
bvarLoc ExprBoundVar t tp
v

mkExpr :: Nonce t tp
      -> ProgramLoc
      -> App (Expr t) tp
      -> AbstractValue tp
      -> Expr t tp
mkExpr :: forall t (tp :: BaseType).
Nonce t tp
-> ProgramLoc -> App (Expr t) tp -> AbstractValue tp -> Expr t tp
mkExpr Nonce t tp
n ProgramLoc
l App (Expr t) tp
a AbstractValue tp
v = forall t (tp :: BaseType). AppExpr t tp -> Expr t tp
AppExpr forall a b. (a -> b) -> a -> b
$ AppExprCtor { appExprId :: Nonce t tp
appExprId  = Nonce t tp
n
                                    , appExprLoc :: ProgramLoc
appExprLoc = ProgramLoc
l
                                    , appExprApp :: App (Expr t) tp
appExprApp = App (Expr t) tp
a
                                    , appExprAbsValue :: AbstractValue tp
appExprAbsValue = AbstractValue tp
v
                                    }



type BoolExpr t = Expr t BaseBoolType
type FloatExpr t fpp = Expr t (BaseFloatType fpp)
type BVExpr t n = Expr t (BaseBVType n)
type IntegerExpr t = Expr t BaseIntegerType
type RealExpr t = Expr t BaseRealType
type CplxExpr t = Expr t BaseComplexType
type StringExpr t si = Expr t (BaseStringType si)



iteSize :: Expr t tp -> Integer
iteSize :: forall t (tp :: BaseType). Expr t tp -> Integer
iteSize Expr t tp
e =
  case forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t tp
e of
    Just (BaseIte BaseTypeRepr tp
_ Integer
sz Expr t BaseBoolType
_ Expr t tp
_ Expr t tp
_) -> Integer
sz
    Maybe (App (Expr t) tp)
_ -> Integer
0

instance IsExpr (Expr t) where
  asConstantPred :: Expr t BaseBoolType -> Maybe Bool
asConstantPred = forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue

  asInteger :: Expr t BaseIntegerType -> Maybe Integer
asInteger (SemiRingLiteral SemiRingRepr sr
SR.SemiRingIntegerRepr Coefficient sr
n ProgramLoc
_) = forall a. a -> Maybe a
Just Coefficient sr
n
  asInteger Expr t BaseIntegerType
_ = forall a. Maybe a
Nothing

  integerBounds :: Expr t BaseIntegerType -> ValueRange Integer
integerBounds Expr t BaseIntegerType
x = forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue Expr t BaseIntegerType
x

  asRational :: Expr t BaseRealType -> Maybe Rational
asRational (SemiRingLiteral SemiRingRepr sr
SR.SemiRingRealRepr Coefficient sr
r ProgramLoc
_) = forall a. a -> Maybe a
Just Coefficient sr
r
  asRational Expr t BaseRealType
_ = forall a. Maybe a
Nothing

  rationalBounds :: Expr t BaseRealType -> ValueRange Rational
rationalBounds Expr t BaseRealType
x = RealAbstractValue -> ValueRange Rational
ravRange forall a b. (a -> b) -> a -> b
$ forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue Expr t BaseRealType
x

  asFloat :: forall (fpp :: FloatPrecision).
Expr t (BaseFloatType fpp) -> Maybe BigFloat
asFloat (FloatExpr FloatPrecisionRepr fpp
_fpp BigFloat
bf ProgramLoc
_) = forall a. a -> Maybe a
Just BigFloat
bf
  asFloat Expr t (BaseFloatType fpp)
_ = forall a. Maybe a
Nothing

  asComplex :: Expr t BaseComplexType -> Maybe (Complex Rational)
asComplex Expr t BaseComplexType
e
    | Just (Cplx Complex (Expr t BaseRealType)
c) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t BaseComplexType
e = forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (e :: BaseType -> Type).
IsExpr e =>
e BaseRealType -> Maybe Rational
asRational Complex (Expr t BaseRealType)
c
    | Bool
otherwise = forall a. Maybe a
Nothing

  exprType :: forall (tp :: BaseType). Expr t tp -> BaseTypeRepr tp
exprType (SemiRingLiteral SemiRingRepr sr
sr Coefficient sr
_ ProgramLoc
_) = forall (sr :: SemiRing).
SemiRingRepr sr -> BaseTypeRepr (SemiRingBase sr)
SR.semiRingBase SemiRingRepr sr
sr
  exprType (BoolExpr Bool
_ ProgramLoc
_) = BaseTypeRepr BaseBoolType
BaseBoolRepr
  exprType (FloatExpr FloatPrecisionRepr fpp
fpp BigFloat
_ ProgramLoc
_) = forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> BaseTypeRepr ('BaseFloatType fpp)
BaseFloatRepr FloatPrecisionRepr fpp
fpp
  exprType (StringExpr StringLiteral si
s ProgramLoc
_) = forall (si :: StringInfo).
StringInfoRepr si -> BaseTypeRepr ('BaseStringType si)
BaseStringRepr (forall (si :: StringInfo). StringLiteral si -> StringInfoRepr si
stringLiteralInfo StringLiteral si
s)
  exprType (NonceAppExpr NonceAppExpr t tp
e)  = forall (e :: BaseType -> Type) t (tp :: BaseType).
IsExpr e =>
NonceApp t e tp -> BaseTypeRepr tp
nonceAppType (forall t (tp :: BaseType).
NonceAppExpr t tp -> NonceApp t (Expr t) tp
nonceExprApp NonceAppExpr t tp
e)
  exprType (AppExpr AppExpr t tp
e) = forall (e :: BaseType -> Type) (tp :: BaseType).
App e tp -> BaseTypeRepr tp
appType (forall t (tp :: BaseType). AppExpr t tp -> App (Expr t) tp
appExprApp AppExpr t tp
e)
  exprType (BoundVarExpr ExprBoundVar t tp
i) = forall t (tp :: BaseType). ExprBoundVar t tp -> BaseTypeRepr tp
bvarType ExprBoundVar t tp
i

  asBV :: forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
asBV (SemiRingLiteral (SR.SemiRingBVRepr BVFlavorRepr fv
_ NatRepr w
_) Coefficient sr
i ProgramLoc
_) = forall a. a -> Maybe a
Just Coefficient sr
i
  asBV Expr t (BaseBVType w)
_ = forall a. Maybe a
Nothing

  unsignedBVBounds :: forall (w :: Natural).
(1 <= w) =>
Expr t (BaseBVType w) -> Maybe (Integer, Integer)
unsignedBVBounds Expr t (BaseBVType w)
x = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (w :: Natural). BVDomain w -> (Integer, Integer)
BVD.ubounds forall a b. (a -> b) -> a -> b
$ forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue Expr t (BaseBVType w)
x
  signedBVBounds :: forall (w :: Natural).
(1 <= w) =>
Expr t (BaseBVType w) -> Maybe (Integer, Integer)
signedBVBounds Expr t (BaseBVType w)
x = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BVDomain w -> (Integer, Integer)
BVD.sbounds (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
x) forall a b. (a -> b) -> a -> b
$ forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue Expr t (BaseBVType w)
x

  asAffineVar :: forall (tp :: BaseType).
Expr t tp -> Maybe (ConcreteVal tp, Expr t tp, ConcreteVal tp)
asAffineVar Expr t tp
e = case forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType Expr t tp
e of
    BaseTypeRepr tp
BaseIntegerRepr
      | Just (Coefficient 'SemiRingInteger
a, Expr t (SemiRingBase 'SemiRingInteger)
x, Coefficient 'SemiRingInteger
b) <- forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr
-> Maybe (Coefficient sr, f (SemiRingBase sr), Coefficient sr)
WSum.asAffineVar forall a b. (a -> b) -> a -> b
$
          forall t (sr :: SemiRing).
HashableF (Expr t) =>
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> WeightedSum (Expr t) sr
asWeightedSum SemiRingRepr 'SemiRingInteger
SR.SemiRingIntegerRepr Expr t tp
e ->
        forall a. a -> Maybe a
Just (Integer -> ConcreteVal BaseIntegerType
ConcreteInteger Coefficient 'SemiRingInteger
a, Expr t (SemiRingBase 'SemiRingInteger)
x, Integer -> ConcreteVal BaseIntegerType
ConcreteInteger Coefficient 'SemiRingInteger
b)
    BaseTypeRepr tp
BaseRealRepr
      | Just (Coefficient 'SemiRingReal
a, Expr t (SemiRingBase 'SemiRingReal)
x, Coefficient 'SemiRingReal
b) <- forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr
-> Maybe (Coefficient sr, f (SemiRingBase sr), Coefficient sr)
WSum.asAffineVar forall a b. (a -> b) -> a -> b
$
          forall t (sr :: SemiRing).
HashableF (Expr t) =>
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> WeightedSum (Expr t) sr
asWeightedSum SemiRingRepr 'SemiRingReal
SR.SemiRingRealRepr Expr t tp
e ->
        forall a. a -> Maybe a
Just (Rational -> ConcreteVal BaseRealType
ConcreteReal Coefficient 'SemiRingReal
a, Expr t (SemiRingBase 'SemiRingReal)
x, Rational -> ConcreteVal BaseRealType
ConcreteReal Coefficient 'SemiRingReal
b)
    BaseBVRepr NatRepr w
w
      | Just (Coefficient ('SemiRingBV 'BVArith w)
a, Expr t (SemiRingBase ('SemiRingBV 'BVArith w))
x, Coefficient ('SemiRingBV 'BVArith w)
b) <- forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr
-> Maybe (Coefficient sr, f (SemiRingBase sr), Coefficient sr)
WSum.asAffineVar forall a b. (a -> b) -> a -> b
$
          forall t (sr :: SemiRing).
HashableF (Expr t) =>
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> WeightedSum (Expr t) sr
asWeightedSum (forall (w :: Natural) (fv :: BVFlavor).
(1 <= w) =>
BVFlavorRepr fv -> NatRepr w -> SemiRingRepr ('SemiRingBV fv w)
SR.SemiRingBVRepr BVFlavorRepr 'BVArith
SR.BVArithRepr (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t tp
e)) Expr t tp
e ->
        forall a. a -> Maybe a
Just (forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BV w -> ConcreteVal ('BaseBVType w)
ConcreteBV NatRepr w
w Coefficient ('SemiRingBV 'BVArith w)
a, Expr t (SemiRingBase ('SemiRingBV 'BVArith w))
x, forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BV w -> ConcreteVal ('BaseBVType w)
ConcreteBV NatRepr w
w Coefficient ('SemiRingBV 'BVArith w)
b)
    BaseTypeRepr tp
_ -> forall a. Maybe a
Nothing

  asString :: forall (si :: StringInfo).
Expr t (BaseStringType si) -> Maybe (StringLiteral si)
asString (StringExpr StringLiteral si
x ProgramLoc
_) = forall a. a -> Maybe a
Just StringLiteral si
x
  asString Expr t (BaseStringType si)
_ = forall a. Maybe a
Nothing

  asConstantArray :: forall (idx :: Ctx BaseType) (bt :: BaseType).
Expr t (BaseArrayType idx bt) -> Maybe (Expr t bt)
asConstantArray (forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp -> Just (ConstantArray Assignment BaseTypeRepr (i ::> tp)
_ BaseTypeRepr b
_ Expr t b
def)) = forall a. a -> Maybe a
Just Expr t b
def
  asConstantArray Expr t (BaseArrayType idx bt)
_ = forall a. Maybe a
Nothing

  asStruct :: forall (flds :: Ctx BaseType).
Expr t (BaseStructType flds) -> Maybe (Assignment (Expr t) flds)
asStruct (forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp -> Just (StructCtor Assignment BaseTypeRepr flds
_ Assignment (Expr t) flds
flds)) = forall a. a -> Maybe a
Just Assignment (Expr t) flds
flds
  asStruct Expr t (BaseStructType flds)
_ = forall a. Maybe a
Nothing

  printSymExpr :: forall (tp :: BaseType) ann. Expr t tp -> Doc ann
printSymExpr = forall a ann. Pretty a => a -> Doc ann
pretty

  unsafeSetAbstractValue :: forall (tp :: BaseType). AbstractValue tp -> Expr t tp -> Expr t tp
unsafeSetAbstractValue AbstractValue tp
av Expr t tp
e =
    case Expr t tp
e of
      SemiRingLiteral{} -> Expr t tp
e
      BoolExpr{}        -> Expr t tp
e
      FloatExpr{}       -> Expr t tp
e
      StringExpr{}      -> Expr t tp
e
      AppExpr AppExpr t tp
ae        -> forall t (tp :: BaseType). AppExpr t tp -> Expr t tp
AppExpr (AppExpr t tp
ae{appExprAbsValue :: AbstractValue tp
appExprAbsValue = AbstractValue tp
av})
      NonceAppExpr NonceAppExpr t tp
nae  -> forall t (tp :: BaseType). NonceAppExpr t tp -> Expr t tp
NonceAppExpr (NonceAppExpr t tp
nae{nonceExprAbsValue :: AbstractValue tp
nonceExprAbsValue = AbstractValue tp
av})
      BoundVarExpr ExprBoundVar t tp
ebv  -> forall t (tp :: BaseType). ExprBoundVar t tp -> Expr t tp
BoundVarExpr (ExprBoundVar t tp
ebv{bvarAbstractValue :: Maybe (AbstractValue tp)
bvarAbstractValue = forall a. a -> Maybe a
Just AbstractValue tp
av})


asSemiRingLit :: SR.SemiRingRepr sr -> Expr t (SR.SemiRingBase sr) -> Maybe (SR.Coefficient sr)
asSemiRingLit :: forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (Coefficient sr)
asSemiRingLit SemiRingRepr sr
sr (SemiRingLiteral SemiRingRepr sr
sr' Coefficient sr
x ProgramLoc
_loc)
  | Just sr :~: sr
Refl <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality SemiRingRepr sr
sr SemiRingRepr sr
sr'
  = forall a. a -> Maybe a
Just Coefficient sr
x

  -- special case, ignore the BV ring flavor for this purpose
  | SR.SemiRingBVRepr BVFlavorRepr fv
_ NatRepr w
w  <- SemiRingRepr sr
sr
  , SR.SemiRingBVRepr BVFlavorRepr fv
_ NatRepr w
w' <- SemiRingRepr sr
sr'
  , Just w :~: w
Refl <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NatRepr w
w NatRepr w
w'
  = forall a. a -> Maybe a
Just Coefficient sr
x

asSemiRingLit SemiRingRepr sr
_ Expr t (SemiRingBase sr)
_ = forall a. Maybe a
Nothing

asSemiRingSum :: SR.SemiRingRepr sr -> Expr t (SR.SemiRingBase sr) -> Maybe (WeightedSum (Expr t) sr)
asSemiRingSum :: forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (WeightedSum (Expr t) sr)
asSemiRingSum SemiRingRepr sr
sr (forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (Coefficient sr)
asSemiRingLit SemiRingRepr sr
sr -> Just Coefficient sr
x) = forall a. a -> Maybe a
Just (forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
SemiRingRepr sr -> Coefficient sr -> WeightedSum f sr
WSum.constant SemiRingRepr sr
sr Coefficient sr
x)
asSemiRingSum SemiRingRepr sr
sr (forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp -> Just (SemiRingSum WeightedSum (Expr t) sr
x))
   | Just sr :~: sr
Refl <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality SemiRingRepr sr
sr (forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> SemiRingRepr sr
WSum.sumRepr WeightedSum (Expr t) sr
x) = forall a. a -> Maybe a
Just WeightedSum (Expr t) sr
x
asSemiRingSum SemiRingRepr sr
_ Expr t (SemiRingBase sr)
_ = forall a. Maybe a
Nothing

asSemiRingProd :: SR.SemiRingRepr sr -> Expr t (SR.SemiRingBase sr) -> Maybe (SemiRingProduct (Expr t) sr)
asSemiRingProd :: forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (SemiRingProduct (Expr t) sr)
asSemiRingProd SemiRingRepr sr
sr (forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp -> Just (SemiRingProd SemiRingProduct (Expr t) sr
x))
  | Just sr :~: sr
Refl <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality SemiRingRepr sr
sr (forall (f :: BaseType -> Type) (sr :: SemiRing).
SemiRingProduct f sr -> SemiRingRepr sr
WSum.prodRepr SemiRingProduct (Expr t) sr
x) = forall a. a -> Maybe a
Just SemiRingProduct (Expr t) sr
x
asSemiRingProd SemiRingRepr sr
_ Expr t (SemiRingBase sr)
_ = forall a. Maybe a
Nothing

-- | This privides a view of a semiring expr as a weighted sum of values.
data SemiRingView t sr
   = SR_Constant !(SR.Coefficient sr)
   | SR_Sum  !(WeightedSum (Expr t) sr)
   | SR_Prod !(SemiRingProduct (Expr t) sr)
   | SR_General

viewSemiRing:: SR.SemiRingRepr sr -> Expr t (SR.SemiRingBase sr) -> SemiRingView t sr
viewSemiRing :: forall (sr :: SemiRing) t.
SemiRingRepr sr -> Expr t (SemiRingBase sr) -> SemiRingView t sr
viewSemiRing SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x
  | Just Coefficient sr
r <- forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (Coefficient sr)
asSemiRingLit SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x  = forall t (sr :: SemiRing). Coefficient sr -> SemiRingView t sr
SR_Constant Coefficient sr
r
  | Just WeightedSum (Expr t) sr
s <- forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (WeightedSum (Expr t) sr)
asSemiRingSum SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x  = forall t (sr :: SemiRing).
WeightedSum (Expr t) sr -> SemiRingView t sr
SR_Sum WeightedSum (Expr t) sr
s
  | Just SemiRingProduct (Expr t) sr
p <- forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (SemiRingProduct (Expr t) sr)
asSemiRingProd SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x = forall t (sr :: SemiRing).
SemiRingProduct (Expr t) sr -> SemiRingView t sr
SR_Prod SemiRingProduct (Expr t) sr
p
  | Bool
otherwise = forall t (sr :: SemiRing). SemiRingView t sr
SR_General

asWeightedSum :: HashableF (Expr t) => SR.SemiRingRepr sr -> Expr t (SR.SemiRingBase sr) -> WeightedSum (Expr t) sr
asWeightedSum :: forall t (sr :: SemiRing).
HashableF (Expr t) =>
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> WeightedSum (Expr t) sr
asWeightedSum SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x
  | Just Coefficient sr
r <- forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (Coefficient sr)
asSemiRingLit SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x = forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
SemiRingRepr sr -> Coefficient sr -> WeightedSum f sr
WSum.constant SemiRingRepr sr
sr Coefficient sr
r
  | Just WeightedSum (Expr t) sr
s <- forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (WeightedSum (Expr t) sr)
asSemiRingSum SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x = WeightedSum (Expr t) sr
s
  | Bool
otherwise = forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
SemiRingRepr sr -> f (SemiRingBase sr) -> WeightedSum f sr
WSum.var SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x

asConjunction :: Expr t BaseBoolType -> [(Expr t BaseBoolType, Polarity)]
asConjunction :: forall t. Expr t BaseBoolType -> [(Expr t BaseBoolType, Polarity)]
asConjunction (BoolExpr Bool
True ProgramLoc
_) = []
asConjunction (forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp -> Just (ConjPred BoolMap (Expr t)
xs)) =
 case forall (f :: BaseType -> Type). BoolMap f -> BoolMapView f
BM.viewBoolMap BoolMap (Expr t)
xs of
   BoolMapView (Expr t)
BoolMapUnit     -> []
   BoolMapView (Expr t)
BoolMapDualUnit -> [(forall t. Bool -> ProgramLoc -> Expr t BaseBoolType
BoolExpr Bool
False ProgramLoc
initializationLoc, Polarity
Positive)]
   BoolMapTerms ((Expr t BaseBoolType, Polarity)
tm:|[(Expr t BaseBoolType, Polarity)]
tms) -> (Expr t BaseBoolType, Polarity)
tmforall a. a -> [a] -> [a]
:[(Expr t BaseBoolType, Polarity)]
tms
asConjunction Expr t BaseBoolType
x = [(Expr t BaseBoolType
x,Polarity
Positive)]


asDisjunction :: Expr t BaseBoolType -> [(Expr t BaseBoolType, Polarity)]
asDisjunction :: forall t. Expr t BaseBoolType -> [(Expr t BaseBoolType, Polarity)]
asDisjunction (BoolExpr Bool
False ProgramLoc
_) = []
asDisjunction (forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp -> Just (NotPred (forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp -> Just (ConjPred BoolMap (Expr t)
xs)))) =
 case forall (f :: BaseType -> Type). BoolMap f -> BoolMapView f
BM.viewBoolMap BoolMap (Expr t)
xs of
   BoolMapView (Expr t)
BoolMapUnit     -> []
   BoolMapView (Expr t)
BoolMapDualUnit -> [(forall t. Bool -> ProgramLoc -> Expr t BaseBoolType
BoolExpr Bool
True ProgramLoc
initializationLoc, Polarity
Positive)]
   BoolMapTerms ((Expr t BaseBoolType, Polarity)
tm:|[(Expr t BaseBoolType, Polarity)]
tms) -> forall a b. (a -> b) -> [a] -> [b]
map (forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall s t a b. Field2 s t a b => Lens s t a b
_2 Polarity -> Polarity
BM.negatePolarity) ((Expr t BaseBoolType, Polarity)
tmforall a. a -> [a] -> [a]
:[(Expr t BaseBoolType, Polarity)]
tms)
asDisjunction Expr t BaseBoolType
x = [(Expr t BaseBoolType
x,Polarity
Positive)]

asPosAtom :: Expr t BaseBoolType -> (Expr t BaseBoolType, Polarity)
asPosAtom :: forall t. Expr t BaseBoolType -> (Expr t BaseBoolType, Polarity)
asPosAtom (forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp -> Just (NotPred Expr t BaseBoolType
x)) = (Expr t BaseBoolType
x, Polarity
Negative)
asPosAtom Expr t BaseBoolType
x                           = (Expr t BaseBoolType
x, Polarity
Positive)

asNegAtom :: Expr t BaseBoolType -> (Expr t BaseBoolType, Polarity)
asNegAtom :: forall t. Expr t BaseBoolType -> (Expr t BaseBoolType, Polarity)
asNegAtom (forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp -> Just (NotPred Expr t BaseBoolType
x)) = (Expr t BaseBoolType
x, Polarity
Positive)
asNegAtom Expr t BaseBoolType
x                           = (Expr t BaseBoolType
x, Polarity
Negative)


-- | Get abstract value associated with element.
exprAbsValue :: Expr t tp -> AbstractValue tp
exprAbsValue :: forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue (SemiRingLiteral SemiRingRepr sr
sr Coefficient sr
x ProgramLoc
_) =
  case SemiRingRepr sr
sr of
    SemiRingRepr sr
SR.SemiRingIntegerRepr  -> forall tp. tp -> ValueRange tp
singleRange Coefficient sr
x
    SemiRingRepr sr
SR.SemiRingRealRepr -> Rational -> RealAbstractValue
ravSingle Coefficient sr
x
    SR.SemiRingBVRepr BVFlavorRepr fv
_ NatRepr w
w -> forall (w :: Natural).
(HasCallStack, 1 <= w) =>
NatRepr w -> Integer -> BVDomain w
BVD.singleton NatRepr w
w (forall (w :: Natural). BV w -> Integer
BV.asUnsigned Coefficient sr
x)

exprAbsValue (StringExpr StringLiteral si
l ProgramLoc
_) = forall (si :: StringInfo). StringLiteral si -> StringAbstractValue
stringAbsSingle StringLiteral si
l
exprAbsValue (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
_ ProgramLoc
_) = ()
exprAbsValue (BoolExpr Bool
b ProgramLoc
_)   = forall a. a -> Maybe a
Just Bool
b
exprAbsValue (NonceAppExpr NonceAppExpr t tp
e) = forall t (tp :: BaseType). NonceAppExpr t tp -> AbstractValue tp
nonceExprAbsValue NonceAppExpr t tp
e
exprAbsValue (AppExpr AppExpr t tp
e)      = forall t (tp :: BaseType). AppExpr t tp -> AbstractValue tp
appExprAbsValue AppExpr t tp
e
exprAbsValue (BoundVarExpr ExprBoundVar t tp
v) =
  forall a. a -> Maybe a -> a
fromMaybe (forall (tp :: BaseType). BaseTypeRepr tp -> AbstractValue tp
unconstrainedAbsValue (forall t (tp :: BaseType). ExprBoundVar t tp -> BaseTypeRepr tp
bvarType ExprBoundVar t tp
v)) (forall t (tp :: BaseType).
ExprBoundVar t tp -> Maybe (AbstractValue tp)
bvarAbstractValue ExprBoundVar t tp
v)

instance HasAbsValue (Expr t) where
  getAbsValue :: forall (tp :: BaseType). Expr t tp -> AbstractValue tp
getAbsValue = forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue


------------------------------------------------------------------------
-- Expr operations

{-# INLINE compareExpr #-}
compareExpr :: Expr t x -> Expr t y -> OrderingF x y

-- Special case, ignore the BV semiring flavor for this purpose
compareExpr :: forall t (x :: BaseType) (y :: BaseType).
Expr t x -> Expr t y -> OrderingF x y
compareExpr (SemiRingLiteral (SR.SemiRingBVRepr BVFlavorRepr fv
_ NatRepr w
wx) Coefficient sr
x ProgramLoc
_) (SemiRingLiteral (SR.SemiRingBVRepr BVFlavorRepr fv
_ NatRepr w
wy) Coefficient sr
y ProgramLoc
_) =
  case forall k (ktp :: k -> Type) (x :: k) (y :: k).
OrdF ktp =>
ktp x -> ktp y -> OrderingF x y
compareF NatRepr w
wx NatRepr w
wy of
    OrderingF w w
LTF -> forall {k} (x :: k) (y :: k). OrderingF x y
LTF
    OrderingF w w
EQF -> forall {k} (x :: k). Ordering -> OrderingF x x
fromOrdering (forall a. Ord a => a -> a -> Ordering
compare Coefficient sr
x Coefficient sr
y)
    OrderingF w w
GTF -> forall {k} (x :: k) (y :: k). OrderingF x y
GTF
compareExpr (SemiRingLiteral SemiRingRepr sr
srx Coefficient sr
x ProgramLoc
_) (SemiRingLiteral SemiRingRepr sr
sry Coefficient sr
y ProgramLoc
_) =
  case forall k (ktp :: k -> Type) (x :: k) (y :: k).
OrdF ktp =>
ktp x -> ktp y -> OrderingF x y
compareF SemiRingRepr sr
srx SemiRingRepr sr
sry of
    OrderingF sr sr
LTF -> forall {k} (x :: k) (y :: k). OrderingF x y
LTF
    OrderingF sr sr
EQF -> forall {k} (x :: k). Ordering -> OrderingF x x
fromOrdering (forall (sr :: SemiRing).
SemiRingRepr sr -> Coefficient sr -> Coefficient sr -> Ordering
SR.sr_compare SemiRingRepr sr
srx Coefficient sr
x Coefficient sr
y)
    OrderingF sr sr
GTF -> forall {k} (x :: k) (y :: k). OrderingF x y
GTF
compareExpr SemiRingLiteral{} Expr t y
_ = forall {k} (x :: k) (y :: k). OrderingF x y
LTF
compareExpr Expr t x
_ SemiRingLiteral{} = forall {k} (x :: k) (y :: k). OrderingF x y
GTF

compareExpr (StringExpr StringLiteral si
x ProgramLoc
_) (StringExpr StringLiteral si
y ProgramLoc
_) =
  case forall k (ktp :: k -> Type) (x :: k) (y :: k).
OrdF ktp =>
ktp x -> ktp y -> OrderingF x y
compareF StringLiteral si
x StringLiteral si
y of
    OrderingF si si
LTF -> forall {k} (x :: k) (y :: k). OrderingF x y
LTF
    OrderingF si si
EQF -> forall {k} (x :: k). OrderingF x x
EQF
    OrderingF si si
GTF -> forall {k} (x :: k) (y :: k). OrderingF x y
GTF

compareExpr StringExpr{} Expr t y
_ = forall {k} (x :: k) (y :: k). OrderingF x y
LTF
compareExpr Expr t x
_ StringExpr{} = forall {k} (x :: k) (y :: k). OrderingF x y
GTF

compareExpr (BoolExpr Bool
x ProgramLoc
_) (BoolExpr Bool
y ProgramLoc
_) = forall {k} (x :: k). Ordering -> OrderingF x x
fromOrdering (forall a. Ord a => a -> a -> Ordering
compare Bool
x Bool
y)
compareExpr BoolExpr{} Expr t y
_ = forall {k} (x :: k) (y :: k). OrderingF x y
LTF
compareExpr Expr t x
_ BoolExpr{} = forall {k} (x :: k) (y :: k). OrderingF x y
GTF

compareExpr (FloatExpr FloatPrecisionRepr fpp
rx BigFloat
x ProgramLoc
_) (FloatExpr FloatPrecisionRepr fpp
ry BigFloat
y ProgramLoc
_) =
   case forall k (ktp :: k -> Type) (x :: k) (y :: k).
OrdF ktp =>
ktp x -> ktp y -> OrderingF x y
compareF FloatPrecisionRepr fpp
rx FloatPrecisionRepr fpp
ry of
     OrderingF fpp fpp
LTF -> forall {k} (x :: k) (y :: k). OrderingF x y
LTF
     OrderingF fpp fpp
EQF -> forall {k} (x :: k). Ordering -> OrderingF x x
fromOrdering (BigFloat -> BigFloat -> Ordering
BF.bfCompare BigFloat
x BigFloat
y) -- NB, don't use `compare`, which is IEEE754 comaprison
     OrderingF fpp fpp
GTF -> forall {k} (x :: k) (y :: k). OrderingF x y
GTF

compareExpr FloatExpr{} Expr t y
_ = forall {k} (x :: k) (y :: k). OrderingF x y
LTF
compareExpr Expr t x
_ FloatExpr{} = forall {k} (x :: k) (y :: k). OrderingF x y
GTF

compareExpr (NonceAppExpr NonceAppExpr t x
x) (NonceAppExpr NonceAppExpr t y
y) = forall k (ktp :: k -> Type) (x :: k) (y :: k).
OrdF ktp =>
ktp x -> ktp y -> OrderingF x y
compareF NonceAppExpr t x
x NonceAppExpr t y
y
compareExpr NonceAppExpr{} Expr t y
_ = forall {k} (x :: k) (y :: k). OrderingF x y
LTF
compareExpr Expr t x
_ NonceAppExpr{} = forall {k} (x :: k) (y :: k). OrderingF x y
GTF

compareExpr (AppExpr AppExpr t x
x) (AppExpr AppExpr t y
y) = forall k (ktp :: k -> Type) (x :: k) (y :: k).
OrdF ktp =>
ktp x -> ktp y -> OrderingF x y
compareF (forall t (tp :: BaseType). AppExpr t tp -> Nonce t tp
appExprId AppExpr t x
x) (forall t (tp :: BaseType). AppExpr t tp -> Nonce t tp
appExprId AppExpr t y
y)
compareExpr AppExpr{} Expr t y
_ = forall {k} (x :: k) (y :: k). OrderingF x y
LTF
compareExpr Expr t x
_ AppExpr{} = forall {k} (x :: k) (y :: k). OrderingF x y
GTF

compareExpr (BoundVarExpr ExprBoundVar t x
x) (BoundVarExpr ExprBoundVar t y
y) = forall k (ktp :: k -> Type) (x :: k) (y :: k).
OrdF ktp =>
ktp x -> ktp y -> OrderingF x y
compareF ExprBoundVar t x
x ExprBoundVar t y
y

-- | A slightly more aggressive syntactic equality check than testEquality,
--   `sameTerm` will recurse through a small collection of known syntax formers.
sameTerm :: Expr t a -> Expr t b -> Maybe (a :~: b)

sameTerm :: forall t (a :: BaseType) (b :: BaseType).
Expr t a -> Expr t b -> Maybe (a :~: b)
sameTerm (forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp -> Just (FloatToBinary FloatPrecisionRepr (FloatingPointPrecision eb sb)
fppx Expr t (BaseFloatType (FloatingPointPrecision eb sb))
x)) (forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp -> Just (FloatToBinary FloatPrecisionRepr (FloatingPointPrecision eb sb)
fppy Expr t (BaseFloatType (FloatingPointPrecision eb sb))
y)) =
  do FloatingPointPrecision eb sb :~: FloatingPointPrecision eb sb
Refl <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality FloatPrecisionRepr (FloatingPointPrecision eb sb)
fppx FloatPrecisionRepr (FloatingPointPrecision eb sb)
fppy
     BaseFloatType (FloatingPointPrecision eb sb)
:~: BaseFloatType (FloatingPointPrecision eb sb)
Refl <- forall t (a :: BaseType) (b :: BaseType).
Expr t a -> Expr t b -> Maybe (a :~: b)
sameTerm Expr t (BaseFloatType (FloatingPointPrecision eb sb))
x Expr t (BaseFloatType (FloatingPointPrecision eb sb))
y
     forall (m :: Type -> Type) a. Monad m => a -> m a
return forall {k} (a :: k). a :~: a
Refl

sameTerm Expr t a
x Expr t b
y = forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality Expr t a
x Expr t b
y


instance TestEquality (NonceAppExpr t) where
  testEquality :: forall (a :: BaseType) (b :: BaseType).
NonceAppExpr t a -> NonceAppExpr t b -> Maybe (a :~: b)
testEquality NonceAppExpr t a
x NonceAppExpr t b
y =
    case forall k (ktp :: k -> Type) (x :: k) (y :: k).
OrdF ktp =>
ktp x -> ktp y -> OrderingF x y
compareF NonceAppExpr t a
x NonceAppExpr t b
y of
      OrderingF a b
EQF -> forall a. a -> Maybe a
Just forall {k} (a :: k). a :~: a
Refl
      OrderingF a b
_ -> forall a. Maybe a
Nothing

instance OrdF (NonceAppExpr t)  where
  compareF :: forall (x :: BaseType) (y :: BaseType).
NonceAppExpr t x -> NonceAppExpr t y -> OrderingF x y
compareF NonceAppExpr t x
x NonceAppExpr t y
y = forall k (ktp :: k -> Type) (x :: k) (y :: k).
OrdF ktp =>
ktp x -> ktp y -> OrderingF x y
compareF (forall t (tp :: BaseType). NonceAppExpr t tp -> Nonce t tp
nonceExprId NonceAppExpr t x
x) (forall t (tp :: BaseType). NonceAppExpr t tp -> Nonce t tp
nonceExprId NonceAppExpr t y
y)

instance Eq (NonceAppExpr t tp) where
  NonceAppExpr t tp
x == :: NonceAppExpr t tp -> NonceAppExpr t tp -> Bool
== NonceAppExpr t tp
y = forall a. Maybe a -> Bool
isJust (forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NonceAppExpr t tp
x NonceAppExpr t tp
y)

instance Ord (NonceAppExpr t tp) where
  compare :: NonceAppExpr t tp -> NonceAppExpr t tp -> Ordering
compare NonceAppExpr t tp
x NonceAppExpr t tp
y = forall {k} (x :: k) (y :: k). OrderingF x y -> Ordering
toOrdering (forall k (ktp :: k -> Type) (x :: k) (y :: k).
OrdF ktp =>
ktp x -> ktp y -> OrderingF x y
compareF NonceAppExpr t tp
x NonceAppExpr t tp
y)

instance TestEquality (Expr t) where
  testEquality :: forall (a :: BaseType) (b :: BaseType).
Expr t a -> Expr t b -> Maybe (a :~: b)
testEquality Expr t a
x Expr t b
y =
    case forall k (ktp :: k -> Type) (x :: k) (y :: k).
OrdF ktp =>
ktp x -> ktp y -> OrderingF x y
compareF Expr t a
x Expr t b
y of
      OrderingF a b
EQF -> forall a. a -> Maybe a
Just forall {k} (a :: k). a :~: a
Refl
      OrderingF a b
_ -> forall a. Maybe a
Nothing

instance OrdF (Expr t)  where
  compareF :: forall (x :: BaseType) (y :: BaseType).
Expr t x -> Expr t y -> OrderingF x y
compareF = forall t (x :: BaseType) (y :: BaseType).
Expr t x -> Expr t y -> OrderingF x y
compareExpr

instance Eq (Expr t tp) where
  Expr t tp
x == :: Expr t tp -> Expr t tp -> Bool
== Expr t tp
y = forall a. Maybe a -> Bool
isJust (forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality Expr t tp
x Expr t tp
y)

instance Ord (Expr t tp) where
  compare :: Expr t tp -> Expr t tp -> Ordering
compare Expr t tp
x Expr t tp
y = forall {k} (x :: k) (y :: k). OrderingF x y -> Ordering
toOrdering (forall k (ktp :: k -> Type) (x :: k) (y :: k).
OrdF ktp =>
ktp x -> ktp y -> OrderingF x y
compareF Expr t tp
x Expr t tp
y)

instance Hashable (Expr t tp) where
  hashWithSalt :: Int -> Expr t tp -> Int
hashWithSalt Int
s (BoolExpr Bool
b ProgramLoc
_) = forall a. Hashable a => Int -> a -> Int
hashWithSalt (forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
0::Int)) Bool
b
  hashWithSalt Int
s (SemiRingLiteral SemiRingRepr sr
sr Coefficient sr
x ProgramLoc
_) =
    case SemiRingRepr sr
sr of
      SemiRingRepr sr
SR.SemiRingIntegerRepr -> forall a. Hashable a => Int -> a -> Int
hashWithSalt (forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
2::Int)) Coefficient sr
x
      SemiRingRepr sr
SR.SemiRingRealRepr    -> forall a. Hashable a => Int -> a -> Int
hashWithSalt (forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
3::Int)) Coefficient sr
x
      SR.SemiRingBVRepr BVFlavorRepr fv
_ NatRepr w
w  -> forall a. Hashable a => Int -> a -> Int
hashWithSalt (forall k (f :: k -> Type) (tp :: k).
HashableF f =>
Int -> f tp -> Int
hashWithSaltF (forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
4::Int)) NatRepr w
w) Coefficient sr
x

  hashWithSalt Int
s (FloatExpr FloatPrecisionRepr fpp
fr BigFloat
x ProgramLoc
_) = forall a. Hashable a => Int -> a -> Int
hashWithSalt (forall k (f :: k -> Type) (tp :: k).
HashableF f =>
Int -> f tp -> Int
hashWithSaltF (forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
5::Int)) FloatPrecisionRepr fpp
fr) BigFloat
x
  hashWithSalt Int
s (StringExpr StringLiteral si
x ProgramLoc
_) = forall a. Hashable a => Int -> a -> Int
hashWithSalt (forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
6::Int)) StringLiteral si
x
  hashWithSalt Int
s (AppExpr AppExpr t tp
x)      = forall a. Hashable a => Int -> a -> Int
hashWithSalt (forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
7::Int)) (forall t (tp :: BaseType). AppExpr t tp -> Nonce t tp
appExprId AppExpr t tp
x)
  hashWithSalt Int
s (NonceAppExpr NonceAppExpr t tp
x) = forall a. Hashable a => Int -> a -> Int
hashWithSalt (forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
8::Int)) (forall t (tp :: BaseType). NonceAppExpr t tp -> Nonce t tp
nonceExprId NonceAppExpr t tp
x)
  hashWithSalt Int
s (BoundVarExpr ExprBoundVar t tp
x) = forall a. Hashable a => Int -> a -> Int
hashWithSalt (forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
9::Int)) ExprBoundVar t tp
x

instance PH.HashableF (Expr t) where
  hashWithSaltF :: forall (tp :: BaseType). Int -> Expr t tp -> Int
hashWithSaltF = forall a. Hashable a => Int -> a -> Int
hashWithSalt


------------------------------------------------------------------------
-- PPIndex

data PPIndex
   = ExprPPIndex {-# UNPACK #-} !Word64
   | RatPPIndex !Rational
  deriving (PPIndex -> PPIndex -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PPIndex -> PPIndex -> Bool
$c/= :: PPIndex -> PPIndex -> Bool
== :: PPIndex -> PPIndex -> Bool
$c== :: PPIndex -> PPIndex -> Bool
Eq, Eq PPIndex
PPIndex -> PPIndex -> Bool
PPIndex -> PPIndex -> Ordering
PPIndex -> PPIndex -> PPIndex
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PPIndex -> PPIndex -> PPIndex
$cmin :: PPIndex -> PPIndex -> PPIndex
max :: PPIndex -> PPIndex -> PPIndex
$cmax :: PPIndex -> PPIndex -> PPIndex
>= :: PPIndex -> PPIndex -> Bool
$c>= :: PPIndex -> PPIndex -> Bool
> :: PPIndex -> PPIndex -> Bool
$c> :: PPIndex -> PPIndex -> Bool
<= :: PPIndex -> PPIndex -> Bool
$c<= :: PPIndex -> PPIndex -> Bool
< :: PPIndex -> PPIndex -> Bool
$c< :: PPIndex -> PPIndex -> Bool
compare :: PPIndex -> PPIndex -> Ordering
$ccompare :: PPIndex -> PPIndex -> Ordering
Ord, forall x. Rep PPIndex x -> PPIndex
forall x. PPIndex -> Rep PPIndex x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PPIndex x -> PPIndex
$cfrom :: forall x. PPIndex -> Rep PPIndex x
Generic)

instance Hashable PPIndex

------------------------------------------------------------------------
-- countOccurrences

countOccurrences :: Expr t tp -> Map.Map PPIndex Int
countOccurrences :: forall t (tp :: BaseType). Expr t tp -> Map PPIndex Int
countOccurrences Expr t tp
e0 = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
  HashTable s PPIndex Int
visited <- forall s k v. ST s (HashTable s k v)
H.new
  forall t (tp :: BaseType) s.
OccurrenceTable s -> Expr t tp -> ST s ()
countOccurrences' HashTable s PPIndex Int
visited Expr t tp
e0
  forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (h :: Type -> Type -> Type -> Type) s k v.
HashTable h =>
h s k v -> ST s [(k, v)]
H.toList HashTable s PPIndex Int
visited

type OccurrenceTable s = H.HashTable s PPIndex Int


incOccurrence :: OccurrenceTable s -> PPIndex -> ST s () -> ST s ()
incOccurrence :: forall s. OccurrenceTable s -> PPIndex -> ST s () -> ST s ()
incOccurrence OccurrenceTable s
visited PPIndex
idx ST s ()
sub = do
  Maybe Int
mv <- forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> ST s (Maybe v)
H.lookup OccurrenceTable s
visited PPIndex
idx
  case Maybe Int
mv of
    Just Int
i -> forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> v -> ST s ()
H.insert OccurrenceTable s
visited PPIndex
idx forall a b. (a -> b) -> a -> b
$! Int
iforall a. Num a => a -> a -> a
+Int
1
    Maybe Int
Nothing -> ST s ()
sub forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> v -> ST s ()
H.insert OccurrenceTable s
visited PPIndex
idx Int
1

-- FIXME... why does this ignore Nat and Int literals?
countOccurrences' :: forall t tp s . OccurrenceTable s -> Expr t tp -> ST s ()
countOccurrences' :: forall t (tp :: BaseType) s.
OccurrenceTable s -> Expr t tp -> ST s ()
countOccurrences' OccurrenceTable s
visited (SemiRingLiteral SemiRingRepr sr
SR.SemiRingRealRepr Coefficient sr
r ProgramLoc
_) = do
  forall s. OccurrenceTable s -> PPIndex -> ST s () -> ST s ()
incOccurrence OccurrenceTable s
visited (Rational -> PPIndex
RatPPIndex Coefficient sr
r) forall a b. (a -> b) -> a -> b
$
    forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
countOccurrences' OccurrenceTable s
visited (AppExpr AppExpr t tp
e) = do
  let idx :: PPIndex
idx = Word64 -> PPIndex
ExprPPIndex (forall k s (tp :: k). Nonce s tp -> Word64
indexValue (forall t (tp :: BaseType). AppExpr t tp -> Nonce t tp
appExprId AppExpr t tp
e))
  forall s. OccurrenceTable s -> PPIndex -> ST s () -> ST s ()
incOccurrence OccurrenceTable s
visited PPIndex
idx forall a b. (a -> b) -> a -> b
$ do
    forall {k} {l} (t :: (k -> Type) -> l -> Type) (m :: Type -> Type)
       (f :: k -> Type) a.
(FoldableFC t, Applicative m) =>
(forall (x :: k). f x -> m a) -> forall (x :: l). t f x -> m ()
traverseFC_ (forall t (tp :: BaseType) s.
OccurrenceTable s -> Expr t tp -> ST s ()
countOccurrences' OccurrenceTable s
visited) (forall t (tp :: BaseType). AppExpr t tp -> App (Expr t) tp
appExprApp AppExpr t tp
e)
countOccurrences' OccurrenceTable s
visited (NonceAppExpr NonceAppExpr t tp
e) = do
  let idx :: PPIndex
idx = Word64 -> PPIndex
ExprPPIndex (forall k s (tp :: k). Nonce s tp -> Word64
indexValue (forall t (tp :: BaseType). NonceAppExpr t tp -> Nonce t tp
nonceExprId NonceAppExpr t tp
e))
  forall s. OccurrenceTable s -> PPIndex -> ST s () -> ST s ()
incOccurrence OccurrenceTable s
visited PPIndex
idx forall a b. (a -> b) -> a -> b
$ do
    forall {k} {l} (t :: (k -> Type) -> l -> Type) (m :: Type -> Type)
       (f :: k -> Type) a.
(FoldableFC t, Applicative m) =>
(forall (x :: k). f x -> m a) -> forall (x :: l). t f x -> m ()
traverseFC_ (forall t (tp :: BaseType) s.
OccurrenceTable s -> Expr t tp -> ST s ()
countOccurrences' OccurrenceTable s
visited) (forall t (tp :: BaseType).
NonceAppExpr t tp -> NonceApp t (Expr t) tp
nonceExprApp NonceAppExpr t tp
e)
countOccurrences' OccurrenceTable s
_ Expr t tp
_ = forall (m :: Type -> Type) a. Monad m => a -> m a
return ()

------------------------------------------------------------------------
-- boundVars

type BoundVarMap s t = H.HashTable s PPIndex (Set (Some (ExprBoundVar t)))

cache :: (Eq k, Hashable k) => H.HashTable s k r -> k -> ST s r -> ST s r
cache :: forall k s r.
(Eq k, Hashable k) =>
HashTable s k r -> k -> ST s r -> ST s r
cache HashTable s k r
h k
k ST s r
m = do
  Maybe r
mr <- forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> ST s (Maybe v)
H.lookup HashTable s k r
h k
k
  case Maybe r
mr of
    Just r
r -> forall (m :: Type -> Type) a. Monad m => a -> m a
return r
r
    Maybe r
Nothing -> do
      r
r <- ST s r
m
      forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> v -> ST s ()
H.insert HashTable s k r
h k
k r
r
      forall (m :: Type -> Type) a. Monad m => a -> m a
return r
r


boundVars :: Expr t tp -> ST s (BoundVarMap s t)
boundVars :: forall t (tp :: BaseType) s. Expr t tp -> ST s (BoundVarMap s t)
boundVars Expr t tp
e0 = do
  BoundVarMap s t
visited <- forall s k v. ST s (HashTable s k v)
H.new
  Set (Some (ExprBoundVar t))
_ <- forall s t (tp :: BaseType).
BoundVarMap s t -> Expr t tp -> ST s (Set (Some (ExprBoundVar t)))
boundVars' BoundVarMap s t
visited Expr t tp
e0
  forall (m :: Type -> Type) a. Monad m => a -> m a
return BoundVarMap s t
visited

boundVars' :: BoundVarMap s t
           -> Expr t tp
           -> ST s (Set (Some (ExprBoundVar t)))
boundVars' :: forall s t (tp :: BaseType).
BoundVarMap s t -> Expr t tp -> ST s (Set (Some (ExprBoundVar t)))
boundVars' BoundVarMap s t
visited (AppExpr AppExpr t tp
e) = do
  let idx :: Word64
idx = forall k s (tp :: k). Nonce s tp -> Word64
indexValue (forall t (tp :: BaseType). AppExpr t tp -> Nonce t tp
appExprId AppExpr t tp
e)
  forall k s r.
(Eq k, Hashable k) =>
HashTable s k r -> k -> ST s r -> ST s r
cache BoundVarMap s t
visited (Word64 -> PPIndex
ExprPPIndex Word64
idx) forall a b. (a -> b) -> a -> b
$ do
    [Set (Some (ExprBoundVar t))]
sums <- forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type) a.
FoldableFC t =>
(forall (x :: k). f x -> a) -> forall (x :: l). t f x -> [a]
toListFC (forall s t (tp :: BaseType).
BoundVarMap s t -> Expr t tp -> ST s (Set (Some (ExprBoundVar t)))
boundVars' BoundVarMap s t
visited) (forall t (tp :: BaseType). AppExpr t tp -> App (Expr t) tp
appExprApp AppExpr t tp
e))
    forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. Ord a => Set a -> Set a -> Set a
Set.union forall a. Set a
Set.empty [Set (Some (ExprBoundVar t))]
sums
boundVars' BoundVarMap s t
visited (NonceAppExpr NonceAppExpr t tp
e) = do
  let idx :: Word64
idx = forall k s (tp :: k). Nonce s tp -> Word64
indexValue (forall t (tp :: BaseType). NonceAppExpr t tp -> Nonce t tp
nonceExprId NonceAppExpr t tp
e)
  forall k s r.
(Eq k, Hashable k) =>
HashTable s k r -> k -> ST s r -> ST s r
cache BoundVarMap s t
visited (Word64 -> PPIndex
ExprPPIndex Word64
idx) forall a b. (a -> b) -> a -> b
$ do
    [Set (Some (ExprBoundVar t))]
sums <- forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type) a.
FoldableFC t =>
(forall (x :: k). f x -> a) -> forall (x :: l). t f x -> [a]
toListFC (forall s t (tp :: BaseType).
BoundVarMap s t -> Expr t tp -> ST s (Set (Some (ExprBoundVar t)))
boundVars' BoundVarMap s t
visited) (forall t (tp :: BaseType).
NonceAppExpr t tp -> NonceApp t (Expr t) tp
nonceExprApp NonceAppExpr t tp
e))
    forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. Ord a => Set a -> Set a -> Set a
Set.union forall a. Set a
Set.empty [Set (Some (ExprBoundVar t))]
sums
boundVars' BoundVarMap s t
visited (BoundVarExpr ExprBoundVar t tp
v)
  | VarKind
QuantifierVarKind <- forall t (tp :: BaseType). ExprBoundVar t tp -> VarKind
bvarKind ExprBoundVar t tp
v = do
      let idx :: Word64
idx = forall k s (tp :: k). Nonce s tp -> Word64
indexValue (forall t (tp :: BaseType). ExprBoundVar t tp -> Nonce t tp
bvarId ExprBoundVar t tp
v)
      forall k s r.
(Eq k, Hashable k) =>
HashTable s k r -> k -> ST s r -> ST s r
cache BoundVarMap s t
visited (Word64 -> PPIndex
ExprPPIndex Word64
idx) forall a b. (a -> b) -> a -> b
$
        forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall a. a -> Set a
Set.singleton (forall k (f :: k -> Type) (x :: k). f x -> Some f
Some ExprBoundVar t tp
v))
boundVars' BoundVarMap s t
_ Expr t tp
_ = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a. Set a
Set.empty


------------------------------------------------------------------------
-- Pretty printing

instance Show (Expr t tp) where
  show :: Expr t tp -> [Char]
show = forall a. Show a => a -> [Char]
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (tp :: BaseType) ann. Expr t tp -> Doc ann
ppExpr

instance Pretty (Expr t tp) where
  pretty :: forall ann. Expr t tp -> Doc ann
pretty = forall t (tp :: BaseType) ann. Expr t tp -> Doc ann
ppExpr



-- | @AppPPExpr@ represents a an application, and it may be let bound.
data AppPPExpr ann
   = APE { forall ann. AppPPExpr ann -> PPIndex
apeIndex :: !PPIndex
         , forall ann. AppPPExpr ann -> ProgramLoc
apeLoc :: !ProgramLoc
         , forall ann. AppPPExpr ann -> Text
apeName :: !Text
         , forall ann. AppPPExpr ann -> [PPExpr ann]
apeExprs :: ![PPExpr ann]
         , forall ann. AppPPExpr ann -> Int
apeLength :: !Int
           -- ^ Length of AppPPExpr not including parenthesis.
         }

data PPExpr ann
   = FixedPPExpr !(Doc ann) ![Doc ann] !Int
     -- ^ A fixed doc with length.
   | AppPPExpr !(AppPPExpr ann)
     -- ^ A doc that can be let bound.

-- | Pretty print a AppPPExpr
apeDoc :: AppPPExpr ann -> (Doc ann, [Doc ann])
apeDoc :: forall ann. AppPPExpr ann -> (Doc ann, [Doc ann])
apeDoc AppPPExpr ann
a = (forall a ann. Pretty a => a -> Doc ann
pretty (forall ann. AppPPExpr ann -> Text
apeName AppPPExpr ann
a), forall ann. Bool -> PPExpr ann -> Doc ann
ppExprDoc Bool
True forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall ann. AppPPExpr ann -> [PPExpr ann]
apeExprs AppPPExpr ann
a)

textPPExpr :: Text -> PPExpr ann
textPPExpr :: forall ann. Text -> PPExpr ann
textPPExpr Text
t = forall ann. Doc ann -> [Doc ann] -> Int -> PPExpr ann
FixedPPExpr (forall a ann. Pretty a => a -> Doc ann
pretty Text
t) [] (Text -> Int
Text.length Text
t)

stringPPExpr :: String -> PPExpr ann
stringPPExpr :: forall ann. [Char] -> PPExpr ann
stringPPExpr [Char]
t = forall ann. Doc ann -> [Doc ann] -> Int -> PPExpr ann
FixedPPExpr (forall a ann. Pretty a => a -> Doc ann
pretty [Char]
t) [] (forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [Char]
t)

-- | Get length of Expr including parens.
ppExprLength :: PPExpr ann -> Int
ppExprLength :: forall ann. PPExpr ann -> Int
ppExprLength (FixedPPExpr Doc ann
_ [] Int
n) = Int
n
ppExprLength (FixedPPExpr Doc ann
_ [Doc ann]
_ Int
n) = Int
n forall a. Num a => a -> a -> a
+ Int
2
ppExprLength (AppPPExpr AppPPExpr ann
a) = forall ann. AppPPExpr ann -> Int
apeLength AppPPExpr ann
a forall a. Num a => a -> a -> a
+ Int
2

parenIf :: Bool -> Doc ann -> [Doc ann] -> Doc ann
parenIf :: forall ann. Bool -> Doc ann -> [Doc ann] -> Doc ann
parenIf Bool
_ Doc ann
h [] = Doc ann
h
parenIf Bool
False Doc ann
h [Doc ann]
l = forall ann. [Doc ann] -> Doc ann
hsep (Doc ann
hforall a. a -> [a] -> [a]
:[Doc ann]
l)
parenIf Bool
True Doc ann
h [Doc ann]
l = forall ann. Doc ann -> Doc ann
parens (forall ann. [Doc ann] -> Doc ann
hsep (Doc ann
hforall a. a -> [a] -> [a]
:[Doc ann]
l))

-- | Pretty print PPExpr
ppExprDoc :: Bool -> PPExpr ann -> Doc ann
ppExprDoc :: forall ann. Bool -> PPExpr ann -> Doc ann
ppExprDoc Bool
b (FixedPPExpr Doc ann
d [Doc ann]
a Int
_) = forall ann. Bool -> Doc ann -> [Doc ann] -> Doc ann
parenIf Bool
b Doc ann
d [Doc ann]
a
ppExprDoc Bool
b (AppPPExpr AppPPExpr ann
a) = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall ann. Bool -> Doc ann -> [Doc ann] -> Doc ann
parenIf Bool
b) (forall ann. AppPPExpr ann -> (Doc ann, [Doc ann])
apeDoc AppPPExpr ann
a)

data PPExprOpts = PPExprOpts { PPExprOpts -> Int
ppExpr_maxWidth :: Int
                           , PPExprOpts -> Bool
ppExpr_useDecimal :: Bool
                           }

defaultPPExprOpts :: PPExprOpts
defaultPPExprOpts :: PPExprOpts
defaultPPExprOpts =
  PPExprOpts { ppExpr_maxWidth :: Int
ppExpr_maxWidth = Int
68
            , ppExpr_useDecimal :: Bool
ppExpr_useDecimal = Bool
True
            }

-- | Pretty print an 'Expr' using let bindings to create the term.
ppExpr :: Expr t tp -> Doc ann
ppExpr :: forall t (tp :: BaseType) ann. Expr t tp -> Doc ann
ppExpr Expr t tp
e
     | forall (t :: Type -> Type) a. Foldable t => t a -> Bool
Prelude.null [Doc ann]
bindings = forall ann. Bool -> PPExpr ann -> Doc ann
ppExprDoc Bool
False PPExpr ann
r
     | Bool
otherwise =
       forall ann. [Doc ann] -> Doc ann
vsep
       [ Doc ann
"let" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall ann. [Doc ann] -> Doc ann
vcat [Doc ann]
bindings)
       , Doc ann
" in" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall ann. Bool -> PPExpr ann -> Doc ann
ppExprDoc Bool
False PPExpr ann
r) ]
  where ([Doc ann]
bindings,PPExpr ann
r) = forall a. (forall s. ST s a) -> a
runST (forall t (tp :: BaseType) s ann.
Expr t tp -> PPExprOpts -> ST s ([Doc ann], PPExpr ann)
ppExpr' Expr t tp
e PPExprOpts
defaultPPExprOpts)

instance ShowF (Expr t)

-- | Pretty print the top part of an element.
ppExprTop :: Expr t tp -> Doc ann
ppExprTop :: forall t (tp :: BaseType) ann. Expr t tp -> Doc ann
ppExprTop Expr t tp
e = forall ann. Bool -> PPExpr ann -> Doc ann
ppExprDoc Bool
False PPExpr ann
r
  where ([Doc ann]
_,PPExpr ann
r) = forall a. (forall s. ST s a) -> a
runST (forall t (tp :: BaseType) s ann.
Expr t tp -> PPExprOpts -> ST s ([Doc ann], PPExpr ann)
ppExpr' Expr t tp
e PPExprOpts
defaultPPExprOpts)

-- | Contains the elements before, the index, doc, and width and
-- the elements after.
type SplitPPExprList ann = Maybe ([PPExpr ann], AppPPExpr ann, [PPExpr ann])

findExprToRemove :: [PPExpr ann] -> SplitPPExprList ann
findExprToRemove :: forall ann. [PPExpr ann] -> SplitPPExprList ann
findExprToRemove [PPExpr ann]
exprs0 = forall ann.
[PPExpr ann]
-> [PPExpr ann] -> SplitPPExprList ann -> SplitPPExprList ann
go [] [PPExpr ann]
exprs0 forall a. Maybe a
Nothing
  where go :: [PPExpr ann] -> [PPExpr ann] -> SplitPPExprList ann -> SplitPPExprList ann
        go :: forall ann.
[PPExpr ann]
-> [PPExpr ann] -> SplitPPExprList ann -> SplitPPExprList ann
go [PPExpr ann]
_ [] SplitPPExprList ann
mr = SplitPPExprList ann
mr
        go [PPExpr ann]
prev (e :: PPExpr ann
e@FixedPPExpr{} : [PPExpr ann]
exprs) SplitPPExprList ann
mr = do
          forall ann.
[PPExpr ann]
-> [PPExpr ann] -> SplitPPExprList ann -> SplitPPExprList ann
go (PPExpr ann
eforall a. a -> [a] -> [a]
:[PPExpr ann]
prev) [PPExpr ann]
exprs SplitPPExprList ann
mr
        go [PPExpr ann]
prev (AppPPExpr AppPPExpr ann
a:[PPExpr ann]
exprs) mr :: SplitPPExprList ann
mr@(Just ([PPExpr ann]
_,AppPPExpr ann
a',[PPExpr ann]
_))
          | forall ann. AppPPExpr ann -> Int
apeLength AppPPExpr ann
a forall a. Ord a => a -> a -> Bool
< forall ann. AppPPExpr ann -> Int
apeLength AppPPExpr ann
a' = forall ann.
[PPExpr ann]
-> [PPExpr ann] -> SplitPPExprList ann -> SplitPPExprList ann
go (forall ann. AppPPExpr ann -> PPExpr ann
AppPPExpr AppPPExpr ann
aforall a. a -> [a] -> [a]
:[PPExpr ann]
prev) [PPExpr ann]
exprs SplitPPExprList ann
mr
        go [PPExpr ann]
prev (AppPPExpr AppPPExpr ann
a:[PPExpr ann]
exprs) SplitPPExprList ann
_ = do
          forall ann.
[PPExpr ann]
-> [PPExpr ann] -> SplitPPExprList ann -> SplitPPExprList ann
go (forall ann. AppPPExpr ann -> PPExpr ann
AppPPExpr AppPPExpr ann
aforall a. a -> [a] -> [a]
:[PPExpr ann]
prev) [PPExpr ann]
exprs (forall a. a -> Maybe a
Just (forall a. [a] -> [a]
reverse [PPExpr ann]
prev, AppPPExpr ann
a, [PPExpr ann]
exprs))


ppExpr' :: forall t tp s ann. Expr t tp -> PPExprOpts -> ST s ([Doc ann], PPExpr ann)
ppExpr' :: forall t (tp :: BaseType) s ann.
Expr t tp -> PPExprOpts -> ST s ([Doc ann], PPExpr ann)
ppExpr' Expr t tp
e0 PPExprOpts
o = do
  let max_width :: Int
max_width = PPExprOpts -> Int
ppExpr_maxWidth PPExprOpts
o
  let use_decimal :: Bool
use_decimal = PPExprOpts -> Bool
ppExpr_useDecimal PPExprOpts
o
  -- Get map that counts number of elements.
  let m :: Map PPIndex Int
m = forall t (tp :: BaseType). Expr t tp -> Map PPIndex Int
countOccurrences Expr t tp
e0
  -- Return number of times a term is referred to in dag.
  let isShared :: PPIndex -> Bool
      isShared :: PPIndex -> Bool
isShared PPIndex
w = forall a. a -> Maybe a -> a
fromMaybe Int
0 (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PPIndex
w Map PPIndex Int
m) forall a. Ord a => a -> a -> Bool
> Int
1

  -- Get bounds variables.
  BoundVarMap s t
bvars <- forall t (tp :: BaseType) s. Expr t tp -> ST s (BoundVarMap s t)
boundVars Expr t tp
e0

  STRef s (Seq (Doc ann))
bindingsRef <- forall a s. a -> ST s (STRef s a)
newSTRef forall a. Seq a
Seq.empty

  HashTable s PPIndex (PPExpr ann)
visited <- forall s k v. ST s (HashTable s k v)
H.new :: ST s (H.HashTable s PPIndex (PPExpr ann))
  HashTable s Word64 Text
visited_fns <- forall s k v. ST s (HashTable s k v)
H.new :: ST s (H.HashTable s Word64 Text)

  let -- Add a binding to the list of bindings
      addBinding :: AppPPExpr ann -> ST s (PPExpr ann)
      addBinding :: AppPPExpr ann -> ST s (PPExpr ann)
addBinding AppPPExpr ann
a = do
        let idx :: PPIndex
idx = forall ann. AppPPExpr ann -> PPIndex
apeIndex AppPPExpr ann
a
        Int
cnt <- forall a. Seq a -> Int
Seq.length forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. STRef s a -> ST s a
readSTRef STRef s (Seq (Doc ann))
bindingsRef

        Set (Some (ExprBoundVar t))
vars <- forall a. a -> Maybe a -> a
fromMaybe forall a. Set a
Set.empty forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> ST s (Maybe v)
H.lookup BoundVarMap s t
bvars PPIndex
idx
        -- TODO: avoid intermediate String from 'ppBoundVar'
        let args :: [String]
            args :: [[Char]]
args = forall {k} (f :: k -> Type) r.
(forall (tp :: k). f tp -> r) -> Some f -> r
viewSome forall t (tp :: BaseType). ExprBoundVar t tp -> [Char]
ppBoundVar forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Set a -> [a]
Set.toList Set (Some (ExprBoundVar t))
vars

        let nm :: [Char]
nm = case PPIndex
idx of
                   ExprPPIndex Word64
e -> [Char]
"v" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Word64
e
                   RatPPIndex Rational
_ -> [Char]
"r" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
cnt
        let lhs :: Doc ann
lhs = forall ann. Bool -> Doc ann -> [Doc ann] -> Doc ann
parenIf Bool
False (forall a ann. Pretty a => a -> Doc ann
pretty [Char]
nm) (forall a ann. Pretty a => a -> Doc ann
pretty forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Char]]
args)
        let doc :: Doc ann
doc = forall ann. [Doc ann] -> Doc ann
vcat
                  [ Doc ann
"--" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty (ProgramLoc -> Position
plSourceLoc (forall ann. AppPPExpr ann -> ProgramLoc
apeLoc AppPPExpr ann
a))
                  , Doc ann
lhs forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"=" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall ann. Bool -> Doc ann -> [Doc ann] -> Doc ann
parenIf Bool
False) (forall ann. AppPPExpr ann -> (Doc ann, [Doc ann])
apeDoc AppPPExpr ann
a) ]
        forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s (Seq (Doc ann))
bindingsRef (forall a. Seq a -> a -> Seq a
Seq.|> Doc ann
doc)
        let len :: Int
len = forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [Char]
nm forall a. Num a => a -> a -> a
+ forall (t :: Type -> Type) a. (Foldable t, Num a) => t a -> a
sum ((\[Char]
arg_s -> forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [Char]
arg_s forall a. Num a => a -> a -> a
+ Int
1) forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Char]]
args)
        let nm_expr :: PPExpr ann
nm_expr = forall ann. Doc ann -> [Doc ann] -> Int -> PPExpr ann
FixedPPExpr (forall a ann. Pretty a => a -> Doc ann
pretty [Char]
nm) (forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [[Char]]
args) Int
len
        forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> v -> ST s ()
H.insert HashTable s PPIndex (PPExpr ann)
visited PPIndex
idx forall a b. (a -> b) -> a -> b
$! PPExpr ann
nm_expr
        forall (m :: Type -> Type) a. Monad m => a -> m a
return PPExpr ann
nm_expr

  let fixLength :: Int
                -> [PPExpr ann]
                -> ST s ([PPExpr ann], Int)
      fixLength :: Int -> [PPExpr ann] -> ST s ([PPExpr ann], Int)
fixLength Int
cur_width [PPExpr ann]
exprs
        | Int
cur_width forall a. Ord a => a -> a -> Bool
> Int
max_width
        , Just ([PPExpr ann]
prev_e, AppPPExpr ann
a, [PPExpr ann]
next_e) <- forall ann. [PPExpr ann] -> SplitPPExprList ann
findExprToRemove [PPExpr ann]
exprs = do
          PPExpr ann
r <- AppPPExpr ann -> ST s (PPExpr ann)
addBinding AppPPExpr ann
a
          let exprs' :: [PPExpr ann]
exprs' = [PPExpr ann]
prev_e forall a. [a] -> [a] -> [a]
++ [PPExpr ann
r] forall a. [a] -> [a] -> [a]
++ [PPExpr ann]
next_e
          Int -> [PPExpr ann] -> ST s ([PPExpr ann], Int)
fixLength (Int
cur_width forall a. Num a => a -> a -> a
- forall ann. AppPPExpr ann -> Int
apeLength AppPPExpr ann
a forall a. Num a => a -> a -> a
+ forall ann. PPExpr ann -> Int
ppExprLength PPExpr ann
r) [PPExpr ann]
exprs'
      fixLength Int
cur_width [PPExpr ann]
exprs = do
        forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! ([PPExpr ann]
exprs, Int
cur_width)

  -- Pretty print an argument.
  let renderArg :: PrettyArg (Expr t) -> ST s (PPExpr ann)
      renderArg :: PrettyArg (Expr t) -> ST s (PPExpr ann)
renderArg (PrettyArg Expr t tp
e) = forall (u :: BaseType). Expr t u -> ST s (PPExpr ann)
getBindings Expr t tp
e
      renderArg (PrettyText Text
txt) = forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall ann. Text -> PPExpr ann
textPPExpr Text
txt)
      renderArg (PrettyFunc Text
nm [PrettyArg (Expr t)]
args) =
        do [PPExpr ann]
exprs0 <- forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse PrettyArg (Expr t) -> ST s (PPExpr ann)
renderArg [PrettyArg (Expr t)]
args
           let total_width :: Int
total_width = Text -> Int
Text.length Text
nm forall a. Num a => a -> a -> a
+ forall (t :: Type -> Type) a. (Foldable t, Num a) => t a -> a
sum ((\PPExpr ann
e -> Int
1 forall a. Num a => a -> a -> a
+ forall ann. PPExpr ann -> Int
ppExprLength PPExpr ann
e) forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [PPExpr ann]
exprs0)
           ([PPExpr ann]
exprs1, Int
cur_width) <- Int -> [PPExpr ann] -> ST s ([PPExpr ann], Int)
fixLength Int
total_width [PPExpr ann]
exprs0
           let exprs :: [Doc ann]
exprs = forall a b. (a -> b) -> [a] -> [b]
map (forall ann. Bool -> PPExpr ann -> Doc ann
ppExprDoc Bool
True) [PPExpr ann]
exprs1
           forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall ann. Doc ann -> [Doc ann] -> Int -> PPExpr ann
FixedPPExpr (forall a ann. Pretty a => a -> Doc ann
pretty Text
nm) [Doc ann]
exprs Int
cur_width)

      renderApp :: PPIndex
                -> ProgramLoc
                -> Text
                -> [PrettyArg (Expr t)]
                -> ST s (AppPPExpr ann)
      renderApp :: PPIndex
-> ProgramLoc
-> Text
-> [PrettyArg (Expr t)]
-> ST s (AppPPExpr ann)
renderApp PPIndex
idx ProgramLoc
loc Text
nm [PrettyArg (Expr t)]
args = forall a. HasCallStack => Bool -> a -> a
Ex.assert (Bool -> Bool
not (forall (t :: Type -> Type) a. Foldable t => t a -> Bool
Prelude.null [PrettyArg (Expr t)]
args)) forall a b. (a -> b) -> a -> b
$ do
        [PPExpr ann]
exprs0 <- forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse PrettyArg (Expr t) -> ST s (PPExpr ann)
renderArg [PrettyArg (Expr t)]
args
        -- Get width not including parenthesis of outer app.
        let total_width :: Int
total_width = Text -> Int
Text.length Text
nm forall a. Num a => a -> a -> a
+ forall (t :: Type -> Type) a. (Foldable t, Num a) => t a -> a
sum ((\PPExpr ann
e -> Int
1 forall a. Num a => a -> a -> a
+ forall ann. PPExpr ann -> Int
ppExprLength PPExpr ann
e) forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [PPExpr ann]
exprs0)
        ([PPExpr ann]
exprs, Int
cur_width) <- Int -> [PPExpr ann] -> ST s ([PPExpr ann], Int)
fixLength Int
total_width [PPExpr ann]
exprs0
        forall (m :: Type -> Type) a. Monad m => a -> m a
return APE { apeIndex :: PPIndex
apeIndex = PPIndex
idx
                   , apeLoc :: ProgramLoc
apeLoc = ProgramLoc
loc
                   , apeName :: Text
apeName = Text
nm
                   , apeExprs :: [PPExpr ann]
apeExprs = [PPExpr ann]
exprs
                   , apeLength :: Int
apeLength = Int
cur_width
                   }

      cacheResult :: PPIndex
                  -> ProgramLoc
                  -> PrettyApp (Expr t)
                  -> ST s (PPExpr ann)
      cacheResult :: PPIndex -> ProgramLoc -> PrettyApp (Expr t) -> ST s (PPExpr ann)
cacheResult PPIndex
_ ProgramLoc
_ (Text
nm,[]) = do
        forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall ann. Text -> PPExpr ann
textPPExpr Text
nm)
      cacheResult PPIndex
idx ProgramLoc
loc (Text
nm,[PrettyArg (Expr t)]
args) = do
        Maybe (PPExpr ann)
mr <- forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> ST s (Maybe v)
H.lookup HashTable s PPIndex (PPExpr ann)
visited PPIndex
idx
        case Maybe (PPExpr ann)
mr of
          Just PPExpr ann
d -> forall (m :: Type -> Type) a. Monad m => a -> m a
return PPExpr ann
d
          Maybe (PPExpr ann)
Nothing -> do
            AppPPExpr ann
a <- PPIndex
-> ProgramLoc
-> Text
-> [PrettyArg (Expr t)]
-> ST s (AppPPExpr ann)
renderApp PPIndex
idx ProgramLoc
loc Text
nm [PrettyArg (Expr t)]
args
            if PPIndex -> Bool
isShared PPIndex
idx then
              AppPPExpr ann -> ST s (PPExpr ann)
addBinding AppPPExpr ann
a
             else
              forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall ann. AppPPExpr ann -> PPExpr ann
AppPPExpr AppPPExpr ann
a)

      bindFn :: ExprSymFn t idx ret -> ST s (PrettyArg (Expr t))
      bindFn :: forall (idx :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t idx ret -> ST s (PrettyArg (Expr t))
bindFn ExprSymFn t idx ret
f = do
        let idx :: Word64
idx = forall k s (tp :: k). Nonce s tp -> Word64
indexValue (forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Nonce t (args ::> ret)
symFnId ExprSymFn t idx ret
f)
        Maybe Text
mr <- forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> ST s (Maybe v)
H.lookup HashTable s Word64 Text
visited_fns Word64
idx
        case Maybe Text
mr of
          Just Text
d -> forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall (e :: BaseType -> Type). Text -> PrettyArg e
PrettyText Text
d)
          Maybe Text
Nothing -> do
            case forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SymFnInfo t args ret
symFnInfo ExprSymFn t idx ret
f of
              UninterpFnInfo{} -> do
                let def_doc :: Doc ann
def_doc = forall a ann. Show a => a -> Doc ann
viaShow ExprSymFn t idx ret
f forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"=" forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"??"
                forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s (Seq (Doc ann))
bindingsRef (forall a. Seq a -> a -> Seq a
Seq.|> Doc ann
def_doc)
              DefinedFnInfo Assignment (ExprBoundVar t) idx
vars Expr t ret
rhs UnfoldPolicy
_ -> do
                -- TODO: avoid intermediate String from 'ppBoundVar'
                let pp_vars :: [Doc ann]
pp_vars = forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type) a.
FoldableFC t =>
(forall (x :: k). f x -> a) -> forall (x :: l). t f x -> [a]
toListFC (forall a ann. Pretty a => a -> Doc ann
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (tp :: BaseType). ExprBoundVar t tp -> [Char]
ppBoundVar) Assignment (ExprBoundVar t) idx
vars
                let def_doc :: Doc ann
def_doc = forall a ann. Show a => a -> Doc ann
viaShow ExprSymFn t idx ret
f forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. [Doc ann] -> Doc ann
hsep [Doc ann]
pp_vars forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"=" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall t (tp :: BaseType) ann. Expr t tp -> Doc ann
ppExpr Expr t ret
rhs
                forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s (Seq (Doc ann))
bindingsRef (forall a. Seq a -> a -> Seq a
Seq.|> Doc ann
def_doc)
              MatlabSolverFnInfo MatlabSolverFn (Expr t) idx ret
fn_id Assignment (ExprBoundVar t) idx
_ Expr t ret
_ -> do
                let def_doc :: Doc ann
def_doc = forall a ann. Show a => a -> Doc ann
viaShow ExprSymFn t idx ret
f forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"=" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall (f :: BaseType -> Type) (a :: Ctx BaseType) (r :: BaseType)
       ann.
IsExpr f =>
MatlabSolverFn f a r -> Doc ann
ppMatlabSolverFn MatlabSolverFn (Expr t) idx ret
fn_id
                forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s (Seq (Doc ann))
bindingsRef (forall a. Seq a -> a -> Seq a
Seq.|> Doc ann
def_doc)

            let d :: Text
d = [Char] -> Text
Text.pack (forall a. Show a => a -> [Char]
show ExprSymFn t idx ret
f)
            forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> v -> ST s ()
H.insert HashTable s Word64 Text
visited_fns Word64
idx forall a b. (a -> b) -> a -> b
$! Text
d
            forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall (e :: BaseType -> Type). Text -> PrettyArg e
PrettyText Text
d

      -- Collect definitions for all applications that occur multiple times
      -- in term.
      getBindings :: Expr t u -> ST s (PPExpr ann)
      getBindings :: forall (u :: BaseType). Expr t u -> ST s (PPExpr ann)
getBindings (SemiRingLiteral SemiRingRepr sr
sr Coefficient sr
x ProgramLoc
l) =
        case SemiRingRepr sr
sr of
          SemiRingRepr sr
SR.SemiRingIntegerRepr ->
            forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall ann. [Char] -> PPExpr ann
stringPPExpr (forall a. Show a => a -> [Char]
show Coefficient sr
x)
          SemiRingRepr sr
SR.SemiRingRealRepr -> PPIndex -> ProgramLoc -> PrettyApp (Expr t) -> ST s (PPExpr ann)
cacheResult (Rational -> PPIndex
RatPPIndex Coefficient sr
x) ProgramLoc
l PrettyApp (Expr t)
app
             where n :: Integer
n = forall a. Ratio a -> a
numerator Coefficient sr
x
                   d :: Integer
d = forall a. Ratio a -> a
denominator Coefficient sr
x
                   app :: PrettyApp (Expr t)
app | Integer
d forall a. Eq a => a -> a -> Bool
== Integer
1      = forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp (forall a. IsString a => [Char] -> a
fromString (forall a. Show a => a -> [Char]
show Integer
n)) []
                       | Bool
use_decimal = forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp (forall a. IsString a => [Char] -> a
fromString (forall a. Show a => a -> [Char]
show (forall a. Fractional a => Rational -> a
fromRational Coefficient sr
x :: Double))) []
                       | Bool
otherwise   = forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"divReal"  [ forall a (e :: BaseType -> Type). Show a => a -> PrettyArg e
showPrettyArg Integer
n, forall a (e :: BaseType -> Type). Show a => a -> PrettyArg e
showPrettyArg Integer
d ]
          SR.SemiRingBVRepr BVFlavorRepr fv
_ NatRepr w
w ->
            forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall ann. [Char] -> PPExpr ann
stringPPExpr forall a b. (a -> b) -> a -> b
$ forall (w :: Natural). NatRepr w -> BV w -> [Char]
BV.ppHex NatRepr w
w Coefficient sr
x

      getBindings (StringExpr StringLiteral si
x ProgramLoc
_) =
        forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall ann. [Char] -> PPExpr ann
stringPPExpr forall a b. (a -> b) -> a -> b
$ (forall a. Show a => a -> [Char]
show StringLiteral si
x)
      getBindings (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
f ProgramLoc
_) =
        forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall ann. [Char] -> PPExpr ann
stringPPExpr (forall a. Show a => a -> [Char]
show BigFloat
f)
      getBindings (BoolExpr Bool
b ProgramLoc
_) =
        forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall ann. [Char] -> PPExpr ann
stringPPExpr (if Bool
b then [Char]
"true" else [Char]
"false")
      getBindings (NonceAppExpr NonceAppExpr t u
e) =
        PPIndex -> ProgramLoc -> PrettyApp (Expr t) -> ST s (PPExpr ann)
cacheResult (Word64 -> PPIndex
ExprPPIndex (forall k s (tp :: k). Nonce s tp -> Word64
indexValue (forall t (tp :: BaseType). NonceAppExpr t tp -> Nonce t tp
nonceExprId NonceAppExpr t u
e))) (forall t (tp :: BaseType). NonceAppExpr t tp -> ProgramLoc
nonceExprLoc NonceAppExpr t u
e)
          forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: Type -> Type) t (e :: BaseType -> Type)
       (tp :: BaseType).
Applicative m =>
(forall (ctx :: Ctx BaseType) (r :: BaseType).
 ExprSymFn t ctx r -> m (PrettyArg e))
-> NonceApp t e tp -> m (PrettyApp e)
ppNonceApp forall (idx :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t idx ret -> ST s (PrettyArg (Expr t))
bindFn (forall t (tp :: BaseType).
NonceAppExpr t tp -> NonceApp t (Expr t) tp
nonceExprApp NonceAppExpr t u
e)
      getBindings (AppExpr AppExpr t u
e) =
        PPIndex -> ProgramLoc -> PrettyApp (Expr t) -> ST s (PPExpr ann)
cacheResult (Word64 -> PPIndex
ExprPPIndex (forall k s (tp :: k). Nonce s tp -> Word64
indexValue (forall t (tp :: BaseType). AppExpr t tp -> Nonce t tp
appExprId AppExpr t u
e)))
                    (forall t (tp :: BaseType). AppExpr t tp -> ProgramLoc
appExprLoc AppExpr t u
e)
                    (forall (e :: BaseType -> Type) (u :: BaseType).
App e u -> PrettyApp e
ppApp' (forall t (tp :: BaseType). AppExpr t tp -> App (Expr t) tp
appExprApp AppExpr t u
e))
      getBindings (BoundVarExpr ExprBoundVar t u
i) =
        forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall ann. [Char] -> PPExpr ann
stringPPExpr forall a b. (a -> b) -> a -> b
$ forall t (tp :: BaseType). ExprBoundVar t tp -> [Char]
ppBoundVar ExprBoundVar t u
i

  PPExpr ann
r <- forall (u :: BaseType). Expr t u -> ST s (PPExpr ann)
getBindings Expr t tp
e0
  [Doc ann]
bindings <- forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. STRef s a -> ST s a
readSTRef STRef s (Seq (Doc ann))
bindingsRef
  forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList [Doc ann]
bindings, PPExpr ann
r)



------------------------------------------------------------------------
-- ExprBoundVar

instance Eq (ExprBoundVar t tp) where
  ExprBoundVar t tp
x == :: ExprBoundVar t tp -> ExprBoundVar t tp -> Bool
== ExprBoundVar t tp
y = forall t (tp :: BaseType). ExprBoundVar t tp -> Nonce t tp
bvarId ExprBoundVar t tp
x forall a. Eq a => a -> a -> Bool
== forall t (tp :: BaseType). ExprBoundVar t tp -> Nonce t tp
bvarId ExprBoundVar t tp
y

instance TestEquality (ExprBoundVar t) where
  testEquality :: forall (a :: BaseType) (b :: BaseType).
ExprBoundVar t a -> ExprBoundVar t b -> Maybe (a :~: b)
testEquality ExprBoundVar t a
x ExprBoundVar t b
y = forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall t (tp :: BaseType). ExprBoundVar t tp -> Nonce t tp
bvarId ExprBoundVar t a
x) (forall t (tp :: BaseType). ExprBoundVar t tp -> Nonce t tp
bvarId ExprBoundVar t b
y)

instance Ord (ExprBoundVar t tp) where
  compare :: ExprBoundVar t tp -> ExprBoundVar t tp -> Ordering
compare ExprBoundVar t tp
x ExprBoundVar t tp
y = forall a. Ord a => a -> a -> Ordering
compare (forall t (tp :: BaseType). ExprBoundVar t tp -> Nonce t tp
bvarId ExprBoundVar t tp
x) (forall t (tp :: BaseType). ExprBoundVar t tp -> Nonce t tp
bvarId ExprBoundVar t tp
y)

instance OrdF (ExprBoundVar t) where
  compareF :: forall (x :: BaseType) (y :: BaseType).
ExprBoundVar t x -> ExprBoundVar t y -> OrderingF x y
compareF ExprBoundVar t x
x ExprBoundVar t y
y = forall k (ktp :: k -> Type) (x :: k) (y :: k).
OrdF ktp =>
ktp x -> ktp y -> OrderingF x y
compareF (forall t (tp :: BaseType). ExprBoundVar t tp -> Nonce t tp
bvarId ExprBoundVar t x
x) (forall t (tp :: BaseType). ExprBoundVar t tp -> Nonce t tp
bvarId ExprBoundVar t y
y)

instance Hashable (ExprBoundVar t tp) where
  hashWithSalt :: Int -> ExprBoundVar t tp -> Int
hashWithSalt Int
s ExprBoundVar t tp
x = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (forall t (tp :: BaseType). ExprBoundVar t tp -> Nonce t tp
bvarId ExprBoundVar t tp
x)

instance HashableF (ExprBoundVar t) where
  hashWithSaltF :: forall (tp :: BaseType). Int -> ExprBoundVar t tp -> Int
hashWithSaltF = forall a. Hashable a => Int -> a -> Int
hashWithSalt

------------------------------------------------------------------------
-- ExprSymFn

instance Show (ExprSymFn t args ret) where
  show :: ExprSymFn t args ret -> [Char]
show ExprSymFn t args ret
f | forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SolverSymbol
symFnName ExprSymFn t args ret
f forall a. Eq a => a -> a -> Bool
== SolverSymbol
emptySymbol = [Char]
"f" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall k s (tp :: k). Nonce s tp -> Word64
indexValue (forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Nonce t (args ::> ret)
symFnId ExprSymFn t args ret
f))
         | Bool
otherwise                  = forall a. Show a => a -> [Char]
show (forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SolverSymbol
symFnName ExprSymFn t args ret
f)

symFnArgTypes :: ExprSymFn t args ret -> Ctx.Assignment BaseTypeRepr args
symFnArgTypes :: forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Assignment BaseTypeRepr args
symFnArgTypes ExprSymFn t args ret
f =
  case forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SymFnInfo t args ret
symFnInfo ExprSymFn t args ret
f of
    UninterpFnInfo Assignment BaseTypeRepr args
tps BaseTypeRepr ret
_ -> Assignment BaseTypeRepr args
tps
    DefinedFnInfo Assignment (ExprBoundVar t) args
vars Expr t ret
_ UnfoldPolicy
_ -> forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
       (g :: k -> Type).
FunctorFC t =>
(forall (x :: k). f x -> g x) -> forall (x :: l). t f x -> t g x
fmapFC forall t (tp :: BaseType). ExprBoundVar t tp -> BaseTypeRepr tp
bvarType Assignment (ExprBoundVar t) args
vars
    MatlabSolverFnInfo MatlabSolverFn (Expr t) args ret
fn_id Assignment (ExprBoundVar t) args
_ Expr t ret
_ -> forall (f :: BaseType -> Type) (args :: Ctx BaseType)
       (ret :: BaseType).
MatlabSolverFn f args ret -> Assignment BaseTypeRepr args
matlabSolverArgTypes MatlabSolverFn (Expr t) args ret
fn_id

symFnReturnType :: ExprSymFn t args ret -> BaseTypeRepr ret
symFnReturnType :: forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> BaseTypeRepr ret
symFnReturnType ExprSymFn t args ret
f =
  case forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SymFnInfo t args ret
symFnInfo ExprSymFn t args ret
f of
    UninterpFnInfo Assignment BaseTypeRepr args
_ BaseTypeRepr ret
tp -> BaseTypeRepr ret
tp
    DefinedFnInfo Assignment (ExprBoundVar t) args
_ Expr t ret
r UnfoldPolicy
_ -> forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType Expr t ret
r
    MatlabSolverFnInfo MatlabSolverFn (Expr t) args ret
fn_id Assignment (ExprBoundVar t) args
_ Expr t ret
_ -> forall (f :: BaseType -> Type) (args :: Ctx BaseType)
       (ret :: BaseType).
MatlabSolverFn f args ret -> BaseTypeRepr ret
matlabSolverReturnType MatlabSolverFn (Expr t) args ret
fn_id

-- | Return solver function associated with ExprSymFn if any.
asMatlabSolverFn :: ExprSymFn t args ret -> Maybe (MatlabSolverFn (Expr t) args ret)
asMatlabSolverFn :: forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Maybe (MatlabSolverFn (Expr t) args ret)
asMatlabSolverFn ExprSymFn t args ret
f
  | MatlabSolverFnInfo MatlabSolverFn (Expr t) args ret
g Assignment (ExprBoundVar t) args
_ Expr t ret
_ <- forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SymFnInfo t args ret
symFnInfo ExprSymFn t args ret
f = forall a. a -> Maybe a
Just MatlabSolverFn (Expr t) args ret
g
  | Bool
otherwise = forall a. Maybe a
Nothing


instance Eq (ExprSymFn t args tp) where
  ExprSymFn t args tp
x == :: ExprSymFn t args tp -> ExprSymFn t args tp -> Bool
== ExprSymFn t args tp
y = forall a. Maybe a -> Bool
isJust (forall t (a1 :: Ctx BaseType) (r1 :: BaseType) (a2 :: Ctx BaseType)
       (r2 :: BaseType).
ExprSymFn t a1 r1
-> ExprSymFn t a2 r2 -> Maybe ((a1 ::> r1) :~: (a2 ::> r2))
testExprSymFnEq ExprSymFn t args tp
x ExprSymFn t args tp
y)

instance Hashable (ExprSymFn t args tp) where
  hashWithSalt :: Int -> ExprSymFn t args tp -> Int
hashWithSalt Int
s ExprSymFn t args tp
f = Int
s forall a. Hashable a => Int -> a -> Int
`hashWithSalt` forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Nonce t (args ::> ret)
symFnId ExprSymFn t args tp
f

testExprSymFnEq ::
  ExprSymFn t a1 r1 -> ExprSymFn t a2 r2 -> Maybe ((a1::>r1) :~: (a2::>r2))
testExprSymFnEq :: forall t (a1 :: Ctx BaseType) (r1 :: BaseType) (a2 :: Ctx BaseType)
       (r2 :: BaseType).
ExprSymFn t a1 r1
-> ExprSymFn t a2 r2 -> Maybe ((a1 ::> r1) :~: (a2 ::> r2))
testExprSymFnEq ExprSymFn t a1 r1
f ExprSymFn t a2 r2
g = forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Nonce t (args ::> ret)
symFnId ExprSymFn t a1 r1
f) (forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Nonce t (args ::> ret)
symFnId ExprSymFn t a2 r2
g)


instance IsSymFn (ExprSymFn t) where
  fnArgTypes :: forall (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Assignment BaseTypeRepr args
fnArgTypes = forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Assignment BaseTypeRepr args
symFnArgTypes
  fnReturnType :: forall (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> BaseTypeRepr ret
fnReturnType = forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> BaseTypeRepr ret
symFnReturnType
  fnTestEquality :: forall (args1 :: Ctx BaseType) (ret1 :: BaseType)
       (args2 :: Ctx BaseType) (ret2 :: BaseType).
ExprSymFn t args1 ret1
-> ExprSymFn t args2 ret2
-> Maybe ((args1 ::> ret1) :~: (args2 ::> ret2))
fnTestEquality = forall t (a1 :: Ctx BaseType) (r1 :: BaseType) (a2 :: Ctx BaseType)
       (r2 :: BaseType).
ExprSymFn t a1 r1
-> ExprSymFn t a2 r2 -> Maybe ((a1 ::> r1) :~: (a2 ::> r2))
testExprSymFnEq
  fnCompare :: forall (args1 :: Ctx BaseType) (ret1 :: BaseType)
       (args2 :: Ctx BaseType) (ret2 :: BaseType).
ExprSymFn t args1 ret1
-> ExprSymFn t args2 ret2
-> OrderingF (args1 ::> ret1) (args2 ::> ret2)
fnCompare ExprSymFn t args1 ret1
f ExprSymFn t args2 ret2
g = forall k (ktp :: k -> Type) (x :: k) (y :: k).
OrdF ktp =>
ktp x -> ktp y -> OrderingF x y
compareF (forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Nonce t (args ::> ret)
symFnId ExprSymFn t args1 ret1
f) (forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Nonce t (args ::> ret)
symFnId ExprSymFn t args2 ret2
g)


-------------------------------------------------------------------------------
-- BVOrSet

instance Semigroup (BVOrNote w) where
  BVOrNote IncrHash
xh BVDomain w
xa <> :: BVOrNote w -> BVOrNote w -> BVOrNote w
<> BVOrNote IncrHash
yh BVDomain w
ya = forall (w :: Natural). IncrHash -> BVDomain w -> BVOrNote w
BVOrNote (IncrHash
xh forall a. Semigroup a => a -> a -> a
<> IncrHash
yh) (forall (w :: Natural). BVDomain w -> BVDomain w -> BVDomain w
BVD.or BVDomain w
xa BVDomain w
ya)

traverseBVOrSet :: (HashableF f, HasAbsValue f, OrdF f, Applicative m) =>
  (forall tp. e tp -> m (f tp)) ->
  (BVOrSet e w -> m (BVOrSet f w))
traverseBVOrSet :: forall (f :: BaseType -> Type) (m :: Type -> Type)
       (e :: BaseType -> Type) (w :: Natural).
(HashableF f, HasAbsValue f, OrdF f, Applicative m) =>
(forall (tp :: BaseType). e tp -> m (f tp))
-> BVOrSet e w -> m (BVOrSet f w)
traverseBVOrSet forall (tp :: BaseType). e tp -> m (f tp)
f (BVOrSet AnnotatedMap (Wrap e (BaseBVType w)) (BVOrNote w) ()
m) =
  forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall (e :: BaseType -> Type) (w :: Natural).
(OrdF e, HashableF e, HasAbsValue e) =>
e (BaseBVType w) -> BVOrSet e w -> BVOrSet e w
bvOrInsert (forall (e :: BaseType -> Type) (w :: Natural).
AnnotatedMap (Wrap e (BaseBVType w)) (BVOrNote w) () -> BVOrSet e w
BVOrSet forall k v a. (Ord k, Semigroup v) => AnnotatedMap k v a
AM.empty) forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (tp :: BaseType). e tp -> m (f tp)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (f :: k -> Type) (x :: k). Wrap f x -> f x
unWrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (forall k v a. AnnotatedMap k v a -> [(k, a)]
AM.toList AnnotatedMap (Wrap e (BaseBVType w)) (BVOrNote w) ()
m)

bvOrInsert :: (OrdF e, HashableF e, HasAbsValue e) => e (BaseBVType w) -> BVOrSet e w -> BVOrSet e w
bvOrInsert :: forall (e :: BaseType -> Type) (w :: Natural).
(OrdF e, HashableF e, HasAbsValue e) =>
e (BaseBVType w) -> BVOrSet e w -> BVOrSet e w
bvOrInsert e (BaseBVType w)
e (BVOrSet AnnotatedMap (Wrap e (BaseBVType w)) (BVOrNote w) ()
m) = forall (e :: BaseType -> Type) (w :: Natural).
AnnotatedMap (Wrap e (BaseBVType w)) (BVOrNote w) () -> BVOrSet e w
BVOrSet forall a b. (a -> b) -> a -> b
$ forall k v a.
(Ord k, Semigroup v) =>
k -> v -> a -> AnnotatedMap k v a -> AnnotatedMap k v a
AM.insert (forall k (f :: k -> Type) (x :: k). f x -> Wrap f x
Wrap e (BaseBVType w)
e) (forall (w :: Natural). IncrHash -> BVDomain w -> BVOrNote w
BVOrNote (Int -> IncrHash
mkIncrHash (forall k (f :: k -> Type) (tp :: k). HashableF f => f tp -> Int
hashF e (BaseBVType w)
e)) (forall (f :: BaseType -> Type) (tp :: BaseType).
HasAbsValue f =>
f tp -> AbstractValue tp
getAbsValue e (BaseBVType w)
e)) () AnnotatedMap (Wrap e (BaseBVType w)) (BVOrNote w) ()
m

bvOrSingleton :: (OrdF e, HashableF e, HasAbsValue e) => e (BaseBVType w) -> BVOrSet e w
bvOrSingleton :: forall (e :: BaseType -> Type) (w :: Natural).
(OrdF e, HashableF e, HasAbsValue e) =>
e (BaseBVType w) -> BVOrSet e w
bvOrSingleton e (BaseBVType w)
e = forall (e :: BaseType -> Type) (w :: Natural).
(OrdF e, HashableF e, HasAbsValue e) =>
e (BaseBVType w) -> BVOrSet e w -> BVOrSet e w
bvOrInsert e (BaseBVType w)
e (forall (e :: BaseType -> Type) (w :: Natural).
AnnotatedMap (Wrap e (BaseBVType w)) (BVOrNote w) () -> BVOrSet e w
BVOrSet forall k v a. (Ord k, Semigroup v) => AnnotatedMap k v a
AM.empty)

bvOrContains :: OrdF e => e (BaseBVType w) -> BVOrSet e w -> Bool
bvOrContains :: forall (e :: BaseType -> Type) (w :: Natural).
OrdF e =>
e (BaseBVType w) -> BVOrSet e w -> Bool
bvOrContains e (BaseBVType w)
x (BVOrSet AnnotatedMap (Wrap e (BaseBVType w)) (BVOrNote w) ()
m) = forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ forall k v a.
(Ord k, Semigroup v) =>
k -> AnnotatedMap k v a -> Maybe (v, a)
AM.lookup (forall k (f :: k -> Type) (x :: k). f x -> Wrap f x
Wrap e (BaseBVType w)
x) AnnotatedMap (Wrap e (BaseBVType w)) (BVOrNote w) ()
m

bvOrUnion :: OrdF e => BVOrSet e w -> BVOrSet e w -> BVOrSet e w
bvOrUnion :: forall (e :: BaseType -> Type) (w :: Natural).
OrdF e =>
BVOrSet e w -> BVOrSet e w -> BVOrSet e w
bvOrUnion (BVOrSet AnnotatedMap (Wrap e (BaseBVType w)) (BVOrNote w) ()
x) (BVOrSet AnnotatedMap (Wrap e (BaseBVType w)) (BVOrNote w) ()
y) = forall (e :: BaseType -> Type) (w :: Natural).
AnnotatedMap (Wrap e (BaseBVType w)) (BVOrNote w) () -> BVOrSet e w
BVOrSet (forall k v a.
(Ord k, Semigroup v) =>
AnnotatedMap k v a -> AnnotatedMap k v a -> AnnotatedMap k v a
AM.union AnnotatedMap (Wrap e (BaseBVType w)) (BVOrNote w) ()
x AnnotatedMap (Wrap e (BaseBVType w)) (BVOrNote w) ()
y)

bvOrToList :: BVOrSet e w -> [e (BaseBVType w)]
bvOrToList :: forall (e :: BaseType -> Type) (w :: Natural).
BVOrSet e w -> [e (BaseBVType w)]
bvOrToList (BVOrSet AnnotatedMap (Wrap e (BaseBVType w)) (BVOrNote w) ()
m) = forall k (f :: k -> Type) (x :: k). Wrap f x -> f x
unWrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k v a. AnnotatedMap k v a -> [(k, a)]
AM.toList AnnotatedMap (Wrap e (BaseBVType w)) (BVOrNote w) ()
m

bvOrAbs :: (OrdF e, 1 <= w) => NatRepr w -> BVOrSet e w -> BVD.BVDomain w
bvOrAbs :: forall (e :: BaseType -> Type) (w :: Natural).
(OrdF e, 1 <= w) =>
NatRepr w -> BVOrSet e w -> BVDomain w
bvOrAbs NatRepr w
w (BVOrSet AnnotatedMap (Wrap e (BaseBVType w)) (BVOrNote w) ()
m) =
  case forall k v a. (Ord k, Semigroup v) => AnnotatedMap k v a -> Maybe v
AM.annotation AnnotatedMap (Wrap e (BaseBVType w)) (BVOrNote w) ()
m of
    Just (BVOrNote IncrHash
_ BVDomain w
a) -> BVDomain w
a
    Maybe (BVOrNote w)
Nothing -> forall (w :: Natural).
(HasCallStack, 1 <= w) =>
NatRepr w -> Integer -> BVDomain w
BVD.singleton NatRepr w
w Integer
0

instance (OrdF e, TestEquality e) => Eq (BVOrSet e w) where
  BVOrSet AnnotatedMap (Wrap e (BaseBVType w)) (BVOrNote w) ()
x == :: BVOrSet e w -> BVOrSet e w -> Bool
== BVOrSet AnnotatedMap (Wrap e (BaseBVType w)) (BVOrNote w) ()
y = forall k a v.
Eq k =>
(a -> a -> Bool)
-> AnnotatedMap k v a -> AnnotatedMap k v a -> Bool
AM.eqBy (\()
_ ()
_ -> Bool
True) AnnotatedMap (Wrap e (BaseBVType w)) (BVOrNote w) ()
x AnnotatedMap (Wrap e (BaseBVType w)) (BVOrNote w) ()
y

instance OrdF e => Hashable (BVOrSet e w) where
  hashWithSalt :: Int -> BVOrSet e w -> Int
hashWithSalt Int
s (BVOrSet AnnotatedMap (Wrap e (BaseBVType w)) (BVOrNote w) ()
m) =
    case forall k v a. (Ord k, Semigroup v) => AnnotatedMap k v a -> Maybe v
AM.annotation AnnotatedMap (Wrap e (BaseBVType w)) (BVOrNote w) ()
m of
      Just (BVOrNote IncrHash
h BVDomain w
_) -> forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s IncrHash
h
      Maybe (BVOrNote w)
Nothing -> Int
s

------------------------------------------------------------------------
-- Types

nonceAppType :: IsExpr e => NonceApp t e tp -> BaseTypeRepr tp
nonceAppType :: forall (e :: BaseType -> Type) t (tp :: BaseType).
IsExpr e =>
NonceApp t e tp -> BaseTypeRepr tp
nonceAppType NonceApp t e tp
a =
  case NonceApp t e tp
a of
    Annotation BaseTypeRepr tp
tpr Nonce t tp
_ e tp
_ -> BaseTypeRepr tp
tpr
    Forall{} -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
    Exists{} -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
    ArrayFromFn   ExprSymFn t (idx ::> itp) ret
fn       -> forall (idx :: Ctx BaseType) (tp :: BaseType) (xs :: BaseType).
Assignment BaseTypeRepr (idx ::> tp)
-> BaseTypeRepr xs -> BaseTypeRepr ('BaseArrayType (idx ::> tp) xs)
BaseArrayRepr (forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Assignment BaseTypeRepr args
symFnArgTypes ExprSymFn t (idx ::> itp) ret
fn) (forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> BaseTypeRepr ret
symFnReturnType ExprSymFn t (idx ::> itp) ret
fn)
    MapOverArrays ExprSymFn t (ctx ::> d) r
fn Assignment BaseTypeRepr (idx ::> itp)
idx Assignment (ArrayResultWrapper e (idx ::> itp)) (ctx ::> d)
_ -> forall (idx :: Ctx BaseType) (tp :: BaseType) (xs :: BaseType).
Assignment BaseTypeRepr (idx ::> tp)
-> BaseTypeRepr xs -> BaseTypeRepr ('BaseArrayType (idx ::> tp) xs)
BaseArrayRepr Assignment BaseTypeRepr (idx ::> itp)
idx (forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> BaseTypeRepr ret
symFnReturnType ExprSymFn t (ctx ::> d) r
fn)
    ArrayTrueOnEntries ExprSymFn t (idx ::> itp) BaseBoolType
_ e (BaseArrayType (idx ::> itp) BaseBoolType)
_ -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
    FnApp ExprSymFn t args tp
f Assignment e args
_ ->  forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> BaseTypeRepr ret
symFnReturnType ExprSymFn t args tp
f

appType :: App e tp -> BaseTypeRepr tp
appType :: forall (e :: BaseType -> Type) (tp :: BaseType).
App e tp -> BaseTypeRepr tp
appType App e tp
a =
  case App e tp
a of
    BaseIte BaseTypeRepr tp
tp Integer
_ e BaseBoolType
_ e tp
_ e tp
_ -> BaseTypeRepr tp
tp
    BaseEq{} -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr

    NotPred{} -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
    ConjPred{} -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr

    RealIsInteger{} -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
    BVTestBit{} -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
    BVSlt{}   -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
    BVUlt{}   -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr

    IntDiv{} -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
    IntMod{} -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
    IntAbs{} -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
    IntDivisible{} -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr

    SemiRingLe{} -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
    SemiRingProd SemiRingProduct e sr
pd -> forall (sr :: SemiRing).
SemiRingRepr sr -> BaseTypeRepr (SemiRingBase sr)
SR.semiRingBase (forall (f :: BaseType -> Type) (sr :: SemiRing).
SemiRingProduct f sr -> SemiRingRepr sr
WSum.prodRepr SemiRingProduct e sr
pd)
    SemiRingSum WeightedSum e sr
s -> forall (sr :: SemiRing).
SemiRingRepr sr -> BaseTypeRepr (SemiRingBase sr)
SR.semiRingBase (forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> SemiRingRepr sr
WSum.sumRepr WeightedSum e sr
s)

    RealDiv{} -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
    RealSqrt{} -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr

    RoundReal{} -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
    RoundEvenReal{} -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
    FloorReal{} -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
    CeilReal{}  -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr

    RealSpecialFunction{} -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr

    BVUnaryTerm UnaryBV (e BaseBoolType) n
u  -> forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr (forall p (n :: Natural). UnaryBV p n -> NatRepr n
UnaryBV.width UnaryBV (e BaseBoolType) n
u)
    BVOrBits NatRepr w
w BVOrSet e w
_ -> forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr NatRepr w
w
    BVConcat NatRepr (u + v)
w e (BaseBVType u)
_ e (BaseBVType v)
_ -> forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr NatRepr (u + v)
w
    BVSelect NatRepr idx
_ NatRepr n
n e (BaseBVType w)
_ -> forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr NatRepr n
n
    BVUdiv NatRepr w
w e ('BaseBVType w)
_ e ('BaseBVType w)
_ -> forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr NatRepr w
w
    BVUrem NatRepr w
w e ('BaseBVType w)
_ e ('BaseBVType w)
_ -> forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr NatRepr w
w
    BVSdiv NatRepr w
w e ('BaseBVType w)
_ e ('BaseBVType w)
_ -> forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr NatRepr w
w
    BVSrem NatRepr w
w e ('BaseBVType w)
_ e ('BaseBVType w)
_ -> forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr NatRepr w
w
    BVShl  NatRepr w
w e ('BaseBVType w)
_ e ('BaseBVType w)
_  -> forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr NatRepr w
w
    BVLshr NatRepr w
w e ('BaseBVType w)
_ e ('BaseBVType w)
_ -> forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr NatRepr w
w
    BVAshr NatRepr w
w e ('BaseBVType w)
_ e ('BaseBVType w)
_ -> forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr NatRepr w
w
    BVRol NatRepr w
w e ('BaseBVType w)
_ e ('BaseBVType w)
_ -> forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr NatRepr w
w
    BVRor NatRepr w
w e ('BaseBVType w)
_ e ('BaseBVType w)
_ -> forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr NatRepr w
w
    BVPopcount NatRepr w
w e ('BaseBVType w)
_ -> forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr NatRepr w
w
    BVCountLeadingZeros NatRepr w
w e ('BaseBVType w)
_ -> forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr NatRepr w
w
    BVCountTrailingZeros NatRepr w
w e ('BaseBVType w)
_ -> forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr NatRepr w
w
    BVZext  NatRepr r
w e (BaseBVType w)
_ -> forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr NatRepr r
w
    BVSext  NatRepr r
w e (BaseBVType w)
_ -> forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr NatRepr r
w
    BVFill NatRepr w
w e BaseBoolType
_ -> forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr NatRepr w
w

    FloatNeg FloatPrecisionRepr fpp
fpp e ('BaseFloatType fpp)
_ -> forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> BaseTypeRepr ('BaseFloatType fpp)
BaseFloatRepr FloatPrecisionRepr fpp
fpp
    FloatAbs FloatPrecisionRepr fpp
fpp e ('BaseFloatType fpp)
_ -> forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> BaseTypeRepr ('BaseFloatType fpp)
BaseFloatRepr FloatPrecisionRepr fpp
fpp
    FloatSqrt FloatPrecisionRepr fpp
fpp RoundingMode
_ e ('BaseFloatType fpp)
_ -> forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> BaseTypeRepr ('BaseFloatType fpp)
BaseFloatRepr FloatPrecisionRepr fpp
fpp
    FloatAdd FloatPrecisionRepr fpp
fpp RoundingMode
_ e ('BaseFloatType fpp)
_ e ('BaseFloatType fpp)
_ -> forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> BaseTypeRepr ('BaseFloatType fpp)
BaseFloatRepr FloatPrecisionRepr fpp
fpp
    FloatSub FloatPrecisionRepr fpp
fpp RoundingMode
_ e ('BaseFloatType fpp)
_ e ('BaseFloatType fpp)
_ -> forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> BaseTypeRepr ('BaseFloatType fpp)
BaseFloatRepr FloatPrecisionRepr fpp
fpp
    FloatMul FloatPrecisionRepr fpp
fpp RoundingMode
_ e ('BaseFloatType fpp)
_ e ('BaseFloatType fpp)
_ -> forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> BaseTypeRepr ('BaseFloatType fpp)
BaseFloatRepr FloatPrecisionRepr fpp
fpp
    FloatDiv FloatPrecisionRepr fpp
fpp RoundingMode
_ e ('BaseFloatType fpp)
_ e ('BaseFloatType fpp)
_ -> forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> BaseTypeRepr ('BaseFloatType fpp)
BaseFloatRepr FloatPrecisionRepr fpp
fpp
    FloatRem FloatPrecisionRepr fpp
fpp e ('BaseFloatType fpp)
_ e ('BaseFloatType fpp)
_ -> forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> BaseTypeRepr ('BaseFloatType fpp)
BaseFloatRepr FloatPrecisionRepr fpp
fpp
    FloatFMA FloatPrecisionRepr fpp
fpp RoundingMode
_ e ('BaseFloatType fpp)
_ e ('BaseFloatType fpp)
_ e ('BaseFloatType fpp)
_ -> forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> BaseTypeRepr ('BaseFloatType fpp)
BaseFloatRepr FloatPrecisionRepr fpp
fpp
    FloatFpEq{} -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
    FloatLe{} -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
    FloatLt{} -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
    FloatIsNaN{} -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
    FloatIsInf{} -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
    FloatIsZero{} -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
    FloatIsPos{} -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
    FloatIsNeg{} -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
    FloatIsSubnorm{} -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
    FloatIsNorm{} -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
    FloatCast FloatPrecisionRepr fpp
fpp RoundingMode
_ e (BaseFloatType fpp')
_ -> forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> BaseTypeRepr ('BaseFloatType fpp)
BaseFloatRepr FloatPrecisionRepr fpp
fpp
    FloatRound FloatPrecisionRepr fpp
fpp RoundingMode
_ e ('BaseFloatType fpp)
_ -> forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> BaseTypeRepr ('BaseFloatType fpp)
BaseFloatRepr FloatPrecisionRepr fpp
fpp
    FloatFromBinary FloatPrecisionRepr (FloatingPointPrecision eb sb)
fpp e (BaseBVType (eb + sb))
_ -> forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> BaseTypeRepr ('BaseFloatType fpp)
BaseFloatRepr FloatPrecisionRepr (FloatingPointPrecision eb sb)
fpp
    FloatToBinary FloatPrecisionRepr (FloatingPointPrecision eb sb)
fpp e (BaseFloatType (FloatingPointPrecision eb sb))
_ -> forall (eb :: Natural) (sb :: Natural).
FloatPrecisionRepr (FloatingPointPrecision eb sb)
-> BaseTypeRepr (BaseBVType (eb + sb))
floatPrecisionToBVType FloatPrecisionRepr (FloatingPointPrecision eb sb)
fpp
    BVToFloat FloatPrecisionRepr fpp
fpp RoundingMode
_ e (BaseBVType w)
_ -> forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> BaseTypeRepr ('BaseFloatType fpp)
BaseFloatRepr FloatPrecisionRepr fpp
fpp
    SBVToFloat FloatPrecisionRepr fpp
fpp RoundingMode
_ e (BaseBVType w)
_ -> forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> BaseTypeRepr ('BaseFloatType fpp)
BaseFloatRepr FloatPrecisionRepr fpp
fpp
    RealToFloat FloatPrecisionRepr fpp
fpp RoundingMode
_ e BaseRealType
_ -> forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> BaseTypeRepr ('BaseFloatType fpp)
BaseFloatRepr FloatPrecisionRepr fpp
fpp
    FloatToBV NatRepr w
w RoundingMode
_ e (BaseFloatType fpp)
_ -> forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr NatRepr w
w
    FloatToSBV NatRepr w
w RoundingMode
_ e (BaseFloatType fpp)
_ -> forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr NatRepr w
w
    FloatToReal{} -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
    FloatSpecialFunction FloatPrecisionRepr fpp
fpp SpecialFunction args
_ SpecialFnArgs e ('BaseFloatType fpp) args
_ -> forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> BaseTypeRepr ('BaseFloatType fpp)
BaseFloatRepr FloatPrecisionRepr fpp
fpp

    ArrayMap      Assignment BaseTypeRepr (i ::> itp)
idx BaseTypeRepr tp
b ArrayUpdateMap e (i ::> itp) tp
_ e ('BaseArrayType (i ::> itp) tp)
_ -> forall (idx :: Ctx BaseType) (tp :: BaseType) (xs :: BaseType).
Assignment BaseTypeRepr (idx ::> tp)
-> BaseTypeRepr xs -> BaseTypeRepr ('BaseArrayType (idx ::> tp) xs)
BaseArrayRepr Assignment BaseTypeRepr (i ::> itp)
idx BaseTypeRepr tp
b
    ConstantArray Assignment BaseTypeRepr (i ::> tp)
idx BaseTypeRepr b
b e b
_   -> forall (idx :: Ctx BaseType) (tp :: BaseType) (xs :: BaseType).
Assignment BaseTypeRepr (idx ::> tp)
-> BaseTypeRepr xs -> BaseTypeRepr ('BaseArrayType (idx ::> tp) xs)
BaseArrayRepr Assignment BaseTypeRepr (i ::> tp)
idx BaseTypeRepr b
b
    SelectArray BaseTypeRepr tp
b e (BaseArrayType (i ::> tp) tp)
_ Assignment e (i ::> tp)
_       -> BaseTypeRepr tp
b
    UpdateArray BaseTypeRepr b
b Assignment BaseTypeRepr (i ::> tp)
itp e ('BaseArrayType (i ::> tp) b)
_ Assignment e (i ::> tp)
_ e b
_     -> forall (idx :: Ctx BaseType) (tp :: BaseType) (xs :: BaseType).
Assignment BaseTypeRepr (idx ::> tp)
-> BaseTypeRepr xs -> BaseTypeRepr ('BaseArrayType (idx ::> tp) xs)
BaseArrayRepr Assignment BaseTypeRepr (i ::> tp)
itp BaseTypeRepr b
b
    CopyArray NatRepr w
w BaseTypeRepr a
a_repr 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)
_ -> forall (idx :: Ctx BaseType) (tp :: BaseType) (xs :: BaseType).
Assignment BaseTypeRepr (idx ::> tp)
-> BaseTypeRepr xs -> BaseTypeRepr ('BaseArrayType (idx ::> tp) xs)
BaseArrayRepr (forall {k} (f :: k -> Type) (tp :: k).
f tp -> Assignment f (EmptyCtx ::> tp)
singleton (forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr NatRepr w
w)) BaseTypeRepr a
a_repr
    SetArray NatRepr w
w BaseTypeRepr a
a_repr e ('BaseArrayType (SingleCtx (BaseBVType w)) a)
_ e (BaseBVType w)
_ e a
_ e (BaseBVType w)
_ e (BaseBVType w)
_ -> forall (idx :: Ctx BaseType) (tp :: BaseType) (xs :: BaseType).
Assignment BaseTypeRepr (idx ::> tp)
-> BaseTypeRepr xs -> BaseTypeRepr ('BaseArrayType (idx ::> tp) xs)
BaseArrayRepr (forall {k} (f :: k -> Type) (tp :: k).
f tp -> Assignment f (EmptyCtx ::> tp)
singleton (forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr NatRepr w
w)) BaseTypeRepr a
a_repr
    EqualArrayRange 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)
_ -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr

    IntegerToReal{} -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
    BVToInteger{} -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
    SBVToInteger{} -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr

    IntegerToBV e BaseIntegerType
_ NatRepr w
w -> forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr NatRepr w
w

    RealToInteger{} -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr

    Cplx{} -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
    RealPart{} -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
    ImagPart{} -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr

    StringContains{} -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
    StringIsPrefixOf{} -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
    StringIsSuffixOf{} -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
    StringIndexOf{} -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
    StringSubstring StringInfoRepr si
si e ('BaseStringType si)
_ e BaseIntegerType
_ e BaseIntegerType
_ -> forall (si :: StringInfo).
StringInfoRepr si -> BaseTypeRepr ('BaseStringType si)
BaseStringRepr StringInfoRepr si
si
    StringAppend StringInfoRepr si
si StringSeq e si
_ -> forall (si :: StringInfo).
StringInfoRepr si -> BaseTypeRepr ('BaseStringType si)
BaseStringRepr StringInfoRepr si
si
    StringLength{} -> forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr

    StructCtor Assignment BaseTypeRepr flds
flds Assignment e flds
_     -> forall (ctx :: Ctx BaseType).
Assignment BaseTypeRepr ctx -> BaseTypeRepr ('BaseStructType ctx)
BaseStructRepr Assignment BaseTypeRepr flds
flds
    StructField e (BaseStructType flds)
_ Index flds tp
_ BaseTypeRepr tp
tp    -> BaseTypeRepr tp
tp


------------------------------------------------------------------------
-- abstractEval

-- | Return an unconstrained abstract value.
unconstrainedAbsValue :: BaseTypeRepr tp -> AbstractValue tp
unconstrainedAbsValue :: forall (tp :: BaseType). BaseTypeRepr tp -> AbstractValue tp
unconstrainedAbsValue BaseTypeRepr tp
tp = forall (bt :: BaseType) a.
BaseTypeRepr bt -> (Abstractable bt => a) -> a
withAbstractable BaseTypeRepr tp
tp (forall (tp :: BaseType). BaseTypeRepr tp -> AbstractValue tp
avTop BaseTypeRepr tp
tp)


-- | Return abstract domain associated with a nonce app
quantAbsEval :: IsExpr e =>
  (forall u . e u -> AbstractValue u) ->
  NonceApp t e tp ->
  AbstractValue tp
quantAbsEval :: forall (e :: BaseType -> Type) t (tp :: BaseType).
IsExpr e =>
(forall (u :: BaseType). e u -> AbstractValue u)
-> NonceApp t e tp -> AbstractValue tp
quantAbsEval forall (u :: BaseType). e u -> AbstractValue u
f NonceApp t e tp
q =
  case NonceApp t e tp
q of
    Annotation BaseTypeRepr tp
_ Nonce t tp
_ e tp
v -> forall (u :: BaseType). e u -> AbstractValue u
f e tp
v
    Forall ExprBoundVar t tp
_ e BaseBoolType
v -> forall (u :: BaseType). e u -> AbstractValue u
f e BaseBoolType
v
    Exists ExprBoundVar t tp
_ e BaseBoolType
v -> forall (u :: BaseType). e u -> AbstractValue u
f e BaseBoolType
v
    ArrayFromFn ExprSymFn t (idx ::> itp) ret
_       -> forall (tp :: BaseType). BaseTypeRepr tp -> AbstractValue tp
unconstrainedAbsValue (forall (e :: BaseType -> Type) t (tp :: BaseType).
IsExpr e =>
NonceApp t e tp -> BaseTypeRepr tp
nonceAppType NonceApp t e tp
q)
    MapOverArrays ExprSymFn t (ctx ::> d) r
g Assignment BaseTypeRepr (idx ::> itp)
_ Assignment (ArrayResultWrapper e (idx ::> itp)) (ctx ::> d)
_ -> forall (tp :: BaseType). BaseTypeRepr tp -> AbstractValue tp
unconstrainedAbsValue BaseTypeRepr r
tp
      where tp :: BaseTypeRepr r
tp = forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> BaseTypeRepr ret
symFnReturnType ExprSymFn t (ctx ::> d) r
g
    ArrayTrueOnEntries ExprSymFn t (idx ::> itp) BaseBoolType
_ e (BaseArrayType (idx ::> itp) BaseBoolType)
a -> forall (u :: BaseType). e u -> AbstractValue u
f e (BaseArrayType (idx ::> itp) BaseBoolType)
a
    FnApp ExprSymFn t args tp
g Assignment e args
_           -> forall (tp :: BaseType). BaseTypeRepr tp -> AbstractValue tp
unconstrainedAbsValue (forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> BaseTypeRepr ret
symFnReturnType ExprSymFn t args tp
g)

abstractEval :: (IsExpr e, HashableF e, OrdF e) =>
  (forall u . e u -> AbstractValue u) ->
  App e tp ->
  AbstractValue tp
abstractEval :: forall (e :: BaseType -> Type) (tp :: BaseType).
(IsExpr e, HashableF e, OrdF e) =>
(forall (u :: BaseType). e u -> AbstractValue u)
-> App e tp -> AbstractValue tp
abstractEval forall (u :: BaseType). e u -> AbstractValue u
f App e tp
a0 = do
  case App e tp
a0 of

    BaseIte BaseTypeRepr tp
tp Integer
_ e BaseBoolType
_c e tp
x e tp
y -> forall (bt :: BaseType) a.
BaseTypeRepr bt -> (Abstractable bt => a) -> a
withAbstractable BaseTypeRepr tp
tp forall a b. (a -> b) -> a -> b
$ forall (tp :: BaseType).
Abstractable tp =>
BaseTypeRepr tp
-> AbstractValue tp -> AbstractValue tp -> AbstractValue tp
avJoin BaseTypeRepr tp
tp (forall (u :: BaseType). e u -> AbstractValue u
f e tp
x) (forall (u :: BaseType). e u -> AbstractValue u
f e tp
y)
    BaseEq{} -> forall a. Maybe a
Nothing

    NotPred{} -> forall a. Maybe a
Nothing
    ConjPred{} -> forall a. Maybe a
Nothing

    SemiRingLe{} -> forall a. Maybe a
Nothing
    RealIsInteger{} -> forall a. Maybe a
Nothing
    BVTestBit{} -> forall a. Maybe a
Nothing
    BVSlt{} -> forall a. Maybe a
Nothing
    BVUlt{} -> forall a. Maybe a
Nothing

    ------------------------------------------------------------------------
    -- Arithmetic operations
    IntAbs e BaseIntegerType
x -> ValueRange Integer -> ValueRange Integer
intAbsRange (forall (u :: BaseType). e u -> AbstractValue u
f e BaseIntegerType
x)
    IntDiv e BaseIntegerType
x e BaseIntegerType
y -> ValueRange Integer -> ValueRange Integer -> ValueRange Integer
intDivRange (forall (u :: BaseType). e u -> AbstractValue u
f e BaseIntegerType
x) (forall (u :: BaseType). e u -> AbstractValue u
f e BaseIntegerType
y)
    IntMod e BaseIntegerType
x e BaseIntegerType
y -> ValueRange Integer -> ValueRange Integer -> ValueRange Integer
intModRange (forall (u :: BaseType). e u -> AbstractValue u
f e BaseIntegerType
x) (forall (u :: BaseType). e u -> AbstractValue u
f e BaseIntegerType
y)

    IntDivisible{} -> forall a. Maybe a
Nothing

    SemiRingSum WeightedSum e sr
s -> forall (f :: BaseType -> Type) (sr :: SemiRing).
OrdF f =>
WeightedSum f sr -> AbstractValue (SemiRingBase sr)
WSum.sumAbsValue WeightedSum e sr
s
    SemiRingProd SemiRingProduct e sr
pd -> forall (f :: BaseType -> Type) (sr :: SemiRing).
OrdF f =>
SemiRingProduct f sr -> AbstractValue (SemiRingBase sr)
WSum.prodAbsValue SemiRingProduct e sr
pd

    BVOrBits NatRepr w
w BVOrSet e w
m -> forall (e :: BaseType -> Type) (w :: Natural).
(OrdF e, 1 <= w) =>
NatRepr w -> BVOrSet e w -> BVDomain w
bvOrAbs NatRepr w
w BVOrSet e w
m

    RealDiv e BaseRealType
_ e BaseRealType
_ -> RealAbstractValue
ravUnbounded
    RealSqrt e BaseRealType
_  -> RealAbstractValue
ravUnbounded

    RealSpecialFunction SpecialFunction args
fn SpecialFnArgs e BaseRealType args
_ ->
      case SpecialFunction args
fn of
        SpecialFunction args
SFn.Pi -> Rational -> Rational -> RealAbstractValue
ravConcreteRange Rational
3.14 Rational
3.15
        -- TODO, other constants...

        SpecialFunction args
SFn.Sin -> Rational -> Rational -> RealAbstractValue
ravConcreteRange (-Rational
1) Rational
1
        SpecialFunction args
SFn.Cos -> Rational -> Rational -> RealAbstractValue
ravConcreteRange (-Rational
1) Rational
1

        -- TODO, is there other interesting range information?
        SpecialFunction args
_ -> RealAbstractValue
ravUnbounded

    BVUnaryTerm UnaryBV (e BaseBoolType) n
u -> forall p (n :: Natural).
(1 <= n) =>
(p -> Maybe Bool) -> UnaryBV p n -> BVDomain n
UnaryBV.domain forall (e :: BaseType -> Type).
IsExpr e =>
e BaseBoolType -> Maybe Bool
asConstantPred UnaryBV (e BaseBoolType) n
u
    BVConcat NatRepr (u + v)
_ e (BaseBVType u)
x e (BaseBVType v)
y -> forall (u :: Natural) (v :: Natural).
NatRepr u
-> BVDomain u -> NatRepr v -> BVDomain v -> BVDomain (u + v)
BVD.concat (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth e (BaseBVType u)
x) (forall (u :: BaseType). e u -> AbstractValue u
f e (BaseBVType u)
x) (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth e (BaseBVType v)
y) (forall (u :: BaseType). e u -> AbstractValue u
f e (BaseBVType v)
y)

    BVSelect NatRepr idx
i NatRepr n
n e (BaseBVType w)
x -> forall (n :: Natural) (i :: Natural) (w :: Natural).
(1 <= n, (i + n) <= w) =>
NatRepr i -> NatRepr n -> BVDomain w -> BVDomain n
BVD.select NatRepr idx
i NatRepr n
n (forall (u :: BaseType). e u -> AbstractValue u
f e (BaseBVType w)
x)
    BVUdiv NatRepr w
_ e ('BaseBVType w)
x e ('BaseBVType w)
y -> forall (w :: Natural).
(1 <= w) =>
BVDomain w -> BVDomain w -> BVDomain w
BVD.udiv (forall (u :: BaseType). e u -> AbstractValue u
f e ('BaseBVType w)
x) (forall (u :: BaseType). e u -> AbstractValue u
f e ('BaseBVType w)
y)
    BVUrem NatRepr w
_ e ('BaseBVType w)
x e ('BaseBVType w)
y -> forall (w :: Natural).
(1 <= w) =>
BVDomain w -> BVDomain w -> BVDomain w
BVD.urem (forall (u :: BaseType). e u -> AbstractValue u
f e ('BaseBVType w)
x) (forall (u :: BaseType). e u -> AbstractValue u
f e ('BaseBVType w)
y)
    BVSdiv NatRepr w
w e ('BaseBVType w)
x e ('BaseBVType w)
y -> forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BVDomain w -> BVDomain w -> BVDomain w
BVD.sdiv NatRepr w
w (forall (u :: BaseType). e u -> AbstractValue u
f e ('BaseBVType w)
x) (forall (u :: BaseType). e u -> AbstractValue u
f e ('BaseBVType w)
y)
    BVSrem NatRepr w
w e ('BaseBVType w)
x e ('BaseBVType w)
y -> forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BVDomain w -> BVDomain w -> BVDomain w
BVD.srem NatRepr w
w (forall (u :: BaseType). e u -> AbstractValue u
f e ('BaseBVType w)
x) (forall (u :: BaseType). e u -> AbstractValue u
f e ('BaseBVType w)
y)

    BVShl  NatRepr w
w e ('BaseBVType w)
x e ('BaseBVType w)
y -> forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BVDomain w -> BVDomain w -> BVDomain w
BVD.shl NatRepr w
w (forall (u :: BaseType). e u -> AbstractValue u
f e ('BaseBVType w)
x) (forall (u :: BaseType). e u -> AbstractValue u
f e ('BaseBVType w)
y)
    BVLshr NatRepr w
w e ('BaseBVType w)
x e ('BaseBVType w)
y -> forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BVDomain w -> BVDomain w -> BVDomain w
BVD.lshr NatRepr w
w (forall (u :: BaseType). e u -> AbstractValue u
f e ('BaseBVType w)
x) (forall (u :: BaseType). e u -> AbstractValue u
f e ('BaseBVType w)
y)
    BVAshr NatRepr w
w e ('BaseBVType w)
x e ('BaseBVType w)
y -> forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BVDomain w -> BVDomain w -> BVDomain w
BVD.ashr NatRepr w
w (forall (u :: BaseType). e u -> AbstractValue u
f e ('BaseBVType w)
x) (forall (u :: BaseType). e u -> AbstractValue u
f e ('BaseBVType w)
y)
    BVRol  NatRepr w
w e ('BaseBVType w)
x e ('BaseBVType w)
y -> forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BVDomain w -> BVDomain w -> BVDomain w
BVD.rol NatRepr w
w  (forall (u :: BaseType). e u -> AbstractValue u
f e ('BaseBVType w)
x) (forall (u :: BaseType). e u -> AbstractValue u
f e ('BaseBVType w)
y)
    BVRor  NatRepr w
w e ('BaseBVType w)
x e ('BaseBVType w)
y -> forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BVDomain w -> BVDomain w -> BVDomain w
BVD.ror NatRepr w
w  (forall (u :: BaseType). e u -> AbstractValue u
f e ('BaseBVType w)
x) (forall (u :: BaseType). e u -> AbstractValue u
f e ('BaseBVType w)
y)
    BVZext NatRepr r
w e (BaseBVType w)
x   -> forall (w :: Natural) (u :: Natural).
(1 <= w, (w + 1) <= u) =>
BVDomain w -> NatRepr u -> BVDomain u
BVD.zext (forall (u :: BaseType). e u -> AbstractValue u
f e (BaseBVType w)
x) NatRepr r
w
    BVSext NatRepr r
w e (BaseBVType w)
x   -> forall (w :: Natural) (u :: Natural).
(1 <= w, (w + 1) <= u) =>
NatRepr w -> BVDomain w -> NatRepr u -> BVDomain u
BVD.sext (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth e (BaseBVType w)
x) (forall (u :: BaseType). e u -> AbstractValue u
f e (BaseBVType w)
x) NatRepr r
w
    BVFill NatRepr w
w e BaseBoolType
_   -> forall (w :: Natural).
NatRepr w -> Integer -> Integer -> BVDomain w
BVD.range NatRepr w
w (-Integer
1) Integer
0

    BVPopcount NatRepr w
w e ('BaseBVType w)
x -> forall (w :: Natural). NatRepr w -> BVDomain w -> BVDomain w
BVD.popcnt NatRepr w
w (forall (u :: BaseType). e u -> AbstractValue u
f e ('BaseBVType w)
x)
    BVCountLeadingZeros NatRepr w
w e ('BaseBVType w)
x -> forall (w :: Natural). NatRepr w -> BVDomain w -> BVDomain w
BVD.clz NatRepr w
w (forall (u :: BaseType). e u -> AbstractValue u
f e ('BaseBVType w)
x)
    BVCountTrailingZeros NatRepr w
w e ('BaseBVType w)
x -> forall (w :: Natural). NatRepr w -> BVDomain w -> BVDomain w
BVD.ctz NatRepr w
w (forall (u :: BaseType). e u -> AbstractValue u
f e ('BaseBVType w)
x)

    FloatNeg{} -> ()
    FloatAbs{} -> ()
    FloatSqrt{} -> ()
    FloatAdd{} -> ()
    FloatSub{} -> ()
    FloatMul{} -> ()
    FloatDiv{} -> ()
    FloatRem{} -> ()
    FloatFMA{} -> ()
    FloatFpEq{} -> forall a. Maybe a
Nothing
    FloatLe{} -> forall a. Maybe a
Nothing
    FloatLt{} -> forall a. Maybe a
Nothing
    FloatIsNaN{} -> forall a. Maybe a
Nothing
    FloatIsInf{} -> forall a. Maybe a
Nothing
    FloatIsZero{} -> forall a. Maybe a
Nothing
    FloatIsPos{} -> forall a. Maybe a
Nothing
    FloatIsNeg{} -> forall a. Maybe a
Nothing
    FloatIsSubnorm{} -> forall a. Maybe a
Nothing
    FloatIsNorm{} -> forall a. Maybe a
Nothing
    FloatCast{} -> ()
    FloatRound{} -> ()
    FloatFromBinary{} -> ()
    FloatToBinary FloatPrecisionRepr (FloatingPointPrecision eb sb)
fpp e (BaseFloatType (FloatingPointPrecision eb sb))
_ -> case forall (eb :: Natural) (sb :: Natural).
FloatPrecisionRepr (FloatingPointPrecision eb sb)
-> BaseTypeRepr (BaseBVType (eb + sb))
floatPrecisionToBVType FloatPrecisionRepr (FloatingPointPrecision eb sb)
fpp of
      BaseBVRepr NatRepr w
w -> forall (w :: Natural). (1 <= w) => NatRepr w -> BVDomain w
BVD.any NatRepr w
w
    BVToFloat{} -> ()
    SBVToFloat{} -> ()
    RealToFloat{} -> ()
    FloatToBV NatRepr w
w RoundingMode
_ e (BaseFloatType fpp)
_ -> forall (w :: Natural). (1 <= w) => NatRepr w -> BVDomain w
BVD.any NatRepr w
w
    FloatToSBV NatRepr w
w RoundingMode
_ e (BaseFloatType fpp)
_ -> forall (w :: Natural). (1 <= w) => NatRepr w -> BVDomain w
BVD.any NatRepr w
w
    FloatToReal{} -> RealAbstractValue
ravUnbounded
    FloatSpecialFunction{} -> ()

    ArrayMap Assignment BaseTypeRepr (i ::> itp)
_ BaseTypeRepr tp
bRepr ArrayUpdateMap e (i ::> itp) tp
m e ('BaseArrayType (i ::> itp) tp)
d ->
      forall (bt :: BaseType) a.
BaseTypeRepr bt -> (Abstractable bt => a) -> a
withAbstractable BaseTypeRepr tp
bRepr forall a b. (a -> b) -> a -> b
$
      case forall (e :: BaseType -> Type) (ct :: Ctx BaseType)
       (tp :: BaseType).
ArrayUpdateMap e ct tp -> Maybe (AbstractValue tp)
AUM.arrayUpdateAbs ArrayUpdateMap e (i ::> itp) tp
m of
        Maybe (AbstractValue tp)
Nothing -> forall (u :: BaseType). e u -> AbstractValue u
f e ('BaseArrayType (i ::> itp) tp)
d
        Just AbstractValue tp
a -> forall (tp :: BaseType).
Abstractable tp =>
BaseTypeRepr tp
-> AbstractValue tp -> AbstractValue tp -> AbstractValue tp
avJoin BaseTypeRepr tp
bRepr (forall (u :: BaseType). e u -> AbstractValue u
f e ('BaseArrayType (i ::> itp) tp)
d) AbstractValue tp
a
    ConstantArray Assignment BaseTypeRepr (i ::> tp)
_idxRepr BaseTypeRepr b
_bRepr e b
v -> forall (u :: BaseType). e u -> AbstractValue u
f e b
v

    SelectArray BaseTypeRepr tp
_bRepr e (BaseArrayType (i ::> tp) tp)
a Assignment e (i ::> tp)
_i -> forall (u :: BaseType). e u -> AbstractValue u
f e (BaseArrayType (i ::> tp) tp)
a  -- FIXME?
    UpdateArray BaseTypeRepr b
bRepr Assignment BaseTypeRepr (i ::> tp)
_ e ('BaseArrayType (i ::> tp) b)
a Assignment e (i ::> tp)
_i e b
v -> forall (bt :: BaseType) a.
BaseTypeRepr bt -> (Abstractable bt => a) -> a
withAbstractable BaseTypeRepr b
bRepr forall a b. (a -> b) -> a -> b
$ forall (tp :: BaseType).
Abstractable tp =>
BaseTypeRepr tp
-> AbstractValue tp -> AbstractValue tp -> AbstractValue tp
avJoin BaseTypeRepr b
bRepr (forall (u :: BaseType). e u -> AbstractValue u
f e ('BaseArrayType (i ::> tp) b)
a) (forall (u :: BaseType). e u -> AbstractValue u
f e b
v)
    CopyArray NatRepr w
_ BaseTypeRepr a
a_repr e ('BaseArrayType (SingleCtx (BaseBVType w)) a)
dest_arr e (BaseBVType w)
_dest_idx e ('BaseArrayType (SingleCtx (BaseBVType w)) a)
src_arr e (BaseBVType w)
_src_idx e (BaseBVType w)
_len e (BaseBVType w)
_dest_end_idx e (BaseBVType w)
_src_end_idx ->
      forall (bt :: BaseType) a.
BaseTypeRepr bt -> (Abstractable bt => a) -> a
withAbstractable BaseTypeRepr a
a_repr forall a b. (a -> b) -> a -> b
$ forall (tp :: BaseType).
Abstractable tp =>
BaseTypeRepr tp
-> AbstractValue tp -> AbstractValue tp -> AbstractValue tp
avJoin BaseTypeRepr a
a_repr (forall (u :: BaseType). e u -> AbstractValue u
f e ('BaseArrayType (SingleCtx (BaseBVType w)) a)
dest_arr) (forall (u :: BaseType). e u -> AbstractValue u
f e ('BaseArrayType (SingleCtx (BaseBVType w)) a)
src_arr)
    SetArray NatRepr w
_ BaseTypeRepr a
a_repr e ('BaseArrayType (SingleCtx (BaseBVType w)) a)
arr e (BaseBVType w)
_idx e a
val e (BaseBVType w)
_len e (BaseBVType w)
_end_idx ->
      forall (bt :: BaseType) a.
BaseTypeRepr bt -> (Abstractable bt => a) -> a
withAbstractable BaseTypeRepr a
a_repr forall a b. (a -> b) -> a -> b
$ forall (tp :: BaseType).
Abstractable tp =>
BaseTypeRepr tp
-> AbstractValue tp -> AbstractValue tp -> AbstractValue tp
avJoin BaseTypeRepr a
a_repr (forall (u :: BaseType). e u -> AbstractValue u
f e ('BaseArrayType (SingleCtx (BaseBVType w)) a)
arr) (forall (u :: BaseType). e u -> AbstractValue u
f e a
val)
    EqualArrayRange{} -> forall a. Maybe a
Nothing

    IntegerToReal e BaseIntegerType
x -> ValueRange Rational -> Maybe Bool -> RealAbstractValue
RAV (forall a b. (a -> b) -> ValueRange a -> ValueRange b
mapRange forall a. Real a => a -> Rational
toRational (forall (u :: BaseType). e u -> AbstractValue u
f e BaseIntegerType
x)) (forall a. a -> Maybe a
Just Bool
True)
    BVToInteger e (BaseBVType w)
x -> forall tp. Eq tp => ValueBound tp -> ValueBound tp -> ValueRange tp
valueRange (forall tp. tp -> ValueBound tp
Inclusive Integer
lx) (forall tp. tp -> ValueBound tp
Inclusive Integer
ux)
      where (Integer
lx, Integer
ux) = forall (w :: Natural). BVDomain w -> (Integer, Integer)
BVD.ubounds (forall (u :: BaseType). e u -> AbstractValue u
f e (BaseBVType w)
x)
    SBVToInteger e (BaseBVType w)
x -> forall tp. Eq tp => ValueBound tp -> ValueBound tp -> ValueRange tp
valueRange (forall tp. tp -> ValueBound tp
Inclusive Integer
lx) (forall tp. tp -> ValueBound tp
Inclusive Integer
ux)
      where (Integer
lx, Integer
ux) = forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BVDomain w -> (Integer, Integer)
BVD.sbounds (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth e (BaseBVType w)
x) (forall (u :: BaseType). e u -> AbstractValue u
f e (BaseBVType w)
x)
    RoundReal e BaseRealType
x -> forall a b. (a -> b) -> ValueRange a -> ValueRange b
mapRange forall a. RealFrac a => a -> Integer
roundAway (RealAbstractValue -> ValueRange Rational
ravRange (forall (u :: BaseType). e u -> AbstractValue u
f e BaseRealType
x))
    RoundEvenReal e BaseRealType
x -> forall a b. (a -> b) -> ValueRange a -> ValueRange b
mapRange forall a b. (RealFrac a, Integral b) => a -> b
round (RealAbstractValue -> ValueRange Rational
ravRange (forall (u :: BaseType). e u -> AbstractValue u
f e BaseRealType
x))
    FloorReal e BaseRealType
x -> forall a b. (a -> b) -> ValueRange a -> ValueRange b
mapRange forall a b. (RealFrac a, Integral b) => a -> b
floor (RealAbstractValue -> ValueRange Rational
ravRange (forall (u :: BaseType). e u -> AbstractValue u
f e BaseRealType
x))
    CeilReal e BaseRealType
x  -> forall a b. (a -> b) -> ValueRange a -> ValueRange b
mapRange forall a b. (RealFrac a, Integral b) => a -> b
ceiling (RealAbstractValue -> ValueRange Rational
ravRange (forall (u :: BaseType). e u -> AbstractValue u
f e BaseRealType
x))
    IntegerToBV e BaseIntegerType
x NatRepr w
w -> forall (w :: Natural).
NatRepr w -> Integer -> Integer -> BVDomain w
BVD.range NatRepr w
w Integer
l Integer
u
      where rng :: AbstractValue BaseIntegerType
rng = forall (u :: BaseType). e u -> AbstractValue u
f e BaseIntegerType
x
            l :: Integer
l = case forall tp. ValueRange tp -> ValueBound tp
rangeLowBound AbstractValue BaseIntegerType
rng of
                  ValueBound Integer
Unbounded -> forall (w :: Natural). NatRepr w -> Integer
minUnsigned NatRepr w
w
                  Inclusive Integer
v -> forall a. Ord a => a -> a -> a
max (forall (w :: Natural). NatRepr w -> Integer
minUnsigned NatRepr w
w) Integer
v
            u :: Integer
u = case forall tp. ValueRange tp -> ValueBound tp
rangeHiBound AbstractValue BaseIntegerType
rng of
                  ValueBound Integer
Unbounded -> forall (w :: Natural). NatRepr w -> Integer
maxUnsigned NatRepr w
w
                  Inclusive Integer
v -> forall a. Ord a => a -> a -> a
min (forall (w :: Natural). NatRepr w -> Integer
maxUnsigned NatRepr w
w) Integer
v
    RealToInteger e BaseRealType
x -> forall tp. Eq tp => ValueBound tp -> ValueBound tp -> ValueRange tp
valueRange (forall a b. (RealFrac a, Integral b) => a -> b
ceiling forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ValueBound Rational
lx) (forall a b. (RealFrac a, Integral b) => a -> b
floor forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ValueBound Rational
ux)
      where lx :: ValueBound Rational
lx = forall tp. ValueRange tp -> ValueBound tp
rangeLowBound ValueRange Rational
rng
            ux :: ValueBound Rational
ux = forall tp. ValueRange tp -> ValueBound tp
rangeHiBound ValueRange Rational
rng
            rng :: ValueRange Rational
rng = RealAbstractValue -> ValueRange Rational
ravRange (forall (u :: BaseType). e u -> AbstractValue u
f e BaseRealType
x)

    Cplx Complex (e BaseRealType)
c -> forall (u :: BaseType). e u -> AbstractValue u
f forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Complex (e BaseRealType)
c
    RealPart e BaseComplexType
x -> forall a. Complex a -> a
realPart (forall (u :: BaseType). e u -> AbstractValue u
f e BaseComplexType
x)
    ImagPart e BaseComplexType
x -> forall a. Complex a -> a
imagPart (forall (u :: BaseType). e u -> AbstractValue u
f e BaseComplexType
x)

    StringContains{} -> forall a. Maybe a
Nothing
    StringIsPrefixOf{} -> forall a. Maybe a
Nothing
    StringIsSuffixOf{} -> forall a. Maybe a
Nothing
    StringLength e (BaseStringType si)
s -> StringAbstractValue -> ValueRange Integer
stringAbsLength (forall (u :: BaseType). e u -> AbstractValue u
f e (BaseStringType si)
s)
    StringSubstring StringInfoRepr si
_ e ('BaseStringType si)
s e BaseIntegerType
t e BaseIntegerType
l -> StringAbstractValue
-> ValueRange Integer -> ValueRange Integer -> StringAbstractValue
stringAbsSubstring (forall (u :: BaseType). e u -> AbstractValue u
f e ('BaseStringType si)
s) (forall (u :: BaseType). e u -> AbstractValue u
f e BaseIntegerType
t) (forall (u :: BaseType). e u -> AbstractValue u
f e BaseIntegerType
l)
    StringIndexOf e (BaseStringType si)
s e (BaseStringType si)
t e BaseIntegerType
k -> StringAbstractValue
-> StringAbstractValue -> ValueRange Integer -> ValueRange Integer
stringAbsIndexOf (forall (u :: BaseType). e u -> AbstractValue u
f e (BaseStringType si)
s) (forall (u :: BaseType). e u -> AbstractValue u
f e (BaseStringType si)
t) (forall (u :: BaseType). e u -> AbstractValue u
f e BaseIntegerType
k)
    StringAppend StringInfoRepr si
_ StringSeq e si
xs -> forall (e :: BaseType -> Type) (si :: StringInfo).
(HasAbsValue e, HashableF e) =>
StringSeq e si -> StringAbstractValue
SSeq.stringSeqAbs StringSeq e si
xs

    StructCtor Assignment BaseTypeRepr flds
_ Assignment e flds
flds -> forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
       (g :: k -> Type).
FunctorFC t =>
(forall (x :: k). f x -> g x) -> forall (x :: l). t f x -> t g x
fmapFC (\e x
v -> forall (tp :: BaseType).
AbstractValue tp -> AbstractValueWrapper tp
AbstractValueWrapper (forall (u :: BaseType). e u -> AbstractValue u
f e x
v)) Assignment e flds
flds
    StructField e (BaseStructType flds)
s Index flds tp
idx BaseTypeRepr tp
_ -> forall (tp :: BaseType).
AbstractValueWrapper tp -> AbstractValue tp
unwrapAV (forall (u :: BaseType). e u -> AbstractValue u
f e (BaseStructType flds)
s forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
Assignment f ctx -> Index ctx tp -> f tp
Ctx.! Index flds tp
idx)


reduceApp :: IsExprBuilder sym
          => sym
          -> (forall w. (1 <= w) => sym -> UnaryBV (Pred sym) w -> IO (SymExpr sym (BaseBVType w)))
          -> App (SymExpr sym) tp
          -> IO (SymExpr sym tp)
reduceApp :: forall sym (tp :: BaseType).
IsExprBuilder sym =>
sym
-> (forall (w :: Natural).
    (1 <= w) =>
    sym -> UnaryBV (Pred sym) w -> IO (SymExpr sym (BaseBVType w)))
-> App (SymExpr sym) tp
-> IO (SymExpr sym tp)
reduceApp sym
sym forall (w :: Natural).
(1 <= w) =>
sym -> UnaryBV (Pred sym) w -> IO (SymExpr sym (BaseBVType w))
unary App (SymExpr sym) tp
a0 = do
  case App (SymExpr sym) tp
a0 of
    BaseIte BaseTypeRepr tp
_ Integer
_ Pred sym
c SymExpr sym tp
x SymExpr sym tp
y -> forall sym (tp :: BaseType).
IsExprBuilder sym =>
sym
-> Pred sym
-> SymExpr sym tp
-> SymExpr sym tp
-> IO (SymExpr sym tp)
baseTypeIte sym
sym Pred sym
c SymExpr sym tp
x SymExpr sym tp
y
    BaseEq BaseTypeRepr tp
_ SymExpr sym tp
x SymExpr sym tp
y -> forall sym (tp :: BaseType).
IsExprBuilder sym =>
sym -> SymExpr sym tp -> SymExpr sym tp -> IO (Pred sym)
isEq sym
sym SymExpr sym tp
x SymExpr sym tp
y

    NotPred Pred sym
x -> forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred sym
sym Pred sym
x
    ConjPred BoolMap (SymExpr sym)
bm ->
      case forall (f :: BaseType -> Type). BoolMap f -> BoolMapView f
BM.viewBoolMap BoolMap (SymExpr sym)
bm of
        BoolMapView (SymExpr sym)
BoolMapDualUnit -> forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred sym
sym
        BoolMapView (SymExpr sym)
BoolMapUnit     -> forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall sym. IsExprBuilder sym => sym -> Pred sym
truePred sym
sym
        BoolMapTerms NonEmpty (Pred sym, Polarity)
tms ->
          do let pol :: (Pred sym, Polarity) -> IO (Pred sym)
pol (Pred sym
p, Polarity
Positive) = forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred sym
p
                 pol (Pred sym
p, Polarity
Negative) = forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred sym
sym Pred sym
p
             Pred sym
x:|[Pred sym]
xs <- forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Pred sym, Polarity) -> IO (Pred sym)
pol NonEmpty (Pred sym, Polarity)
tms
             forall (t :: Type -> Type) (m :: Type -> Type) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
andPred sym
sym) Pred sym
x [Pred sym]
xs

    SemiRingSum WeightedSum (SymExpr sym) sr
s ->
      case forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> SemiRingRepr sr
WSum.sumRepr WeightedSum (SymExpr sym) sr
s of
        SemiRingRepr sr
SR.SemiRingIntegerRepr ->
          forall (m :: Type -> Type) r (sr :: SemiRing)
       (f :: BaseType -> Type).
Monad m =>
(r -> r -> m r)
-> (Coefficient sr -> f (SemiRingBase sr) -> m r)
-> (Coefficient sr -> m r)
-> WeightedSum f sr
-> m r
WSum.evalM (forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (SymInteger sym)
intAdd sym
sym) (\Coefficient sr
c SymExpr sym (SemiRingBase sr)
x -> forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (SymInteger sym)
intMul sym
sym SymExpr sym (SemiRingBase sr)
x forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit sym
sym Coefficient sr
c) (forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit sym
sym) WeightedSum (SymExpr sym) sr
s
        SemiRingRepr sr
SR.SemiRingRealRepr ->
          forall (m :: Type -> Type) r (sr :: SemiRing)
       (f :: BaseType -> Type).
Monad m =>
(r -> r -> m r)
-> (Coefficient sr -> f (SemiRingBase sr) -> m r)
-> (Coefficient sr -> m r)
-> WeightedSum f sr
-> m r
WSum.evalM (forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (SymReal sym)
realAdd sym
sym) (\Coefficient sr
c SymExpr sym (SemiRingBase sr)
x -> forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (SymReal sym)
realMul sym
sym SymExpr sym (SemiRingBase sr)
x forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit sym
sym Coefficient sr
c) (forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit sym
sym) WeightedSum (SymExpr sym) sr
s
        SR.SemiRingBVRepr BVFlavorRepr fv
SR.BVArithRepr NatRepr w
w ->
          forall (m :: Type -> Type) r (sr :: SemiRing)
       (f :: BaseType -> Type).
Monad m =>
(r -> r -> m r)
-> (Coefficient sr -> f (SemiRingBase sr) -> m r)
-> (Coefficient sr -> m r)
-> WeightedSum f sr
-> m r
WSum.evalM (forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvAdd sym
sym) (\Coefficient sr
c SymExpr sym (SemiRingBase sr)
x -> forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvMul sym
sym SymExpr sym (SemiRingBase sr)
x forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit sym
sym NatRepr w
w Coefficient sr
c) (forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit sym
sym NatRepr w
w) WeightedSum (SymExpr sym) sr
s
        SR.SemiRingBVRepr BVFlavorRepr fv
SR.BVBitsRepr NatRepr w
w ->
          forall (m :: Type -> Type) r (sr :: SemiRing)
       (f :: BaseType -> Type).
Monad m =>
(r -> r -> m r)
-> (Coefficient sr -> f (SemiRingBase sr) -> m r)
-> (Coefficient sr -> m r)
-> WeightedSum f sr
-> m r
WSum.evalM (forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvXorBits sym
sym) (\Coefficient sr
c SymExpr sym (SemiRingBase sr)
x -> forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvAndBits sym
sym SymExpr sym (SemiRingBase sr)
x forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit sym
sym NatRepr w
w Coefficient sr
c) (forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit sym
sym NatRepr w
w) WeightedSum (SymExpr sym) sr
s

    SemiRingProd SemiRingProduct (SymExpr sym) sr
pd ->
      case forall (f :: BaseType -> Type) (sr :: SemiRing).
SemiRingProduct f sr -> SemiRingRepr sr
WSum.prodRepr SemiRingProduct (SymExpr sym) sr
pd of
        SemiRingRepr sr
SR.SemiRingIntegerRepr ->
          forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit sym
sym Integer
1) forall (m :: Type -> Type) a. Monad m => a -> m a
return forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: Type -> Type) r (f :: BaseType -> Type)
       (sr :: SemiRing).
Monad m =>
(r -> r -> m r)
-> (f (SemiRingBase sr) -> m r)
-> SemiRingProduct f sr
-> m (Maybe r)
WSum.prodEvalM (forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (SymInteger sym)
intMul sym
sym) forall (m :: Type -> Type) a. Monad m => a -> m a
return SemiRingProduct (SymExpr sym) sr
pd
        SemiRingRepr sr
SR.SemiRingRealRepr ->
          forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit sym
sym Rational
1) forall (m :: Type -> Type) a. Monad m => a -> m a
return forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: Type -> Type) r (f :: BaseType -> Type)
       (sr :: SemiRing).
Monad m =>
(r -> r -> m r)
-> (f (SemiRingBase sr) -> m r)
-> SemiRingProduct f sr
-> m (Maybe r)
WSum.prodEvalM (forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (SymReal sym)
realMul sym
sym) forall (m :: Type -> Type) a. Monad m => a -> m a
return SemiRingProduct (SymExpr sym) sr
pd
        SR.SemiRingBVRepr BVFlavorRepr fv
SR.BVArithRepr NatRepr w
w ->
          forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit sym
sym NatRepr w
w (forall (w :: Natural). (1 <= w) => NatRepr w -> BV w
BV.one NatRepr w
w)) forall (m :: Type -> Type) a. Monad m => a -> m a
return forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: Type -> Type) r (f :: BaseType -> Type)
       (sr :: SemiRing).
Monad m =>
(r -> r -> m r)
-> (f (SemiRingBase sr) -> m r)
-> SemiRingProduct f sr
-> m (Maybe r)
WSum.prodEvalM (forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvMul sym
sym) forall (m :: Type -> Type) a. Monad m => a -> m a
return SemiRingProduct (SymExpr sym) sr
pd
        SR.SemiRingBVRepr BVFlavorRepr fv
SR.BVBitsRepr NatRepr w
w ->
          forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit sym
sym NatRepr w
w (forall (w :: Natural). NatRepr w -> BV w
BV.maxUnsigned NatRepr w
w)) forall (m :: Type -> Type) a. Monad m => a -> m a
return forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: Type -> Type) r (f :: BaseType -> Type)
       (sr :: SemiRing).
Monad m =>
(r -> r -> m r)
-> (f (SemiRingBase sr) -> m r)
-> SemiRingProduct f sr
-> m (Maybe r)
WSum.prodEvalM (forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvAndBits sym
sym) forall (m :: Type -> Type) a. Monad m => a -> m a
return SemiRingProduct (SymExpr sym) sr
pd

    SemiRingLe OrderedSemiRingRepr sr
SR.OrderedSemiRingRealRepr SymExpr sym (SemiRingBase sr)
x SymExpr sym (SemiRingBase sr)
y -> forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realLe sym
sym SymExpr sym (SemiRingBase sr)
x SymExpr sym (SemiRingBase sr)
y
    SemiRingLe OrderedSemiRingRepr sr
SR.OrderedSemiRingIntegerRepr SymExpr sym (SemiRingBase sr)
x SymExpr sym (SemiRingBase sr)
y -> forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (Pred sym)
intLe sym
sym SymExpr sym (SemiRingBase sr)
x SymExpr sym (SemiRingBase sr)
y

    RealIsInteger SymExpr sym BaseRealType
x -> forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> IO (Pred sym)
isInteger sym
sym SymExpr sym BaseRealType
x

    IntDiv SymExpr sym BaseIntegerType
x SymExpr sym BaseIntegerType
y -> forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (SymInteger sym)
intDiv sym
sym SymExpr sym BaseIntegerType
x SymExpr sym BaseIntegerType
y
    IntMod SymExpr sym BaseIntegerType
x SymExpr sym BaseIntegerType
y -> forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (SymInteger sym)
intMod sym
sym SymExpr sym BaseIntegerType
x SymExpr sym BaseIntegerType
y
    IntAbs SymExpr sym BaseIntegerType
x -> forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> IO (SymInteger sym)
intAbs sym
sym SymExpr sym BaseIntegerType
x
    IntDivisible SymExpr sym BaseIntegerType
x Natural
k -> forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> Natural -> IO (Pred sym)
intDivisible sym
sym SymExpr sym BaseIntegerType
x Natural
k

    RealDiv SymExpr sym BaseRealType
x SymExpr sym BaseRealType
y -> forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (SymReal sym)
realDiv sym
sym SymExpr sym BaseRealType
x SymExpr sym BaseRealType
y
    RealSqrt SymExpr sym BaseRealType
x  -> forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> IO (SymReal sym)
realSqrt sym
sym SymExpr sym BaseRealType
x

    RealSpecialFunction SpecialFunction args
fn (SFn.SpecialFnArgs Assignment (SpecialFnArg (SymExpr sym) BaseRealType) args
args) ->
      forall sym (args :: Ctx Type).
IsExprBuilder sym =>
sym
-> SpecialFunction args
-> Assignment (SpecialFnArg (SymExpr sym) BaseRealType) args
-> IO (SymReal sym)
realSpecialFunction sym
sym SpecialFunction args
fn Assignment (SpecialFnArg (SymExpr sym) BaseRealType) args
args

    BVOrBits NatRepr w
w BVOrSet (SymExpr sym) w
bs ->
      case forall (e :: BaseType -> Type) (w :: Natural).
BVOrSet e w -> [e (BaseBVType w)]
bvOrToList BVOrSet (SymExpr sym) w
bs of
        [] -> forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit sym
sym NatRepr w
w (forall (w :: Natural). NatRepr w -> BV w
BV.zero NatRepr w
w)
        (SymExpr sym ('BaseBVType w)
x:[SymExpr sym ('BaseBVType w)]
xs) -> forall (t :: Type -> Type) (m :: Type -> Type) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvOrBits sym
sym) SymExpr sym ('BaseBVType w)
x [SymExpr sym ('BaseBVType w)]
xs

    BVTestBit Natural
i SymExpr sym (BaseBVType w)
e -> forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> Natural -> SymBV sym w -> IO (Pred sym)
testBitBV sym
sym Natural
i SymExpr sym (BaseBVType w)
e
    BVSlt SymExpr sym (BaseBVType w)
x SymExpr sym (BaseBVType w)
y -> forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvSlt sym
sym SymExpr sym (BaseBVType w)
x SymExpr sym (BaseBVType w)
y
    BVUlt SymExpr sym (BaseBVType w)
x SymExpr sym (BaseBVType w)
y -> forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvUlt sym
sym SymExpr sym (BaseBVType w)
x SymExpr sym (BaseBVType w)
y
    BVUnaryTerm UnaryBV (Pred sym) n
x -> forall (w :: Natural).
(1 <= w) =>
sym -> UnaryBV (Pred sym) w -> IO (SymExpr sym (BaseBVType w))
unary sym
sym UnaryBV (Pred sym) n
x
    BVConcat NatRepr (u + v)
_ SymExpr sym (BaseBVType u)
x SymExpr sym (BaseBVType v)
y -> forall sym (u :: Natural) (v :: Natural).
(IsExprBuilder sym, 1 <= u, 1 <= v) =>
sym -> SymBV sym u -> SymBV sym v -> IO (SymBV sym (u + v))
bvConcat sym
sym SymExpr sym (BaseBVType u)
x SymExpr sym (BaseBVType v)
y
    BVSelect NatRepr idx
idx NatRepr n
n SymExpr sym (BaseBVType w)
x -> forall sym (idx :: Natural) (n :: Natural) (w :: Natural).
(IsExprBuilder sym, 1 <= n, (idx + n) <= w) =>
sym -> NatRepr idx -> NatRepr n -> SymBV sym w -> IO (SymBV sym n)
bvSelect sym
sym NatRepr idx
idx NatRepr n
n SymExpr sym (BaseBVType w)
x
    BVUdiv NatRepr w
_ SymExpr sym ('BaseBVType w)
x SymExpr sym ('BaseBVType w)
y -> forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvUdiv sym
sym SymExpr sym ('BaseBVType w)
x SymExpr sym ('BaseBVType w)
y
    BVUrem NatRepr w
_ SymExpr sym ('BaseBVType w)
x SymExpr sym ('BaseBVType w)
y -> forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvUrem sym
sym SymExpr sym ('BaseBVType w)
x SymExpr sym ('BaseBVType w)
y
    BVSdiv NatRepr w
_ SymExpr sym ('BaseBVType w)
x SymExpr sym ('BaseBVType w)
y -> forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvSdiv sym
sym SymExpr sym ('BaseBVType w)
x SymExpr sym ('BaseBVType w)
y
    BVSrem NatRepr w
_ SymExpr sym ('BaseBVType w)
x SymExpr sym ('BaseBVType w)
y -> forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvSrem sym
sym SymExpr sym ('BaseBVType w)
x SymExpr sym ('BaseBVType w)
y
    BVShl NatRepr w
_ SymExpr sym ('BaseBVType w)
x SymExpr sym ('BaseBVType w)
y  -> forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvShl  sym
sym SymExpr sym ('BaseBVType w)
x SymExpr sym ('BaseBVType w)
y
    BVLshr NatRepr w
_ SymExpr sym ('BaseBVType w)
x SymExpr sym ('BaseBVType w)
y -> forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvLshr sym
sym SymExpr sym ('BaseBVType w)
x SymExpr sym ('BaseBVType w)
y
    BVAshr NatRepr w
_ SymExpr sym ('BaseBVType w)
x SymExpr sym ('BaseBVType w)
y -> forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvAshr sym
sym SymExpr sym ('BaseBVType w)
x SymExpr sym ('BaseBVType w)
y
    BVRol  NatRepr w
_ SymExpr sym ('BaseBVType w)
x SymExpr sym ('BaseBVType w)
y -> forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvRol sym
sym SymExpr sym ('BaseBVType w)
x SymExpr sym ('BaseBVType w)
y
    BVRor  NatRepr w
_ SymExpr sym ('BaseBVType w)
x SymExpr sym ('BaseBVType w)
y -> forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvRor sym
sym SymExpr sym ('BaseBVType w)
x SymExpr sym ('BaseBVType w)
y
    BVZext  NatRepr r
w SymExpr sym (BaseBVType w)
x  -> forall sym (u :: Natural) (r :: Natural).
(IsExprBuilder sym, 1 <= u, (u + 1) <= r) =>
sym -> NatRepr r -> SymBV sym u -> IO (SymBV sym r)
bvZext sym
sym NatRepr r
w SymExpr sym (BaseBVType w)
x
    BVSext  NatRepr r
w SymExpr sym (BaseBVType w)
x  -> forall sym (u :: Natural) (r :: Natural).
(IsExprBuilder sym, 1 <= u, (u + 1) <= r) =>
sym -> NatRepr r -> SymBV sym u -> IO (SymBV sym r)
bvSext sym
sym NatRepr r
w SymExpr sym (BaseBVType w)
x
    BVPopcount NatRepr w
_ SymExpr sym ('BaseBVType w)
x -> forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> IO (SymBV sym w)
bvPopcount sym
sym SymExpr sym ('BaseBVType w)
x
    BVFill NatRepr w
w Pred sym
p -> forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> Pred sym -> IO (SymBV sym w)
bvFill sym
sym NatRepr w
w Pred sym
p
    BVCountLeadingZeros NatRepr w
_ SymExpr sym ('BaseBVType w)
x -> forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> IO (SymBV sym w)
bvCountLeadingZeros sym
sym SymExpr sym ('BaseBVType w)
x
    BVCountTrailingZeros NatRepr w
_ SymExpr sym ('BaseBVType w)
x -> forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> IO (SymBV sym w)
bvCountTrailingZeros sym
sym SymExpr sym ('BaseBVType w)
x

    FloatNeg FloatPrecisionRepr fpp
_ SymExpr sym ('BaseFloatType fpp)
x -> forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (SymFloat sym fpp)
floatNeg sym
sym SymExpr sym ('BaseFloatType fpp)
x
    FloatAbs FloatPrecisionRepr fpp
_ SymExpr sym ('BaseFloatType fpp)
x -> forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (SymFloat sym fpp)
floatAbs sym
sym SymExpr sym ('BaseFloatType fpp)
x
    FloatSqrt FloatPrecisionRepr fpp
_ RoundingMode
r SymExpr sym ('BaseFloatType fpp)
x -> forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> RoundingMode -> SymFloat sym fpp -> IO (SymFloat sym fpp)
floatSqrt sym
sym RoundingMode
r SymExpr sym ('BaseFloatType fpp)
x
    FloatAdd FloatPrecisionRepr fpp
_ RoundingMode
r SymExpr sym ('BaseFloatType fpp)
x SymExpr sym ('BaseFloatType fpp)
y -> forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> RoundingMode
-> SymFloat sym fpp
-> SymFloat sym fpp
-> IO (SymFloat sym fpp)
floatAdd sym
sym RoundingMode
r SymExpr sym ('BaseFloatType fpp)
x SymExpr sym ('BaseFloatType fpp)
y
    FloatSub FloatPrecisionRepr fpp
_ RoundingMode
r SymExpr sym ('BaseFloatType fpp)
x SymExpr sym ('BaseFloatType fpp)
y -> forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> RoundingMode
-> SymFloat sym fpp
-> SymFloat sym fpp
-> IO (SymFloat sym fpp)
floatSub sym
sym RoundingMode
r SymExpr sym ('BaseFloatType fpp)
x SymExpr sym ('BaseFloatType fpp)
y
    FloatMul FloatPrecisionRepr fpp
_ RoundingMode
r SymExpr sym ('BaseFloatType fpp)
x SymExpr sym ('BaseFloatType fpp)
y -> forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> RoundingMode
-> SymFloat sym fpp
-> SymFloat sym fpp
-> IO (SymFloat sym fpp)
floatMul sym
sym RoundingMode
r SymExpr sym ('BaseFloatType fpp)
x SymExpr sym ('BaseFloatType fpp)
y
    FloatDiv FloatPrecisionRepr fpp
_ RoundingMode
r SymExpr sym ('BaseFloatType fpp)
x SymExpr sym ('BaseFloatType fpp)
y -> forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> RoundingMode
-> SymFloat sym fpp
-> SymFloat sym fpp
-> IO (SymFloat sym fpp)
floatDiv sym
sym RoundingMode
r SymExpr sym ('BaseFloatType fpp)
x SymExpr sym ('BaseFloatType fpp)
y
    FloatRem FloatPrecisionRepr fpp
_ SymExpr sym ('BaseFloatType fpp)
x SymExpr sym ('BaseFloatType fpp)
y -> forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> SymFloat sym fpp -> SymFloat sym fpp -> IO (SymFloat sym fpp)
floatRem sym
sym SymExpr sym ('BaseFloatType fpp)
x SymExpr sym ('BaseFloatType fpp)
y
    FloatFMA FloatPrecisionRepr fpp
_ RoundingMode
r SymExpr sym ('BaseFloatType fpp)
x SymExpr sym ('BaseFloatType fpp)
y SymExpr sym ('BaseFloatType fpp)
z -> forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> RoundingMode
-> SymFloat sym fpp
-> SymFloat sym fpp
-> SymFloat sym fpp
-> IO (SymFloat sym fpp)
floatFMA sym
sym RoundingMode
r SymExpr sym ('BaseFloatType fpp)
x SymExpr sym ('BaseFloatType fpp)
y SymExpr sym ('BaseFloatType fpp)
z
    FloatFpEq SymExpr sym (BaseFloatType fpp)
x SymExpr sym (BaseFloatType fpp)
y -> forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
floatFpEq sym
sym SymExpr sym (BaseFloatType fpp)
x SymExpr sym (BaseFloatType fpp)
y
    FloatLe   SymExpr sym (BaseFloatType fpp)
x SymExpr sym (BaseFloatType fpp)
y -> forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
floatLe sym
sym SymExpr sym (BaseFloatType fpp)
x SymExpr sym (BaseFloatType fpp)
y
    FloatLt   SymExpr sym (BaseFloatType fpp)
x SymExpr sym (BaseFloatType fpp)
y -> forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
floatLt sym
sym SymExpr sym (BaseFloatType fpp)
x SymExpr sym (BaseFloatType fpp)
y
    FloatIsNaN     SymExpr sym (BaseFloatType fpp)
x -> forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
floatIsNaN sym
sym SymExpr sym (BaseFloatType fpp)
x
    FloatIsInf     SymExpr sym (BaseFloatType fpp)
x -> forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
floatIsInf sym
sym SymExpr sym (BaseFloatType fpp)
x
    FloatIsZero    SymExpr sym (BaseFloatType fpp)
x -> forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
floatIsZero sym
sym SymExpr sym (BaseFloatType fpp)
x
    FloatIsPos     SymExpr sym (BaseFloatType fpp)
x -> forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
floatIsPos sym
sym SymExpr sym (BaseFloatType fpp)
x
    FloatIsNeg     SymExpr sym (BaseFloatType fpp)
x -> forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
floatIsNeg sym
sym SymExpr sym (BaseFloatType fpp)
x
    FloatIsSubnorm SymExpr sym (BaseFloatType fpp)
x -> forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
floatIsSubnorm sym
sym SymExpr sym (BaseFloatType fpp)
x
    FloatIsNorm    SymExpr sym (BaseFloatType fpp)
x -> forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
floatIsNorm sym
sym SymExpr sym (BaseFloatType fpp)
x
    FloatCast FloatPrecisionRepr fpp
fpp RoundingMode
r SymExpr sym (BaseFloatType fpp')
x -> forall sym (fpp :: FloatPrecision) (fpp' :: FloatPrecision).
IsExprBuilder sym =>
sym
-> FloatPrecisionRepr fpp
-> RoundingMode
-> SymFloat sym fpp'
-> IO (SymFloat sym fpp)
floatCast sym
sym FloatPrecisionRepr fpp
fpp RoundingMode
r SymExpr sym (BaseFloatType fpp')
x
    FloatRound  FloatPrecisionRepr fpp
_ RoundingMode
r SymExpr sym ('BaseFloatType fpp)
x -> forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> RoundingMode -> SymFloat sym fpp -> IO (SymFloat sym fpp)
floatRound sym
sym RoundingMode
r SymExpr sym ('BaseFloatType fpp)
x
    FloatFromBinary FloatPrecisionRepr (FloatingPointPrecision eb sb)
fpp SymExpr sym (BaseBVType (eb + sb))
x -> forall sym (eb :: Natural) (sb :: Natural).
(IsExprBuilder sym, 2 <= eb, 2 <= sb) =>
sym
-> FloatPrecisionRepr (FloatingPointPrecision eb sb)
-> SymBV sym (eb + sb)
-> IO (SymFloat sym (FloatingPointPrecision eb sb))
floatFromBinary sym
sym FloatPrecisionRepr (FloatingPointPrecision eb sb)
fpp SymExpr sym (BaseBVType (eb + sb))
x
    FloatToBinary   FloatPrecisionRepr (FloatingPointPrecision eb sb)
_   SymExpr sym (BaseFloatType (FloatingPointPrecision eb sb))
x -> forall sym (eb :: Natural) (sb :: Natural).
(IsExprBuilder sym, 2 <= eb, 2 <= sb) =>
sym
-> SymFloat sym (FloatingPointPrecision eb sb)
-> IO (SymBV sym (eb + sb))
floatToBinary sym
sym SymExpr sym (BaseFloatType (FloatingPointPrecision eb sb))
x
    BVToFloat   FloatPrecisionRepr fpp
fpp RoundingMode
r SymExpr sym (BaseBVType w)
x -> forall sym (w :: Natural) (fpp :: FloatPrecision).
(IsExprBuilder sym, 1 <= w) =>
sym
-> FloatPrecisionRepr fpp
-> RoundingMode
-> SymBV sym w
-> IO (SymFloat sym fpp)
bvToFloat sym
sym FloatPrecisionRepr fpp
fpp RoundingMode
r SymExpr sym (BaseBVType w)
x
    SBVToFloat  FloatPrecisionRepr fpp
fpp RoundingMode
r SymExpr sym (BaseBVType w)
x -> forall sym (w :: Natural) (fpp :: FloatPrecision).
(IsExprBuilder sym, 1 <= w) =>
sym
-> FloatPrecisionRepr fpp
-> RoundingMode
-> SymBV sym w
-> IO (SymFloat sym fpp)
sbvToFloat sym
sym FloatPrecisionRepr fpp
fpp RoundingMode
r SymExpr sym (BaseBVType w)
x
    RealToFloat FloatPrecisionRepr fpp
fpp RoundingMode
r SymExpr sym BaseRealType
x -> forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> FloatPrecisionRepr fpp
-> RoundingMode
-> SymReal sym
-> IO (SymFloat sym fpp)
realToFloat sym
sym FloatPrecisionRepr fpp
fpp RoundingMode
r SymExpr sym BaseRealType
x
    FloatToBV   NatRepr w
w   RoundingMode
r SymExpr sym (BaseFloatType fpp)
x -> forall sym (w :: Natural) (fpp :: FloatPrecision).
(IsExprBuilder sym, 1 <= w) =>
sym
-> NatRepr w
-> RoundingMode
-> SymFloat sym fpp
-> IO (SymBV sym w)
floatToBV sym
sym NatRepr w
w RoundingMode
r SymExpr sym (BaseFloatType fpp)
x
    FloatToSBV  NatRepr w
w   RoundingMode
r SymExpr sym (BaseFloatType fpp)
x -> forall sym (w :: Natural) (fpp :: FloatPrecision).
(IsExprBuilder sym, 1 <= w) =>
sym
-> NatRepr w
-> RoundingMode
-> SymFloat sym fpp
-> IO (SymBV sym w)
floatToSBV sym
sym NatRepr w
w RoundingMode
r SymExpr sym (BaseFloatType fpp)
x
    FloatToReal SymExpr sym (BaseFloatType fpp)
x -> forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (SymReal sym)
floatToReal sym
sym SymExpr sym (BaseFloatType fpp)
x
    FloatSpecialFunction FloatPrecisionRepr fpp
fpp SpecialFunction args
fn (SFn.SpecialFnArgs Assignment (SpecialFnArg (SymExpr sym) ('BaseFloatType fpp)) args
args) ->
      forall sym (fpp :: FloatPrecision) (args :: Ctx Type).
IsExprBuilder sym =>
sym
-> FloatPrecisionRepr fpp
-> SpecialFunction args
-> Assignment (SpecialFnArg (SymExpr sym) (BaseFloatType fpp)) args
-> IO (SymFloat sym fpp)
floatSpecialFunction sym
sym FloatPrecisionRepr fpp
fpp SpecialFunction args
fn Assignment (SpecialFnArg (SymExpr sym) ('BaseFloatType fpp)) args
args

    ArrayMap Assignment BaseTypeRepr (i ::> itp)
_ BaseTypeRepr tp
_ ArrayUpdateMap (SymExpr sym) (i ::> itp) tp
m SymExpr sym ('BaseArrayType (i ::> itp) tp)
def_map ->
      forall sym (idx :: Ctx BaseType) (itp :: BaseType)
       (tp :: BaseType).
IsExprBuilder sym =>
sym
-> ArrayUpdateMap (SymExpr sym) (idx ::> itp) tp
-> SymArray sym (idx ::> itp) tp
-> IO (SymArray sym (idx ::> itp) tp)
arrayUpdateAtIdxLits sym
sym ArrayUpdateMap (SymExpr sym) (i ::> itp) tp
m SymExpr sym ('BaseArrayType (i ::> itp) tp)
def_map
    ConstantArray Assignment BaseTypeRepr (i ::> tp)
idx_tp BaseTypeRepr b
_ SymExpr sym b
e -> forall sym (idx :: Ctx BaseType) (tp :: BaseType) (b :: BaseType).
IsExprBuilder sym =>
sym
-> Assignment BaseTypeRepr (idx ::> tp)
-> SymExpr sym b
-> IO (SymArray sym (idx ::> tp) b)
constantArray sym
sym Assignment BaseTypeRepr (i ::> tp)
idx_tp SymExpr sym b
e
    SelectArray BaseTypeRepr tp
_ SymExpr sym (BaseArrayType (i ::> tp) tp)
a Assignment (SymExpr sym) (i ::> tp)
i     -> forall sym (idx :: Ctx BaseType) (tp :: BaseType) (b :: BaseType).
IsExprBuilder sym =>
sym
-> SymArray sym (idx ::> tp) b
-> Assignment (SymExpr sym) (idx ::> tp)
-> IO (SymExpr sym b)
arrayLookup sym
sym SymExpr sym (BaseArrayType (i ::> tp) tp)
a Assignment (SymExpr sym) (i ::> tp)
i
    UpdateArray BaseTypeRepr b
_ Assignment BaseTypeRepr (i ::> tp)
_ SymExpr sym ('BaseArrayType (i ::> tp) b)
a Assignment (SymExpr sym) (i ::> tp)
i SymExpr sym b
v -> forall sym (idx :: Ctx BaseType) (tp :: BaseType) (b :: BaseType).
IsExprBuilder sym =>
sym
-> SymArray sym (idx ::> tp) b
-> Assignment (SymExpr sym) (idx ::> tp)
-> SymExpr sym b
-> IO (SymArray sym (idx ::> tp) b)
arrayUpdate sym
sym SymExpr sym ('BaseArrayType (i ::> tp) b)
a Assignment (SymExpr sym) (i ::> tp)
i SymExpr sym b
v
    CopyArray NatRepr w
_ BaseTypeRepr a
_ SymExpr sym ('BaseArrayType (SingleCtx (BaseBVType w)) a)
dest_arr SymExpr sym (BaseBVType w)
dest_idx SymExpr sym ('BaseArrayType (SingleCtx (BaseBVType w)) a)
src_arr SymExpr sym (BaseBVType w)
src_idx SymExpr sym (BaseBVType w)
len SymExpr sym (BaseBVType w)
_ SymExpr sym (BaseBVType w)
_ ->
      forall sym (w :: Natural) (a :: BaseType).
(IsExprBuilder sym, 1 <= w) =>
sym
-> SymArray sym (SingleCtx (BaseBVType w)) a
-> SymBV sym w
-> SymArray sym (SingleCtx (BaseBVType w)) a
-> SymBV sym w
-> SymBV sym w
-> IO (SymArray sym (SingleCtx (BaseBVType w)) a)
arrayCopy sym
sym SymExpr sym ('BaseArrayType (SingleCtx (BaseBVType w)) a)
dest_arr SymExpr sym (BaseBVType w)
dest_idx SymExpr sym ('BaseArrayType (SingleCtx (BaseBVType w)) a)
src_arr SymExpr sym (BaseBVType w)
src_idx SymExpr sym (BaseBVType w)
len
    SetArray NatRepr w
_ BaseTypeRepr a
_ SymExpr sym ('BaseArrayType (SingleCtx (BaseBVType w)) a)
arr SymExpr sym (BaseBVType w)
idx SymExpr sym a
val SymExpr sym (BaseBVType w)
len SymExpr sym (BaseBVType w)
_ -> forall sym (w :: Natural) (a :: BaseType).
(IsExprBuilder sym, 1 <= w) =>
sym
-> SymArray sym (SingleCtx (BaseBVType w)) a
-> SymBV sym w
-> SymExpr sym a
-> SymBV sym w
-> IO (SymArray sym (SingleCtx (BaseBVType w)) a)
arraySet sym
sym SymExpr sym ('BaseArrayType (SingleCtx (BaseBVType w)) a)
arr SymExpr sym (BaseBVType w)
idx SymExpr sym a
val SymExpr sym (BaseBVType w)
len
    EqualArrayRange NatRepr w
_ BaseTypeRepr a
_ SymExpr sym (BaseArrayType (SingleCtx (BaseBVType w)) a)
x_arr SymExpr sym (BaseBVType w)
x_idx SymExpr sym (BaseArrayType (SingleCtx (BaseBVType w)) a)
y_arr SymExpr sym (BaseBVType w)
y_idx SymExpr sym (BaseBVType w)
len SymExpr sym (BaseBVType w)
_ SymExpr sym (BaseBVType w)
_ ->
      forall sym (w :: Natural) (a :: BaseType).
(IsExprBuilder sym, 1 <= w) =>
sym
-> SymArray sym (SingleCtx (BaseBVType w)) a
-> SymBV sym w
-> SymArray sym (SingleCtx (BaseBVType w)) a
-> SymBV sym w
-> SymBV sym w
-> IO (Pred sym)
arrayRangeEq sym
sym SymExpr sym (BaseArrayType (SingleCtx (BaseBVType w)) a)
x_arr SymExpr sym (BaseBVType w)
x_idx SymExpr sym (BaseArrayType (SingleCtx (BaseBVType w)) a)
y_arr SymExpr sym (BaseBVType w)
y_idx SymExpr sym (BaseBVType w)
len

    IntegerToReal SymExpr sym BaseIntegerType
x -> forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> IO (SymReal sym)
integerToReal sym
sym SymExpr sym BaseIntegerType
x
    RealToInteger SymExpr sym BaseRealType
x -> forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> IO (SymInteger sym)
realToInteger sym
sym SymExpr sym BaseRealType
x

    BVToInteger SymExpr sym (BaseBVType w)
x   -> forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> IO (SymInteger sym)
bvToInteger sym
sym SymExpr sym (BaseBVType w)
x
    SBVToInteger SymExpr sym (BaseBVType w)
x  -> forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> IO (SymInteger sym)
sbvToInteger sym
sym SymExpr sym (BaseBVType w)
x
    IntegerToBV SymExpr sym BaseIntegerType
x NatRepr w
w -> forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymInteger sym -> NatRepr w -> IO (SymBV sym w)
integerToBV sym
sym SymExpr sym BaseIntegerType
x NatRepr w
w

    RoundReal SymExpr sym BaseRealType
x -> forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> IO (SymInteger sym)
realRound sym
sym SymExpr sym BaseRealType
x
    RoundEvenReal SymExpr sym BaseRealType
x -> forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> IO (SymInteger sym)
realRoundEven sym
sym SymExpr sym BaseRealType
x
    FloorReal SymExpr sym BaseRealType
x -> forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> IO (SymInteger sym)
realFloor sym
sym SymExpr sym BaseRealType
x
    CeilReal  SymExpr sym BaseRealType
x -> forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> IO (SymInteger sym)
realCeil sym
sym SymExpr sym BaseRealType
x

    Cplx Complex (SymExpr sym BaseRealType)
c     -> forall sym.
IsExprBuilder sym =>
sym -> Complex (SymReal sym) -> IO (SymCplx sym)
mkComplex sym
sym Complex (SymExpr sym BaseRealType)
c
    RealPart SymExpr sym BaseComplexType
x -> forall sym.
IsExprBuilder sym =>
sym -> SymCplx sym -> IO (SymReal sym)
getRealPart sym
sym SymExpr sym BaseComplexType
x
    ImagPart SymExpr sym BaseComplexType
x -> forall sym.
IsExprBuilder sym =>
sym -> SymCplx sym -> IO (SymReal sym)
getImagPart sym
sym SymExpr sym BaseComplexType
x

    StringIndexOf SymExpr sym (BaseStringType si)
x SymExpr sym (BaseStringType si)
y SymExpr sym BaseIntegerType
k -> forall sym (si :: StringInfo).
IsExprBuilder sym =>
sym
-> SymString sym si
-> SymString sym si
-> SymInteger sym
-> IO (SymInteger sym)
stringIndexOf sym
sym SymExpr sym (BaseStringType si)
x SymExpr sym (BaseStringType si)
y SymExpr sym BaseIntegerType
k
    StringContains SymExpr sym (BaseStringType si)
x SymExpr sym (BaseStringType si)
y -> forall sym (si :: StringInfo).
IsExprBuilder sym =>
sym -> SymString sym si -> SymString sym si -> IO (Pred sym)
stringContains sym
sym SymExpr sym (BaseStringType si)
x SymExpr sym (BaseStringType si)
y
    StringIsPrefixOf SymExpr sym (BaseStringType si)
x SymExpr sym (BaseStringType si)
y -> forall sym (si :: StringInfo).
IsExprBuilder sym =>
sym -> SymString sym si -> SymString sym si -> IO (Pred sym)
stringIsPrefixOf sym
sym SymExpr sym (BaseStringType si)
x SymExpr sym (BaseStringType si)
y
    StringIsSuffixOf SymExpr sym (BaseStringType si)
x SymExpr sym (BaseStringType si)
y -> forall sym (si :: StringInfo).
IsExprBuilder sym =>
sym -> SymString sym si -> SymString sym si -> IO (Pred sym)
stringIsSuffixOf sym
sym SymExpr sym (BaseStringType si)
x SymExpr sym (BaseStringType si)
y
    StringSubstring StringInfoRepr si
_ SymExpr sym ('BaseStringType si)
x SymExpr sym BaseIntegerType
off SymExpr sym BaseIntegerType
len -> forall sym (si :: StringInfo).
IsExprBuilder sym =>
sym
-> SymString sym si
-> SymInteger sym
-> SymInteger sym
-> IO (SymString sym si)
stringSubstring sym
sym SymExpr sym ('BaseStringType si)
x SymExpr sym BaseIntegerType
off SymExpr sym BaseIntegerType
len

    StringAppend StringInfoRepr si
si StringSeq (SymExpr sym) si
xs ->
       do SymExpr sym ('BaseStringType si)
e <- forall sym (si :: StringInfo).
IsExprBuilder sym =>
sym -> StringInfoRepr si -> IO (SymString sym si)
stringEmpty sym
sym StringInfoRepr si
si
          let f :: SymExpr sym ('BaseStringType si)
-> StringSeqEntry (SymExpr sym) si
-> IO (SymExpr sym ('BaseStringType si))
f SymExpr sym ('BaseStringType si)
x (SSeq.StringSeqLiteral StringLiteral si
l) = forall sym (si :: StringInfo).
IsExprBuilder sym =>
sym
-> SymString sym si -> SymString sym si -> IO (SymString sym si)
stringConcat sym
sym SymExpr sym ('BaseStringType si)
x forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall sym (si :: StringInfo).
IsExprBuilder sym =>
sym -> StringLiteral si -> IO (SymString sym si)
stringLit sym
sym StringLiteral si
l
              f SymExpr sym ('BaseStringType si)
x (SSeq.StringSeqTerm SymExpr sym ('BaseStringType si)
y) = forall sym (si :: StringInfo).
IsExprBuilder sym =>
sym
-> SymString sym si -> SymString sym si -> IO (SymString sym si)
stringConcat sym
sym SymExpr sym ('BaseStringType si)
x SymExpr sym ('BaseStringType si)
y
          forall (t :: Type -> Type) (m :: Type -> Type) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM SymExpr sym ('BaseStringType si)
-> StringSeqEntry (SymExpr sym) si
-> IO (SymExpr sym ('BaseStringType si))
f SymExpr sym ('BaseStringType si)
e (forall (e :: BaseType -> Type) (si :: StringInfo).
StringSeq e si -> [StringSeqEntry e si]
SSeq.toList StringSeq (SymExpr sym) si
xs)

    StringLength SymExpr sym (BaseStringType si)
x -> forall sym (si :: StringInfo).
IsExprBuilder sym =>
sym -> SymString sym si -> IO (SymInteger sym)
stringLength sym
sym SymExpr sym (BaseStringType si)
x

    StructCtor Assignment BaseTypeRepr flds
_ Assignment (SymExpr sym) flds
args -> forall sym (flds :: Ctx BaseType).
IsExprBuilder sym =>
sym -> Assignment (SymExpr sym) flds -> IO (SymStruct sym flds)
mkStruct sym
sym Assignment (SymExpr sym) flds
args
    StructField SymExpr sym (BaseStructType flds)
s Index flds tp
i BaseTypeRepr tp
_ -> forall sym (flds :: Ctx BaseType) (tp :: BaseType).
IsExprBuilder sym =>
sym -> SymStruct sym flds -> Index flds tp -> IO (SymExpr sym tp)
structField sym
sym SymExpr sym (BaseStructType flds)
s Index flds tp
i

------------------------------------------------------------------------
-- App operations


ppVar :: String -> SolverSymbol -> Nonce t tp -> BaseTypeRepr tp -> String
ppVar :: forall t (tp :: BaseType).
[Char] -> SolverSymbol -> Nonce t tp -> BaseTypeRepr tp -> [Char]
ppVar [Char]
pr SolverSymbol
sym Nonce t tp
i BaseTypeRepr tp
tp = [Char]
pr forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show SolverSymbol
sym forall a. [a] -> [a] -> [a]
++ [Char]
"@" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall k s (tp :: k). Nonce s tp -> Word64
indexValue Nonce t tp
i) forall a. [a] -> [a] -> [a]
++ [Char]
":" forall a. [a] -> [a] -> [a]
++ forall (tp :: BaseType). BaseTypeRepr tp -> [Char]
ppVarTypeCode BaseTypeRepr tp
tp

ppBoundVar :: ExprBoundVar t tp -> String
ppBoundVar :: forall t (tp :: BaseType). ExprBoundVar t tp -> [Char]
ppBoundVar ExprBoundVar t tp
v =
  case forall t (tp :: BaseType). ExprBoundVar t tp -> VarKind
bvarKind ExprBoundVar t tp
v of
    VarKind
QuantifierVarKind -> forall t (tp :: BaseType).
[Char] -> SolverSymbol -> Nonce t tp -> BaseTypeRepr tp -> [Char]
ppVar [Char]
"?" (forall t (tp :: BaseType). ExprBoundVar t tp -> SolverSymbol
bvarName ExprBoundVar t tp
v) (forall t (tp :: BaseType). ExprBoundVar t tp -> Nonce t tp
bvarId ExprBoundVar t tp
v) (forall t (tp :: BaseType). ExprBoundVar t tp -> BaseTypeRepr tp
bvarType ExprBoundVar t tp
v)
    VarKind
LatchVarKind   -> forall t (tp :: BaseType).
[Char] -> SolverSymbol -> Nonce t tp -> BaseTypeRepr tp -> [Char]
ppVar [Char]
"l" (forall t (tp :: BaseType). ExprBoundVar t tp -> SolverSymbol
bvarName ExprBoundVar t tp
v) (forall t (tp :: BaseType). ExprBoundVar t tp -> Nonce t tp
bvarId ExprBoundVar t tp
v) (forall t (tp :: BaseType). ExprBoundVar t tp -> BaseTypeRepr tp
bvarType ExprBoundVar t tp
v)
    VarKind
UninterpVarKind -> forall t (tp :: BaseType).
[Char] -> SolverSymbol -> Nonce t tp -> BaseTypeRepr tp -> [Char]
ppVar [Char]
"c" (forall t (tp :: BaseType). ExprBoundVar t tp -> SolverSymbol
bvarName ExprBoundVar t tp
v) (forall t (tp :: BaseType). ExprBoundVar t tp -> Nonce t tp
bvarId ExprBoundVar t tp
v) (forall t (tp :: BaseType). ExprBoundVar t tp -> BaseTypeRepr tp
bvarType ExprBoundVar t tp
v)

instance Show (ExprBoundVar t tp) where
  show :: ExprBoundVar t tp -> [Char]
show = forall t (tp :: BaseType). ExprBoundVar t tp -> [Char]
ppBoundVar

instance ShowF (ExprBoundVar t)


-- | Pretty print a code to identify the type of constant.
ppVarTypeCode :: BaseTypeRepr tp -> String
ppVarTypeCode :: forall (tp :: BaseType). BaseTypeRepr tp -> [Char]
ppVarTypeCode BaseTypeRepr tp
tp =
  case BaseTypeRepr tp
tp of
    BaseTypeRepr tp
BaseBoolRepr    -> [Char]
"b"
    BaseBVRepr NatRepr w
_    -> [Char]
"bv"
    BaseTypeRepr tp
BaseIntegerRepr -> [Char]
"i"
    BaseTypeRepr tp
BaseRealRepr    -> [Char]
"r"
    BaseFloatRepr FloatPrecisionRepr fpp
_ -> [Char]
"f"
    BaseStringRepr StringInfoRepr si
_ -> [Char]
"s"
    BaseTypeRepr tp
BaseComplexRepr -> [Char]
"c"
    BaseArrayRepr Assignment BaseTypeRepr (idx ::> tp)
_ BaseTypeRepr xs
_ -> [Char]
"a"
    BaseStructRepr Assignment BaseTypeRepr ctx
_ -> [Char]
"struct"

-- | Either a argument or text or text
data PrettyArg (e :: BaseType -> Type) where
  PrettyArg  :: e tp -> PrettyArg e
  PrettyText :: Text -> PrettyArg e
  PrettyFunc :: Text -> [PrettyArg e] -> PrettyArg e

exprPrettyArg :: e tp -> PrettyArg e
exprPrettyArg :: forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e tp
e = forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
PrettyArg e tp
e

exprPrettyIndices :: Ctx.Assignment e ctx -> [PrettyArg e]
exprPrettyIndices :: forall (e :: BaseType -> Type) (ctx :: Ctx BaseType).
Assignment e ctx -> [PrettyArg e]
exprPrettyIndices = forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type) a.
FoldableFC t =>
(forall (x :: k). f x -> a) -> forall (x :: l). t f x -> [a]
toListFC forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg

stringPrettyArg :: String -> PrettyArg e
stringPrettyArg :: forall (e :: BaseType -> Type). [Char] -> PrettyArg e
stringPrettyArg [Char]
x = forall (e :: BaseType -> Type). Text -> PrettyArg e
PrettyText forall a b. (a -> b) -> a -> b
$! [Char] -> Text
Text.pack [Char]
x

showPrettyArg :: Show a => a -> PrettyArg e
showPrettyArg :: forall a (e :: BaseType -> Type). Show a => a -> PrettyArg e
showPrettyArg a
x = forall (e :: BaseType -> Type). [Char] -> PrettyArg e
stringPrettyArg forall a b. (a -> b) -> a -> b
$! forall a. Show a => a -> [Char]
show a
x

type PrettyApp e = (Text, [PrettyArg e])

prettyApp :: Text -> [PrettyArg e] -> PrettyApp e
prettyApp :: forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
nm [PrettyArg e]
args = (Text
nm, [PrettyArg e]
args)

ppNonceApp :: forall m t e tp
           . Applicative m
           => (forall ctx r . ExprSymFn t ctx r -> m (PrettyArg e))
           -> NonceApp t e tp
           -> m (PrettyApp e)
ppNonceApp :: forall (m :: Type -> Type) t (e :: BaseType -> Type)
       (tp :: BaseType).
Applicative m =>
(forall (ctx :: Ctx BaseType) (r :: BaseType).
 ExprSymFn t ctx r -> m (PrettyArg e))
-> NonceApp t e tp -> m (PrettyApp e)
ppNonceApp forall (ctx :: Ctx BaseType) (r :: BaseType).
ExprSymFn t ctx r -> m (PrettyArg e)
ppFn NonceApp t e tp
a0 = do
  case NonceApp t e tp
a0 of
    Annotation BaseTypeRepr tp
_ Nonce t tp
n e tp
x -> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"annotation" [ forall a (e :: BaseType -> Type). Show a => a -> PrettyArg e
showPrettyArg Nonce t tp
n, forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e tp
x ]
    Forall ExprBoundVar t tp
v e BaseBoolType
x -> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"forall" [ forall (e :: BaseType -> Type). [Char] -> PrettyArg e
stringPrettyArg (forall t (tp :: BaseType). ExprBoundVar t tp -> [Char]
ppBoundVar ExprBoundVar t tp
v), forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e BaseBoolType
x ]
    Exists ExprBoundVar t tp
v e BaseBoolType
x -> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"exists" [ forall (e :: BaseType -> Type). [Char] -> PrettyArg e
stringPrettyArg (forall t (tp :: BaseType). ExprBoundVar t tp -> [Char]
ppBoundVar ExprBoundVar t tp
v), forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e BaseBoolType
x ]
    ArrayFromFn ExprSymFn t (idx ::> itp) ret
f -> forall {e :: BaseType -> Type}. PrettyArg e -> PrettyApp e
resolve forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (ctx :: Ctx BaseType) (r :: BaseType).
ExprSymFn t ctx r -> m (PrettyArg e)
ppFn ExprSymFn t (idx ::> itp) ret
f
      where resolve :: PrettyArg e -> PrettyApp e
resolve PrettyArg e
f_nm = forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"arrayFromFn" [ PrettyArg e
f_nm ]
    MapOverArrays ExprSymFn t (ctx ::> d) r
f Assignment BaseTypeRepr (idx ::> itp)
_ Assignment (ArrayResultWrapper e (idx ::> itp)) (ctx ::> d)
args -> PrettyArg e -> PrettyApp e
resolve forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (ctx :: Ctx BaseType) (r :: BaseType).
ExprSymFn t ctx r -> m (PrettyArg e)
ppFn ExprSymFn t (ctx ::> d) r
f
      where resolve :: PrettyArg e -> PrettyApp e
resolve PrettyArg e
f_nm = forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"mapArray" (PrettyArg e
f_nm forall a. a -> [a] -> [a]
: [PrettyArg e]
arg_nms)
            arg_nms :: [PrettyArg e]
arg_nms = forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type) a.
FoldableFC t =>
(forall (x :: k). f x -> a) -> forall (x :: l). t f x -> [a]
toListFC (\(ArrayResultWrapper e (BaseArrayType (idx ::> itp) x)
a) -> forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e (BaseArrayType (idx ::> itp) x)
a) Assignment (ArrayResultWrapper e (idx ::> itp)) (ctx ::> d)
args
    ArrayTrueOnEntries ExprSymFn t (idx ::> itp) BaseBoolType
f e (BaseArrayType (idx ::> itp) BaseBoolType)
a -> PrettyArg e -> PrettyApp e
resolve forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (ctx :: Ctx BaseType) (r :: BaseType).
ExprSymFn t ctx r -> m (PrettyArg e)
ppFn ExprSymFn t (idx ::> itp) BaseBoolType
f
      where resolve :: PrettyArg e -> PrettyApp e
resolve PrettyArg e
f_nm = forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"arrayTrueOnEntries" [ PrettyArg e
f_nm, PrettyArg e
a_nm ]
            a_nm :: PrettyArg e
a_nm = forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e (BaseArrayType (idx ::> itp) BaseBoolType)
a
    FnApp ExprSymFn t args tp
f Assignment e args
a -> PrettyArg e -> PrettyApp e
resolve forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (ctx :: Ctx BaseType) (r :: BaseType).
ExprSymFn t ctx r -> m (PrettyArg e)
ppFn ExprSymFn t args tp
f
      where resolve :: PrettyArg e -> PrettyApp e
resolve PrettyArg e
f_nm = forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"apply" (PrettyArg e
f_nm forall a. a -> [a] -> [a]
: forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type) a.
FoldableFC t =>
(forall (x :: k). f x -> a) -> forall (x :: l). t f x -> [a]
toListFC forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg Assignment e args
a)

instance ShowF e => Pretty (App e u) where
  pretty :: forall ann. App e u -> Doc ann
pretty App e u
a = forall a ann. Pretty a => a -> Doc ann
pretty Text
nm forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. [Doc ann] -> Doc ann
sep (forall ann. PrettyArg e -> Doc ann
ppArg forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [PrettyArg e]
args)
    where (Text
nm, [PrettyArg e]
args) = forall (e :: BaseType -> Type) (u :: BaseType).
App e u -> PrettyApp e
ppApp' App e u
a
          ppArg :: PrettyArg e -> Doc ann
          ppArg :: forall ann. PrettyArg e -> Doc ann
ppArg (PrettyArg e tp
e) = forall a ann. Pretty a => a -> Doc ann
pretty (forall k (f :: k -> Type) (tp :: k). ShowF f => f tp -> [Char]
showF e tp
e)
          ppArg (PrettyText Text
txt) = forall a ann. Pretty a => a -> Doc ann
pretty Text
txt
          ppArg (PrettyFunc Text
fnm [PrettyArg e]
fargs) = forall ann. Doc ann -> Doc ann
parens (forall a ann. Pretty a => a -> Doc ann
pretty Text
fnm forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. [Doc ann] -> Doc ann
sep (forall ann. PrettyArg e -> Doc ann
ppArg forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [PrettyArg e]
fargs))

instance ShowF e => Show (App e u) where
  show :: App e u -> [Char]
show = forall a. Show a => a -> [Char]
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty

ppApp' :: forall e u . App e u -> PrettyApp e
ppApp' :: forall (e :: BaseType -> Type) (u :: BaseType).
App e u -> PrettyApp e
ppApp' App e u
a0 = do
  let ppSExpr :: Text -> [e x] -> PrettyApp e
      ppSExpr :: forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
f [e x]
l = forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
f (forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [e x]
l)

  case App e u
a0 of
    BaseIte BaseTypeRepr u
_ Integer
_ e BaseBoolType
c e u
x e u
y -> forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"ite" [forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e BaseBoolType
c, forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e u
x, forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e u
y]
    BaseEq BaseTypeRepr tp
_ e tp
x e tp
y -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"eq" [e tp
x, e tp
y]

    NotPred e BaseBoolType
x -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"not" [e BaseBoolType
x]

    ConjPred BoolMap e
xs ->
      let pol :: (e tp, Polarity) -> PrettyArg e
pol (e tp
x,Polarity
Positive) = forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e tp
x
          pol (e tp
x,Polarity
Negative) = forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyArg e
PrettyFunc Text
"not" [ forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e tp
x ]
       in
       case forall (f :: BaseType -> Type). BoolMap f -> BoolMapView f
BM.viewBoolMap BoolMap e
xs of
         BoolMapView e
BoolMapUnit      -> forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"true" []
         BoolMapView e
BoolMapDualUnit  -> forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"false" []
         BoolMapTerms NonEmpty (e BaseBoolType, Polarity)
tms -> forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"and" (forall a b. (a -> b) -> [a] -> [b]
map forall {e :: BaseType -> Type} {tp :: BaseType}.
(e tp, Polarity) -> PrettyArg e
pol (forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList NonEmpty (e BaseBoolType, Polarity)
tms))

    RealIsInteger e BaseRealType
x -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"isInteger" [e BaseRealType
x]
    BVTestBit Natural
i e (BaseBVType w)
x   -> forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"testBit"  [forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e (BaseBVType w)
x, forall a (e :: BaseType -> Type). Show a => a -> PrettyArg e
showPrettyArg Natural
i]
    BVUlt e (BaseBVType w)
x e (BaseBVType w)
y -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"bvUlt" [e (BaseBVType w)
x, e (BaseBVType w)
y]
    BVSlt e (BaseBVType w)
x e (BaseBVType w)
y -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"bvSlt" [e (BaseBVType w)
x, e (BaseBVType w)
y]

    IntAbs e BaseIntegerType
x   -> forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"intAbs" [forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e BaseIntegerType
x]
    IntDiv e BaseIntegerType
x e BaseIntegerType
y -> forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"intDiv" [forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e BaseIntegerType
x, forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e BaseIntegerType
y]
    IntMod e BaseIntegerType
x e BaseIntegerType
y -> forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"intMod" [forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e BaseIntegerType
x, forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e BaseIntegerType
y]
    IntDivisible e BaseIntegerType
x Natural
k -> forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"intDivisible" [forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e BaseIntegerType
x, forall a (e :: BaseType -> Type). Show a => a -> PrettyArg e
showPrettyArg Natural
k]

    SemiRingLe OrderedSemiRingRepr sr
sr e (SemiRingBase sr)
x e (SemiRingBase sr)
y ->
      case OrderedSemiRingRepr sr
sr of
        OrderedSemiRingRepr sr
SR.OrderedSemiRingRealRepr    -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"realLe" [e (SemiRingBase sr)
x, e (SemiRingBase sr)
y]
        OrderedSemiRingRepr sr
SR.OrderedSemiRingIntegerRepr -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"intLe" [e (SemiRingBase sr)
x, e (SemiRingBase sr)
y]

    SemiRingSum WeightedSum e sr
s ->
      case forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> SemiRingRepr sr
WSum.sumRepr WeightedSum e sr
s of
        SemiRingRepr sr
SR.SemiRingRealRepr -> forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"realSum" (forall r (sr :: SemiRing) (f :: BaseType -> Type).
(r -> r -> r)
-> (Coefficient sr -> f (SemiRingBase sr) -> r)
-> (Coefficient sr -> r)
-> WeightedSum f sr
-> r
WSum.eval forall a. [a] -> [a] -> [a]
(++) forall {a} {e :: BaseType -> Type} {tp :: BaseType}.
(Integral a, Show a) =>
Ratio a -> e tp -> [PrettyArg e]
ppEntry forall {a} {e :: BaseType -> Type}.
(Integral a, Show a) =>
Ratio a -> [PrettyArg e]
ppConstant WeightedSum e sr
s)
          where ppConstant :: Ratio a -> [PrettyArg e]
ppConstant Ratio a
0 = []
                ppConstant Ratio a
c = [ forall (e :: BaseType -> Type). [Char] -> PrettyArg e
stringPrettyArg (forall {a}. (Eq a, Num a, Show a) => Ratio a -> [Char]
ppRat Ratio a
c) ]
                ppEntry :: Ratio a -> e tp -> [PrettyArg e]
ppEntry Ratio a
1 e tp
e  = [ forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e tp
e ]
                ppEntry Ratio a
sm e tp
e = [ forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyArg e
PrettyFunc Text
"realAdd" [forall (e :: BaseType -> Type). [Char] -> PrettyArg e
stringPrettyArg (forall {a}. (Eq a, Num a, Show a) => Ratio a -> [Char]
ppRat Ratio a
sm), forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e tp
e ] ]
                ppRat :: Ratio a -> [Char]
ppRat Ratio a
r | a
d forall a. Eq a => a -> a -> Bool
== a
1 = forall a. Show a => a -> [Char]
show a
n
                        | Bool
otherwise = [Char]
"(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
n forall a. [a] -> [a] -> [a]
++ [Char]
"/" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
d forall a. [a] -> [a] -> [a]
++ [Char]
")"
                     where n :: a
n = forall a. Ratio a -> a
numerator Ratio a
r
                           d :: a
d = forall a. Ratio a -> a
denominator Ratio a
r

        SemiRingRepr sr
SR.SemiRingIntegerRepr -> forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"intSum" (forall r (sr :: SemiRing) (f :: BaseType -> Type).
(r -> r -> r)
-> (Coefficient sr -> f (SemiRingBase sr) -> r)
-> (Coefficient sr -> r)
-> WeightedSum f sr
-> r
WSum.eval forall a. [a] -> [a] -> [a]
(++) forall {a} {e :: BaseType -> Type} {tp :: BaseType}.
(Eq a, Num a, Show a) =>
a -> e tp -> [PrettyArg e]
ppEntry forall {a} {e :: BaseType -> Type}.
(Eq a, Num a, Show a) =>
a -> [PrettyArg e]
ppConstant WeightedSum e sr
s)
          where ppConstant :: a -> [PrettyArg e]
ppConstant a
0 = []
                ppConstant a
c = [ forall (e :: BaseType -> Type). [Char] -> PrettyArg e
stringPrettyArg (forall a. Show a => a -> [Char]
show a
c) ]
                ppEntry :: a -> e tp -> [PrettyArg e]
ppEntry a
1 e tp
e  = [ forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e tp
e ]
                ppEntry a
sm e tp
e = [ forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyArg e
PrettyFunc Text
"intMul" [forall (e :: BaseType -> Type). [Char] -> PrettyArg e
stringPrettyArg (forall a. Show a => a -> [Char]
show a
sm), forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e tp
e ] ]

        SR.SemiRingBVRepr BVFlavorRepr fv
SR.BVArithRepr NatRepr w
w -> forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"bvSum" (forall r (sr :: SemiRing) (f :: BaseType -> Type).
(r -> r -> r)
-> (Coefficient sr -> f (SemiRingBase sr) -> r)
-> (Coefficient sr -> r)
-> WeightedSum f sr
-> r
WSum.eval forall a. [a] -> [a] -> [a]
(++) BV w -> e (BaseBVType w) -> [PrettyArg e]
ppEntry BV w -> [PrettyArg e]
ppConstant WeightedSum e sr
s)
          where ppConstant :: BV w -> [PrettyArg e]
ppConstant (BV.BV Integer
0) = []
                ppConstant BV w
c = [ forall (e :: BaseType -> Type). [Char] -> PrettyArg e
stringPrettyArg (BV w -> [Char]
ppBV BV w
c) ]
                ppEntry :: BV w -> e (BaseBVType w) -> [PrettyArg e]
ppEntry BV w
sm e (BaseBVType w)
e
                  | BV w
sm forall a. Eq a => a -> a -> Bool
== forall (w :: Natural). (1 <= w) => NatRepr w -> BV w
BV.one NatRepr w
w = [ forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e (BaseBVType w)
e ]
                  | Bool
otherwise = [ forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyArg e
PrettyFunc Text
"bvMul" [ forall (e :: BaseType -> Type). [Char] -> PrettyArg e
stringPrettyArg (BV w -> [Char]
ppBV BV w
sm), forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e (BaseBVType w)
e ] ]
                ppBV :: BV w -> [Char]
ppBV = forall (w :: Natural). NatRepr w -> BV w -> [Char]
BV.ppHex NatRepr w
w

        SR.SemiRingBVRepr BVFlavorRepr fv
SR.BVBitsRepr NatRepr w
w -> forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"bvXor" (forall r (sr :: SemiRing) (f :: BaseType -> Type).
(r -> r -> r)
-> (Coefficient sr -> f (SemiRingBase sr) -> r)
-> (Coefficient sr -> r)
-> WeightedSum f sr
-> r
WSum.eval forall a. [a] -> [a] -> [a]
(++) BV w -> e (BaseBVType w) -> [PrettyArg e]
ppEntry BV w -> [PrettyArg e]
ppConstant WeightedSum e sr
s)
          where ppConstant :: BV w -> [PrettyArg e]
ppConstant (BV.BV Integer
0) = []
                ppConstant BV w
c = [ forall (e :: BaseType -> Type). [Char] -> PrettyArg e
stringPrettyArg (BV w -> [Char]
ppBV BV w
c) ]
                ppEntry :: BV w -> e (BaseBVType w) -> [PrettyArg e]
ppEntry BV w
sm e (BaseBVType w)
e
                  | BV w
sm forall a. Eq a => a -> a -> Bool
== forall (w :: Natural). NatRepr w -> BV w
BV.maxUnsigned NatRepr w
w = [ forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e (BaseBVType w)
e ]
                  | Bool
otherwise = [ forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyArg e
PrettyFunc Text
"bvAnd" [ forall (e :: BaseType -> Type). [Char] -> PrettyArg e
stringPrettyArg (BV w -> [Char]
ppBV BV w
sm), forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e (BaseBVType w)
e ] ]
                ppBV :: BV w -> [Char]
ppBV = forall (w :: Natural). NatRepr w -> BV w -> [Char]
BV.ppHex NatRepr w
w

    SemiRingProd SemiRingProduct e sr
pd ->
      case forall (f :: BaseType -> Type) (sr :: SemiRing).
SemiRingProduct f sr -> SemiRingRepr sr
WSum.prodRepr SemiRingProduct e sr
pd of
        SemiRingRepr sr
SR.SemiRingRealRepr ->
          forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"realProd" forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe [] (forall r (f :: BaseType -> Type) (sr :: SemiRing).
(r -> r -> r)
-> (f (SemiRingBase sr) -> r) -> SemiRingProduct f sr -> Maybe r
WSum.prodEval forall a. [a] -> [a] -> [a]
(++) ((forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg) SemiRingProduct e sr
pd)
        SemiRingRepr sr
SR.SemiRingIntegerRepr ->
          forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"intProd" forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe [] (forall r (f :: BaseType -> Type) (sr :: SemiRing).
(r -> r -> r)
-> (f (SemiRingBase sr) -> r) -> SemiRingProduct f sr -> Maybe r
WSum.prodEval forall a. [a] -> [a] -> [a]
(++) ((forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg) SemiRingProduct e sr
pd)
        SR.SemiRingBVRepr BVFlavorRepr fv
SR.BVArithRepr NatRepr w
_w ->
          forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"bvProd" forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe [] (forall r (f :: BaseType -> Type) (sr :: SemiRing).
(r -> r -> r)
-> (f (SemiRingBase sr) -> r) -> SemiRingProduct f sr -> Maybe r
WSum.prodEval forall a. [a] -> [a] -> [a]
(++) ((forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg) SemiRingProduct e sr
pd)
        SR.SemiRingBVRepr BVFlavorRepr fv
SR.BVBitsRepr NatRepr w
_w ->
          forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"bvAnd" forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe [] (forall r (f :: BaseType -> Type) (sr :: SemiRing).
(r -> r -> r)
-> (f (SemiRingBase sr) -> r) -> SemiRingProduct f sr -> Maybe r
WSum.prodEval forall a. [a] -> [a] -> [a]
(++) ((forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg) SemiRingProduct e sr
pd)


    RealDiv e BaseRealType
x e BaseRealType
y -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"divReal" [e BaseRealType
x, e BaseRealType
y]
    RealSqrt e BaseRealType
x  -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"sqrt" [e BaseRealType
x]

    RealSpecialFunction SpecialFunction args
fn (SFn.SpecialFnArgs Assignment (SpecialFnArg e BaseRealType) args
xs) ->
      forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp ([Char] -> Text
Text.pack (forall a. Show a => a -> [Char]
show SpecialFunction args
fn)) (forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type) a.
FoldableFC t =>
(forall (x :: k). f x -> a) -> forall (x :: l). t f x -> [a]
toListFC (\ (SFn.SpecialFnArg e BaseRealType
x) -> forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e BaseRealType
x) Assignment (SpecialFnArg e BaseRealType) args
xs)

    --------------------------------
    -- Bitvector operations

    BVUnaryTerm UnaryBV (e BaseBoolType) n
u -> forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"bvUnary" (forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap (Integer, e BaseBoolType) -> [PrettyArg e]
go forall a b. (a -> b) -> a -> b
$ forall (n :: Natural) p. (1 <= n) => UnaryBV p n -> [(Integer, p)]
UnaryBV.unsignedEntries UnaryBV (e BaseBoolType) n
u)
      where go :: (Integer, e BaseBoolType) -> [PrettyArg e]
            go :: (Integer, e BaseBoolType) -> [PrettyArg e]
go (Integer
k,e BaseBoolType
v) = [ forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e BaseBoolType
v, forall a (e :: BaseType -> Type). Show a => a -> PrettyArg e
showPrettyArg Integer
k ]
    BVOrBits NatRepr w
_ BVOrSet e w
bs -> forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"bvOr" forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg forall a b. (a -> b) -> a -> b
$ forall (e :: BaseType -> Type) (w :: Natural).
BVOrSet e w -> [e (BaseBVType w)]
bvOrToList BVOrSet e w
bs

    BVConcat NatRepr (u + v)
_ e (BaseBVType u)
x e (BaseBVType v)
y -> forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"bvConcat" [forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e (BaseBVType u)
x, forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e (BaseBVType v)
y]
    BVSelect NatRepr idx
idx NatRepr n
n e (BaseBVType w)
x -> forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"bvSelect" [forall a (e :: BaseType -> Type). Show a => a -> PrettyArg e
showPrettyArg NatRepr idx
idx, forall a (e :: BaseType -> Type). Show a => a -> PrettyArg e
showPrettyArg NatRepr n
n, forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e (BaseBVType w)
x]
    BVUdiv NatRepr w
_ e ('BaseBVType w)
x e ('BaseBVType w)
y -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"bvUdiv" [e ('BaseBVType w)
x, e ('BaseBVType w)
y]
    BVUrem NatRepr w
_ e ('BaseBVType w)
x e ('BaseBVType w)
y -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"bvUrem" [e ('BaseBVType w)
x, e ('BaseBVType w)
y]
    BVSdiv NatRepr w
_ e ('BaseBVType w)
x e ('BaseBVType w)
y -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"bvSdiv" [e ('BaseBVType w)
x, e ('BaseBVType w)
y]
    BVSrem NatRepr w
_ e ('BaseBVType w)
x e ('BaseBVType w)
y -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"bvSrem" [e ('BaseBVType w)
x, e ('BaseBVType w)
y]

    BVShl  NatRepr w
_ e ('BaseBVType w)
x e ('BaseBVType w)
y -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"bvShl" [e ('BaseBVType w)
x, e ('BaseBVType w)
y]
    BVLshr NatRepr w
_ e ('BaseBVType w)
x e ('BaseBVType w)
y -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"bvLshr" [e ('BaseBVType w)
x, e ('BaseBVType w)
y]
    BVAshr NatRepr w
_ e ('BaseBVType w)
x e ('BaseBVType w)
y -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"bvAshr" [e ('BaseBVType w)
x, e ('BaseBVType w)
y]
    BVRol  NatRepr w
_ e ('BaseBVType w)
x e ('BaseBVType w)
y -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"bvRol" [e ('BaseBVType w)
x, e ('BaseBVType w)
y]
    BVRor  NatRepr w
_ e ('BaseBVType w)
x e ('BaseBVType w)
y -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"bvRor" [e ('BaseBVType w)
x, e ('BaseBVType w)
y]

    BVZext NatRepr r
w e (BaseBVType w)
x -> forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"bvZext"   [forall a (e :: BaseType -> Type). Show a => a -> PrettyArg e
showPrettyArg NatRepr r
w, forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e (BaseBVType w)
x]
    BVSext NatRepr r
w e (BaseBVType w)
x -> forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"bvSext"   [forall a (e :: BaseType -> Type). Show a => a -> PrettyArg e
showPrettyArg NatRepr r
w, forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e (BaseBVType w)
x]
    BVFill NatRepr w
w e BaseBoolType
p -> forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"bvFill"   [forall a (e :: BaseType -> Type). Show a => a -> PrettyArg e
showPrettyArg NatRepr w
w, forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e BaseBoolType
p]

    BVPopcount NatRepr w
w e ('BaseBVType w)
x -> forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"bvPopcount" [forall a (e :: BaseType -> Type). Show a => a -> PrettyArg e
showPrettyArg NatRepr w
w, forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e ('BaseBVType w)
x]
    BVCountLeadingZeros NatRepr w
w e ('BaseBVType w)
x -> forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"bvCountLeadingZeros" [forall a (e :: BaseType -> Type). Show a => a -> PrettyArg e
showPrettyArg NatRepr w
w, forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e ('BaseBVType w)
x]
    BVCountTrailingZeros NatRepr w
w e ('BaseBVType w)
x -> forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"bvCountTrailingZeros" [forall a (e :: BaseType -> Type). Show a => a -> PrettyArg e
showPrettyArg NatRepr w
w, forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e ('BaseBVType w)
x]

    --------------------------------
    -- Float operations

    FloatNeg FloatPrecisionRepr fpp
_ e ('BaseFloatType fpp)
x -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"floatNeg" [e ('BaseFloatType fpp)
x]
    FloatAbs FloatPrecisionRepr fpp
_ e ('BaseFloatType fpp)
x -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"floatAbs" [e ('BaseFloatType fpp)
x]
    FloatSqrt FloatPrecisionRepr fpp
_ RoundingMode
r e ('BaseFloatType fpp)
x -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr ([Char] -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ [Char]
"floatSqrt " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show RoundingMode
r) [e ('BaseFloatType fpp)
x]
    FloatAdd FloatPrecisionRepr fpp
_ RoundingMode
r e ('BaseFloatType fpp)
x e ('BaseFloatType fpp)
y -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr ([Char] -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ [Char]
"floatAdd " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show RoundingMode
r) [e ('BaseFloatType fpp)
x, e ('BaseFloatType fpp)
y]
    FloatSub FloatPrecisionRepr fpp
_ RoundingMode
r e ('BaseFloatType fpp)
x e ('BaseFloatType fpp)
y -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr ([Char] -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ [Char]
"floatSub " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show RoundingMode
r) [e ('BaseFloatType fpp)
x, e ('BaseFloatType fpp)
y]
    FloatMul FloatPrecisionRepr fpp
_ RoundingMode
r e ('BaseFloatType fpp)
x e ('BaseFloatType fpp)
y -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr ([Char] -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ [Char]
"floatMul " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show RoundingMode
r) [e ('BaseFloatType fpp)
x, e ('BaseFloatType fpp)
y]
    FloatDiv FloatPrecisionRepr fpp
_ RoundingMode
r e ('BaseFloatType fpp)
x e ('BaseFloatType fpp)
y -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr ([Char] -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ [Char]
"floatDiv " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show RoundingMode
r) [e ('BaseFloatType fpp)
x, e ('BaseFloatType fpp)
y]
    FloatRem FloatPrecisionRepr fpp
_ e ('BaseFloatType fpp)
x e ('BaseFloatType fpp)
y -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"floatRem" [e ('BaseFloatType fpp)
x, e ('BaseFloatType fpp)
y]
    FloatFMA FloatPrecisionRepr fpp
_ RoundingMode
r e ('BaseFloatType fpp)
x e ('BaseFloatType fpp)
y e ('BaseFloatType fpp)
z -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr ([Char] -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ [Char]
"floatFMA " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show RoundingMode
r) [e ('BaseFloatType fpp)
x, e ('BaseFloatType fpp)
y, e ('BaseFloatType fpp)
z]
    FloatFpEq e (BaseFloatType fpp)
x e (BaseFloatType fpp)
y -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"floatFpEq" [e (BaseFloatType fpp)
x, e (BaseFloatType fpp)
y]
    FloatLe e (BaseFloatType fpp)
x e (BaseFloatType fpp)
y -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"floatLe" [e (BaseFloatType fpp)
x, e (BaseFloatType fpp)
y]
    FloatLt e (BaseFloatType fpp)
x e (BaseFloatType fpp)
y -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"floatLt" [e (BaseFloatType fpp)
x, e (BaseFloatType fpp)
y]
    FloatIsNaN e (BaseFloatType fpp)
x -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"floatIsNaN" [e (BaseFloatType fpp)
x]
    FloatIsInf e (BaseFloatType fpp)
x -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"floatIsInf" [e (BaseFloatType fpp)
x]
    FloatIsZero e (BaseFloatType fpp)
x -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"floatIsZero" [e (BaseFloatType fpp)
x]
    FloatIsPos e (BaseFloatType fpp)
x -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"floatIsPos" [e (BaseFloatType fpp)
x]
    FloatIsNeg e (BaseFloatType fpp)
x -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"floatIsNeg" [e (BaseFloatType fpp)
x]
    FloatIsSubnorm e (BaseFloatType fpp)
x -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"floatIsSubnorm" [e (BaseFloatType fpp)
x]
    FloatIsNorm e (BaseFloatType fpp)
x -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"floatIsNorm" [e (BaseFloatType fpp)
x]
    FloatCast FloatPrecisionRepr fpp
_ RoundingMode
r e (BaseFloatType fpp')
x -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr ([Char] -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ [Char]
"floatCast " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show RoundingMode
r) [e (BaseFloatType fpp')
x]
    FloatRound FloatPrecisionRepr fpp
_ RoundingMode
r e ('BaseFloatType fpp)
x -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr ([Char] -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ [Char]
"floatRound " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show RoundingMode
r) [e ('BaseFloatType fpp)
x]
    FloatFromBinary FloatPrecisionRepr (FloatingPointPrecision eb sb)
_ e (BaseBVType (eb + sb))
x -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"floatFromBinary" [e (BaseBVType (eb + sb))
x]
    FloatToBinary FloatPrecisionRepr (FloatingPointPrecision eb sb)
_ e (BaseFloatType (FloatingPointPrecision eb sb))
x -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"floatToBinary" [e (BaseFloatType (FloatingPointPrecision eb sb))
x]
    BVToFloat FloatPrecisionRepr fpp
_ RoundingMode
r e (BaseBVType w)
x -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr ([Char] -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ [Char]
"bvToFloat " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show RoundingMode
r) [e (BaseBVType w)
x]
    SBVToFloat FloatPrecisionRepr fpp
_ RoundingMode
r e (BaseBVType w)
x -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr ([Char] -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ [Char]
"sbvToFloat " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show RoundingMode
r) [e (BaseBVType w)
x]
    RealToFloat FloatPrecisionRepr fpp
_ RoundingMode
r e BaseRealType
x -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr ([Char] -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ [Char]
"realToFloat " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show RoundingMode
r) [e BaseRealType
x]
    FloatToBV NatRepr w
_ RoundingMode
r e (BaseFloatType fpp)
x -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr ([Char] -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ [Char]
"floatToBV " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show RoundingMode
r) [e (BaseFloatType fpp)
x]
    FloatToSBV NatRepr w
_ RoundingMode
r e (BaseFloatType fpp)
x -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr ([Char] -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ [Char]
"floatToSBV " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show RoundingMode
r) [e (BaseFloatType fpp)
x]
    FloatToReal e (BaseFloatType fpp)
x -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"floatToReal " [e (BaseFloatType fpp)
x]
    FloatSpecialFunction FloatPrecisionRepr fpp
_fpp SpecialFunction args
fn (SFn.SpecialFnArgs Assignment (SpecialFnArg e ('BaseFloatType fpp)) args
args) ->
      forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp ([Char] -> Text
Text.pack (forall a. Show a => a -> [Char]
show SpecialFunction args
fn)) (forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type) a.
FoldableFC t =>
(forall (x :: k). f x -> a) -> forall (x :: l). t f x -> [a]
toListFC (\ (SFn.SpecialFnArg e ('BaseFloatType fpp)
x) -> forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e ('BaseFloatType fpp)
x) Assignment (SpecialFnArg e ('BaseFloatType fpp)) args
args)

    -------------------------------------
    -- Arrays

    ArrayMap Assignment BaseTypeRepr (i ::> itp)
_ BaseTypeRepr tp
_ ArrayUpdateMap e (i ::> itp) tp
m e ('BaseArrayType (i ::> itp) tp)
d ->
        forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"arrayMap" (forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a} {e :: BaseType -> Type} {tp :: BaseType}.
Show a =>
(a, e tp) -> [PrettyArg e] -> [PrettyArg e]
ppEntry [forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e ('BaseArrayType (i ::> itp) tp)
d] (forall (e :: BaseType -> Type) (ctx :: Ctx BaseType)
       (tp :: BaseType).
ArrayUpdateMap e ctx tp -> [(Assignment IndexLit ctx, e tp)]
AUM.toList ArrayUpdateMap e (i ::> itp) tp
m))
      where ppEntry :: (a, e tp) -> [PrettyArg e] -> [PrettyArg e]
ppEntry (a
k,e tp
e) [PrettyArg e]
l = forall a (e :: BaseType -> Type). Show a => a -> PrettyArg e
showPrettyArg a
k forall a. a -> [a] -> [a]
: forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e tp
e forall a. a -> [a] -> [a]
: [PrettyArg e]
l
    ConstantArray Assignment BaseTypeRepr (i ::> tp)
_ BaseTypeRepr b
_ e b
v ->
      forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"constArray" [forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e b
v]
    SelectArray BaseTypeRepr u
_ e (BaseArrayType (i ::> tp) u)
a Assignment e (i ::> tp)
i ->
      forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"select" (forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e (BaseArrayType (i ::> tp) u)
a forall a. a -> [a] -> [a]
: forall (e :: BaseType -> Type) (ctx :: Ctx BaseType).
Assignment e ctx -> [PrettyArg e]
exprPrettyIndices Assignment e (i ::> tp)
i)
    UpdateArray BaseTypeRepr b
_ Assignment BaseTypeRepr (i ::> tp)
_ e ('BaseArrayType (i ::> tp) b)
a Assignment e (i ::> tp)
i e b
v ->
      forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"update" ([forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e ('BaseArrayType (i ::> tp) b)
a] forall a. [a] -> [a] -> [a]
++ forall (e :: BaseType -> Type) (ctx :: Ctx BaseType).
Assignment e ctx -> [PrettyArg e]
exprPrettyIndices Assignment e (i ::> tp)
i forall a. [a] -> [a] -> [a]
++ [forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e b
v])
    CopyArray NatRepr w
_ BaseTypeRepr a
_ e ('BaseArrayType (SingleCtx (BaseBVType w)) a)
dest_arr e (BaseBVType w)
dest_idx e ('BaseArrayType (SingleCtx (BaseBVType w)) a)
src_arr e (BaseBVType w)
src_idx e (BaseBVType w)
len e (BaseBVType w)
_ e (BaseBVType w)
_ ->
      forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp
        Text
"arrayCopy"
        [ forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e ('BaseArrayType (SingleCtx (BaseBVType w)) a)
dest_arr
        , forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e (BaseBVType w)
dest_idx
        , forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e ('BaseArrayType (SingleCtx (BaseBVType w)) a)
src_arr
        , forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e (BaseBVType w)
src_idx
        , forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e (BaseBVType w)
len
        ]
    SetArray NatRepr w
_ BaseTypeRepr a
_ e ('BaseArrayType (SingleCtx (BaseBVType w)) a)
arr e (BaseBVType w)
idx e a
val e (BaseBVType w)
len e (BaseBVType w)
_ ->
      forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp
        Text
"arraySet"
        [forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e ('BaseArrayType (SingleCtx (BaseBVType w)) a)
arr, forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e (BaseBVType w)
idx, forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e a
val, forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e (BaseBVType w)
len]
    EqualArrayRange NatRepr w
_ BaseTypeRepr a
_ e (BaseArrayType (SingleCtx (BaseBVType w)) a)
x_arr e (BaseBVType w)
x_idx e (BaseArrayType (SingleCtx (BaseBVType w)) a)
y_arr e (BaseBVType w)
y_idx e (BaseBVType w)
len e (BaseBVType w)
_ e (BaseBVType w)
_ ->
      forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp
        Text
"arrayRangeEq"
        [ forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e (BaseArrayType (SingleCtx (BaseBVType w)) a)
x_arr
        , forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e (BaseBVType w)
x_idx
        , forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e (BaseArrayType (SingleCtx (BaseBVType w)) a)
y_arr
        , forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e (BaseBVType w)
y_idx
        , forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e (BaseBVType w)
len
        ]

    ------------------------------------------------------------------------
    -- Conversions.

    IntegerToReal e BaseIntegerType
x -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"integerToReal" [e BaseIntegerType
x]
    BVToInteger  e (BaseBVType w)
x  -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"bvToInteger" [e (BaseBVType w)
x]
    SBVToInteger e (BaseBVType w)
x  -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"sbvToInteger" [e (BaseBVType w)
x]

    RoundReal e BaseRealType
x -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"round" [e BaseRealType
x]
    RoundEvenReal e BaseRealType
x -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"roundEven" [e BaseRealType
x]
    FloorReal e BaseRealType
x -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"floor" [e BaseRealType
x]
    CeilReal  e BaseRealType
x -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"ceil"  [e BaseRealType
x]

    IntegerToBV e BaseIntegerType
x NatRepr w
w -> forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"integerToBV" [forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e BaseIntegerType
x, forall a (e :: BaseType -> Type). Show a => a -> PrettyArg e
showPrettyArg NatRepr w
w]

    RealToInteger e BaseRealType
x   -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"realToInteger" [e BaseRealType
x]

    ------------------------------------------------------------------------
    -- String operations

    StringIndexOf e (BaseStringType si)
x e (BaseStringType si)
y e BaseIntegerType
k ->
       forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"string-index-of" [forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e (BaseStringType si)
x, forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e (BaseStringType si)
y, forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e BaseIntegerType
k]
    StringContains e (BaseStringType si)
x e (BaseStringType si)
y -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"string-contains" [e (BaseStringType si)
x, e (BaseStringType si)
y]
    StringIsPrefixOf e (BaseStringType si)
x e (BaseStringType si)
y -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"string-is-prefix-of" [e (BaseStringType si)
x, e (BaseStringType si)
y]
    StringIsSuffixOf e (BaseStringType si)
x e (BaseStringType si)
y -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"string-is-suffix-of" [e (BaseStringType si)
x, e (BaseStringType si)
y]
    StringSubstring StringInfoRepr si
_ e ('BaseStringType si)
x e BaseIntegerType
off e BaseIntegerType
len ->
       forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"string-substring" [forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e ('BaseStringType si)
x, forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e BaseIntegerType
off, forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e BaseIntegerType
len]
    StringAppend StringInfoRepr si
_ StringSeq e si
xs -> forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"string-append" (forall a b. (a -> b) -> [a] -> [b]
map forall {e :: BaseType -> Type} {si :: StringInfo}.
StringSeqEntry e si -> PrettyArg e
f (forall (e :: BaseType -> Type) (si :: StringInfo).
StringSeq e si -> [StringSeqEntry e si]
SSeq.toList StringSeq e si
xs))
          where f :: StringSeqEntry e si -> PrettyArg e
f (SSeq.StringSeqLiteral StringLiteral si
l) = forall a (e :: BaseType -> Type). Show a => a -> PrettyArg e
showPrettyArg StringLiteral si
l
                f (SSeq.StringSeqTerm e (BaseStringType si)
t)    = forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e (BaseStringType si)
t
    StringLength e (BaseStringType si)
x -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"string-length" [e (BaseStringType si)
x]

    ------------------------------------------------------------------------
    -- Complex operations

    Cplx (e BaseRealType
r :+ e BaseRealType
i) -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"complex" [e BaseRealType
r, e BaseRealType
i]
    RealPart e BaseComplexType
x -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"realPart" [e BaseComplexType
x]
    ImagPart e BaseComplexType
x -> forall (x :: BaseType). Text -> [e x] -> PrettyApp e
ppSExpr Text
"imagPart" [e BaseComplexType
x]

    ------------------------------------------------------------------------
    -- SymStruct

    StructCtor Assignment BaseTypeRepr flds
_ Assignment e flds
flds -> forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"struct" (forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type) a.
FoldableFC t =>
(forall (x :: k). f x -> a) -> forall (x :: l). t f x -> [a]
toListFC forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg Assignment e flds
flds)
    StructField e (BaseStructType flds)
s Index flds u
idx BaseTypeRepr u
_ ->
      forall (e :: BaseType -> Type).
Text -> [PrettyArg e] -> PrettyApp e
prettyApp Text
"field" [forall (e :: BaseType -> Type) (tp :: BaseType).
e tp -> PrettyArg e
exprPrettyArg e (BaseStructType flds)
s, forall a (e :: BaseType -> Type). Show a => a -> PrettyArg e
showPrettyArg Index flds u
idx]