| Copyright | (c) Galois Inc 2014 |
|---|---|
| License | BSD3 |
| Maintainer | Joe Hendrix <jhendrix@galois.com> |
| Stability | provisional |
| Safe Haskell | None |
| Language | Haskell2010 |
Lang.Crucible.Types
Description
This module exports the types used in Crucible expressions.
These types are largely used as indexes to various GADTs and type families as a way to let the GHC typechecker help us keep expressions of the embedded CFG language apart.
In addition, we provide a value-level reification of the type
indices that can be examined by pattern matching, called TypeRepr.
The KnownRepr class computes the value-level representation
of a given type index, when the type is known at compile time.
Similar setups exist for other components of the type system:
bitvector data and type contexts.
Synopsis
- data CrucibleType
- type AnyType = 'AnyType
- type UnitType = 'UnitType
- type BoolType = BaseToType BaseBoolType
- type NatType = 'NatType
- type IntegerType = BaseToType BaseIntegerType
- type RealValType = BaseToType BaseRealType
- type SymbolicStructType (flds :: Ctx BaseType) = BaseToType (BaseStructType flds)
- type ComplexRealType = BaseToType BaseComplexType
- type BVType (w :: Nat) = BaseToType (BaseBVType w)
- type FloatType = 'FloatType
- type IEEEFloatType (p :: FloatPrecision) = BaseToType (BaseFloatType p)
- type CharType = 'CharType
- type StringType (si :: StringInfo) = BaseToType (BaseStringType si)
- type FunctionHandleType = 'FunctionHandleType
- type MaybeType = 'MaybeType
- type RecursiveType = 'RecursiveType
- type IntrinsicType (ctx :: Symbol) = 'IntrinsicType ctx
- type VectorType = 'VectorType
- type SequenceType = 'SequenceType
- type StructType = 'StructType
- type VariantType = 'VariantType
- type ReferenceType = 'ReferenceType
- type WordMapType = 'WordMapType
- type StringMapType = 'StringMapType
- type SymbolicArrayType (idx :: Ctx BaseType) (xs :: BaseType) = BaseToType (BaseArrayType idx xs)
- class IsRecursiveType (nm :: Symbol) where
- type UnrollType (nm :: Symbol) (ctx :: Ctx CrucibleType) :: CrucibleType
- unrollType :: forall (ctx :: Ctx CrucibleType). SymbolRepr nm -> CtxRepr ctx -> TypeRepr (UnrollType nm ctx)
- type BaseToType = 'BaseToType
- baseToType :: forall (bt :: BaseType). BaseTypeRepr bt -> TypeRepr (BaseToType bt)
- data AsBaseType (tp :: CrucibleType) where
- AsBaseType :: forall (tp :: CrucibleType) (bt :: BaseType). tp ~ BaseToType bt => BaseTypeRepr bt -> AsBaseType tp
- NotBaseType :: forall (tp :: CrucibleType). AsBaseType tp
- asBaseType :: forall (tp :: CrucibleType). TypeRepr tp -> AsBaseType tp
- type CtxRepr = Assignment TypeRepr
- pattern KnownBV :: forall (n :: Natural). (1 <= n, KnownNat n) => TypeRepr (BVType n)
- ppTypeRepr :: forall f ann (tp :: CrucibleType). Monad f => (forall (s :: Symbol) (ctx :: Ctx CrucibleType). SymbolRepr s -> CtxRepr ctx -> f (Doc ann)) -> TypeRepr tp -> f (Doc ann)
- ppIntrinsicDefault :: forall (s :: Symbol) (ctx :: Ctx CrucibleType) ann. SymbolRepr s -> CtxRepr ctx -> Doc ann
- data TypeRepr (tp :: CrucibleType) where
- AnyRepr :: TypeRepr 'AnyType
- UnitRepr :: TypeRepr 'UnitType
- BoolRepr :: TypeRepr ('BaseToType BaseBoolType)
- NatRepr :: TypeRepr 'NatType
- IntegerRepr :: TypeRepr ('BaseToType BaseIntegerType)
- RealValRepr :: TypeRepr ('BaseToType BaseRealType)
- ComplexRealRepr :: TypeRepr ('BaseToType BaseComplexType)
- BVRepr :: forall (n :: Natural). 1 <= n => !(NatRepr n) -> TypeRepr ('BaseToType (BaseBVType n))
- IntrinsicRepr :: forall (nm :: Symbol) (ctx :: Ctx CrucibleType). !(SymbolRepr nm) -> !(CtxRepr ctx) -> TypeRepr ('IntrinsicType nm ctx)
- RecursiveRepr :: forall (nm :: Symbol) (ctx :: Ctx CrucibleType). IsRecursiveType nm => SymbolRepr nm -> CtxRepr ctx -> TypeRepr ('RecursiveType nm ctx)
- FloatRepr :: forall (flt :: FloatInfo). !(FloatInfoRepr flt) -> TypeRepr ('FloatType flt)
- IEEEFloatRepr :: forall (ps :: FloatPrecision). !(FloatPrecisionRepr ps) -> TypeRepr ('BaseToType (BaseFloatType ps))
- CharRepr :: TypeRepr 'CharType
- StringRepr :: forall (si :: StringInfo). StringInfoRepr si -> TypeRepr ('BaseToType (BaseStringType si))
- FunctionHandleRepr :: forall (ctx :: Ctx CrucibleType) (ret :: CrucibleType). !(CtxRepr ctx) -> !(TypeRepr ret) -> TypeRepr ('FunctionHandleType ctx ret)
- MaybeRepr :: forall (tp1 :: CrucibleType). !(TypeRepr tp1) -> TypeRepr ('MaybeType tp1)
- SequenceRepr :: forall (tp1 :: CrucibleType). !(TypeRepr tp1) -> TypeRepr ('SequenceType tp1)
- VectorRepr :: forall (tp1 :: CrucibleType). !(TypeRepr tp1) -> TypeRepr ('VectorType tp1)
- StructRepr :: forall (ctx :: Ctx CrucibleType). !(CtxRepr ctx) -> TypeRepr ('StructType ctx)
- VariantRepr :: forall (ctx :: Ctx CrucibleType). !(CtxRepr ctx) -> TypeRepr ('VariantType ctx)
- ReferenceRepr :: forall (a :: CrucibleType). !(TypeRepr a) -> TypeRepr ('ReferenceType a)
- WordMapRepr :: forall (n :: Natural) (tp1 :: BaseType). 1 <= n => !(NatRepr n) -> !(BaseTypeRepr tp1) -> TypeRepr ('WordMapType n tp1)
- StringMapRepr :: forall (tp1 :: CrucibleType). !(TypeRepr tp1) -> TypeRepr ('StringMapType tp1)
- SymbolicArrayRepr :: forall (idx :: Ctx BaseType) (tp1 :: BaseType) (t :: BaseType). !(Assignment BaseTypeRepr (idx ::> tp1)) -> !(BaseTypeRepr t) -> TypeRepr ('BaseToType (BaseArrayType (idx ::> tp1) t))
- SymbolicStructRepr :: forall (ctx :: Ctx BaseType). Assignment BaseTypeRepr ctx -> TypeRepr ('BaseToType (BaseStructType ctx))
- module Data.Parameterized.Ctx
- module Data.Parameterized.NatRepr
- module Data.Parameterized.SymbolRepr
- module What4.BaseTypes
- module What4.InterpretedFloatingPoint
CrucibleType data kind
data CrucibleType Source #
This data kind describes the types of values and expressions that can occur in Crucible CFGs.
Instances
Constructors for kind CrucibleType
Arguments
| = 'AnyType |
|
A dynamic type that can contain values of any type.
Arguments
| = BaseToType BaseBoolType |
|
type IntegerType Source #
Arguments
| = BaseToType BaseIntegerType |
|
type RealValType Source #
Arguments
| = BaseToType BaseRealType |
|
type SymbolicStructType (flds :: Ctx BaseType) Source #
Arguments
| = BaseToType (BaseStructType flds) |
|
type ComplexRealType Source #
Arguments
| = BaseToType BaseComplexType |
|
type BVType (w :: Nat) Source #
Arguments
| = BaseToType (BaseBVType w) |
|
Arguments
| = 'FloatType |
|
A type index for floating point numbers, whose interpretation depends on the symbolic backend.
type IEEEFloatType (p :: FloatPrecision) Source #
Arguments
| = BaseToType (BaseFloatType p) | :: FloatPrecision -> CrucibleType |
Arguments
| = 'CharType |
|
A single character, as a 16-bit wide char.
type StringType (si :: StringInfo) Source #
Arguments
| = BaseToType (BaseStringType si) |
|
type FunctionHandleType Source #
Arguments
| = 'FunctionHandleType |
|
A function handle taking a context of formal arguments and a return type.
Arguments
| = 'MaybeType |
|
The Maybe type lifted into Crucible expressions.
type RecursiveType Source #
Arguments
| = 'RecursiveType |
|
Named recursive types, named by the given symbol. To use
recursive types you must provide an instance of the
IsRecursiveType class that gives the unfolding of this recursive
type. The RollRecursive and
UnrollRecursive operations witness the
isomorphism between a recursive type and its one-step unrolling.
Similar to Haskell's newtype, recursive types do not necessarily
have to mention the recursive type being defined; in which case,
the type is simply a new named type which is isomorphic to its
definition.
type IntrinsicType (ctx :: Symbol) Source #
Arguments
| = 'IntrinsicType ctx |
|
Named intrinsic types. Intrinsic types are a way to extend the
Crucible type system after-the-fact and add new type
implementations. Core Crucible provides no operations on intrinsic
types; they must be provided as built-in override functions. See
the IntrinsicClass typeclass
and the Intrinsic type family
defined in Lang.Crucible.Simulator.Intrinsics.
type VectorType Source #
Arguments
| = 'VectorType |
|
A finite (one-dimensional) sequence of values. Vectors are optimized for random-access indexing and updating. Vectors of different lengths may not be combined at join points.
type SequenceType Source #
Arguments
| = 'SequenceType |
|
Sequences of values, represented as linked lists of cons cells. Sequences only allow access to the front. Unlike Vectors, sequences of different lengths may be combined at join points.
type StructType Source #
Arguments
| = 'StructType |
|
A structure is an aggregate type consisting of a sequence of values. The type of each value is known statically.
type VariantType Source #
Arguments
| = 'VariantType |
|
A variant is a disjoint union of the types listed in the context.
type ReferenceType Source #
Arguments
| = 'ReferenceType |
|
The type of mutable reference cells.
type WordMapType Source #
Arguments
| = 'WordMapType |
|
A finite map from bitvector values to the given Crucible type.
The Nat index gives the width of the bitvector values used to
index the map.
type StringMapType Source #
Arguments
| = 'StringMapType |
|
A partial map from strings to values.
type SymbolicArrayType (idx :: Ctx BaseType) (xs :: BaseType) Source #
Arguments
| = BaseToType (BaseArrayType idx xs) |
|
IsRecursiveType
class IsRecursiveType (nm :: Symbol) where Source #
This typeclass is used to register recursive Crucible types with the compiler. This class defines, for a given symbol, both the type-level and the representative-level unrolling of a named recursive type.
The symbol constitutes a unique compile-time identifier for the recursive type, allowing recursive types to be unrolled at run time without requiring dynamic checks.
Parameter nm has kind Symbol.
Associated Types
type UnrollType (nm :: Symbol) (ctx :: Ctx CrucibleType) :: CrucibleType Source #
Methods
unrollType :: forall (ctx :: Ctx CrucibleType). SymbolRepr nm -> CtxRepr ctx -> TypeRepr (UnrollType nm ctx) Source #
Base type injection
type BaseToType Source #
Arguments
| = 'BaseToType |
|
baseToType :: forall (bt :: BaseType). BaseTypeRepr bt -> TypeRepr (BaseToType bt) Source #
data AsBaseType (tp :: CrucibleType) where Source #
Constructors
| AsBaseType :: forall (tp :: CrucibleType) (bt :: BaseType). tp ~ BaseToType bt => BaseTypeRepr bt -> AsBaseType tp | |
| NotBaseType :: forall (tp :: CrucibleType). AsBaseType tp |
asBaseType :: forall (tp :: CrucibleType). TypeRepr tp -> AsBaseType tp Source #
Other stuff
type CtxRepr = Assignment TypeRepr Source #
pattern KnownBV :: forall (n :: Natural). (1 <= n, KnownNat n) => TypeRepr (BVType n) Source #
Pattern synonym specifying bitvector TypeReprs. Intended to be use
with type applications, e.g., KnownBV @32.
Arguments
| :: forall f ann (tp :: CrucibleType). Monad f | |
| => (forall (s :: Symbol) (ctx :: Ctx CrucibleType). SymbolRepr s -> CtxRepr ctx -> f (Doc ann)) | How to print |
| -> TypeRepr tp | |
| -> f (Doc ann) |
Pretty-print a type.
Attempts to be consistent with the syntax provided in the crucible-syntax
package.
This is monadic mostly to allow failure, e.g., in case the caller finds an intrinsic type that it doesn't expect.
ppIntrinsicDefault :: forall (s :: Symbol) (ctx :: Ctx CrucibleType) ann. SymbolRepr s -> CtxRepr ctx -> Doc ann Source #
A default printer for IntrinsicRepr, suitable for use with ppTypeRepr.
Representation of Crucible types
data TypeRepr (tp :: CrucibleType) where Source #
A family of representatives for Crucible types. Parameter tp
has kind CrucibleType.
Constructors
| AnyRepr :: TypeRepr 'AnyType | |
| UnitRepr :: TypeRepr 'UnitType | |
| BoolRepr :: TypeRepr ('BaseToType BaseBoolType) | |
| NatRepr :: TypeRepr 'NatType | |
| IntegerRepr :: TypeRepr ('BaseToType BaseIntegerType) | |
| RealValRepr :: TypeRepr ('BaseToType BaseRealType) | |
| ComplexRealRepr :: TypeRepr ('BaseToType BaseComplexType) | |
| BVRepr :: forall (n :: Natural). 1 <= n => !(NatRepr n) -> TypeRepr ('BaseToType (BaseBVType n)) | |
| IntrinsicRepr :: forall (nm :: Symbol) (ctx :: Ctx CrucibleType). !(SymbolRepr nm) -> !(CtxRepr ctx) -> TypeRepr ('IntrinsicType nm ctx) | |
| RecursiveRepr :: forall (nm :: Symbol) (ctx :: Ctx CrucibleType). IsRecursiveType nm => SymbolRepr nm -> CtxRepr ctx -> TypeRepr ('RecursiveType nm ctx) | |
| FloatRepr :: forall (flt :: FloatInfo). !(FloatInfoRepr flt) -> TypeRepr ('FloatType flt) | This is a representation of floats that works at known fixed mantissa and exponent widths, but the symbolic backend may pick the representation. |
| IEEEFloatRepr :: forall (ps :: FloatPrecision). !(FloatPrecisionRepr ps) -> TypeRepr ('BaseToType (BaseFloatType ps)) | This is a float with user-definable mantissa and exponent that maps directly to the what4 base type. |
| CharRepr :: TypeRepr 'CharType | |
| StringRepr :: forall (si :: StringInfo). StringInfoRepr si -> TypeRepr ('BaseToType (BaseStringType si)) | |
| FunctionHandleRepr :: forall (ctx :: Ctx CrucibleType) (ret :: CrucibleType). !(CtxRepr ctx) -> !(TypeRepr ret) -> TypeRepr ('FunctionHandleType ctx ret) | |
| MaybeRepr :: forall (tp1 :: CrucibleType). !(TypeRepr tp1) -> TypeRepr ('MaybeType tp1) | |
| SequenceRepr :: forall (tp1 :: CrucibleType). !(TypeRepr tp1) -> TypeRepr ('SequenceType tp1) | |
| VectorRepr :: forall (tp1 :: CrucibleType). !(TypeRepr tp1) -> TypeRepr ('VectorType tp1) | |
| StructRepr :: forall (ctx :: Ctx CrucibleType). !(CtxRepr ctx) -> TypeRepr ('StructType ctx) | |
| VariantRepr :: forall (ctx :: Ctx CrucibleType). !(CtxRepr ctx) -> TypeRepr ('VariantType ctx) | |
| ReferenceRepr :: forall (a :: CrucibleType). !(TypeRepr a) -> TypeRepr ('ReferenceType a) | |
| WordMapRepr :: forall (n :: Natural) (tp1 :: BaseType). 1 <= n => !(NatRepr n) -> !(BaseTypeRepr tp1) -> TypeRepr ('WordMapType n tp1) | |
| StringMapRepr :: forall (tp1 :: CrucibleType). !(TypeRepr tp1) -> TypeRepr ('StringMapType tp1) | |
| SymbolicArrayRepr :: forall (idx :: Ctx BaseType) (tp1 :: BaseType) (t :: BaseType). !(Assignment BaseTypeRepr (idx ::> tp1)) -> !(BaseTypeRepr t) -> TypeRepr ('BaseToType (BaseArrayType (idx ::> tp1) t)) | |
| SymbolicStructRepr :: forall (ctx :: Ctx BaseType). Assignment BaseTypeRepr ctx -> TypeRepr ('BaseToType (BaseStructType ctx)) |
Instances
Re-exports
module Data.Parameterized.Ctx
module Data.Parameterized.NatRepr
module What4.BaseTypes