Module Satproc.L


module L: Logic


API
type location = Errormsg.location 

Expressions
type var = string 

The main type for symbolic expressions. Each expression can have one of a few types:

type exp =
| Int of Int32.t (*Integer constants (of type Sign32). If you want to convert to an int, use Logic.to_int, not In32.to_int because the latter silently drops a bit.*)
| UnOp of unop * exp (*A unary operation. Type of operand and result depends on the operation.*)
| BinOp of binop * exp * exp (*A binary operation. Type of operand and result depends on the operation. **)
| Fun of string * exp list (*A constructed expression, with the constructor name and a number of arguments.*)
| Var of int
| NVar of var (*A named variable*)
| UVar of int (*A unification variable*)

type unop =
| Mod32 (*Computes modulo 2^32. Of type Int -> Unsign32.*)
| BNot (*Bitwise complement*)
| RepS32 (*Tests whether the argument (an Int) is in the range of Sign32. Has a value of zero or one*)
| RepU32 (*Tests whether the argument (an Int) is in the range of Unsign32. Has a value of zero or one*)

type binop =
| Plus (*Addition (the real one). Two operands of type Int or Sign32 and result of type Int.*)
| Minus (*Subtraction (the real one). Two operands of any integer type and result of type Int.*)
| Times (*Multiplication (the real one ). Two operands of type Int or Sign32 and result of type Int.*)
| Add (*Addition modulo 2^32. Two operands of type Sign32 and result of type Sign32.*)
| Sub (*Subtraction modulo 2^32. Two operands of type Sign32 and result of type Sign32.*)
| Mult (*Multiplication modulo 2^32. Two operands of type Sign32 and result of type Sign32.*)
| Div (*Integer Division. Two operands of type Sign32 and result of type Sign32.*)
| BAnd (*Bitwise AND*)
| BOr (*Bitwise OR*)
| BXor (*Bitwise XOR*)
| Sll (*Shift left logical*)
| Srl (*Shift right logical*)
| Sra (*Shift right arithmetic*)
| SetEq (*equal, printed "=" when used with PNez.*)
| SetNe (*not equal, printed "<>" when used with PNez.*)
| SetGt (*signed greater, printed ">" when used with PNez.*)
| SetGe (*signed greater or equal, printed ">=" when used with PNez.*)
| SetLt (*signed less, printed "<" when used with PNez.*)
| SetLe (*signed less or equal, printed "<=" when used with PNez.*)
| SetAb (*unsigned greater (above), printed ">u" when used with PNez.*)
| SetAe (*unsigned greate equal, , printed ">=u" when used with PNez.*)
| SetBl (*unsigned less (below), printed "<u" when used with PNez.*)
| SetBe (*unsigned less or equal , printed "<=u" when used with PNez.*)
| SetPe (*parity even*)
| SetPo (*parity odd*)
| SignExt (*signext(e1,e2) we sign-extend the least-significant e2 bytes of e1, to a full 32-bit word*)

type pred =
| Bool of bool (*A boolean value of True or False*)
| PNez of exp (*A shorthand for e <> 0*)
| PFun of string * exp list (*Constructed predicate*)
| And of pred list
| Or of pred list
| Imply of pred * pred (*An implication*)
| All of string * pred (*A universal quantification of the variable and predicate. Give the name of the quantified variable.*)
| Exist of string * pred (*An existential quanitification of the variable and predicate. Give the name of the quantified variable.*)
A symbolic predicate
exception CannotNegate of pred
val negateExp : exp -> exp
Negate an expression. This is the same as BinOp(SetEq,e,zero) but in most cases it yields a better expression.
val negatePredRaise : pred -> pred
Negate a predicate. Predicated of the form PFun cannot be negated. Raise CannotNegate in that case.
val negatePred : pred -> pred
Like Logic.negatePredRaise except that it generates an error for predicates that cannot be negated.
val integer : int -> exp
A constructor for making Int expressions
exception IntegerTooLarge
Converts an int32 into an integer. Raises IntegerTooLarge if the conversion cannot be made soundly.
val to_int : int32 -> int
val newVar : string -> var
val resetVars : unit -> unit
val varName : string -> string
val isAtomPred : pred -> bool
val zero : exp
A few useful constants
val one : exp
val minus : exp -> exp -> exp
val plus : exp -> exp -> exp
val times : exp -> exp -> exp
val eq : exp -> exp -> pred
val ne : exp -> exp -> pred
val geq : exp -> exp -> pred
val leq : exp -> exp -> pred
val gt : exp -> exp -> pred
val lt : exp -> exp -> pred
val makeMap : (int * exp) list -> exp
We have integer maps built-in. Make an integer map
val findMap : exp -> int -> exp
Lookup an index into the map. Raises Not_found
val insertMap : exp -> int -> exp -> exp
Insert a new entry into the map: insertMap map idx e
val substPred : ?depth:int ->
(int -> exp -> exp option) -> pred -> pred
Substitution on predicates, given a function that can substitute a subexpression. The argument function is also passed the abstraction depth. If the function returns Some e then that is used as a replacement for the subexpression. If the function returns None then the subexpressions of the current expression are processed recurisively. If no substitutions are performed this function returns the exact same object.
val substExp : ?depth:int ->
(int -> exp -> exp option) -> exp -> exp

type soption =
| Unif
| Done of sexp
type subst = soption array 
type sexp = exp * subst 
type spred = pred * subst 
val eunify : (subst -> int -> sexp -> bool) ->
exp * subst -> exp * subst -> bool
Unify two expressions. The first argument is a function that can be used to update the substitution. If it tries to unify two unification variables, the first one gets instantiated.
val punify : (subst -> int -> sexp -> bool) ->
pred * subst -> pred * subst -> bool
val unrollUVars : subst -> exp -> exp
Tries to unroll the unification variables completely, but if there are still unresolved unification variables it leaves the expression unchanged (so that the original subsitution still applies)
val unrollUVarsRaise : subst -> exp -> exp
Like Logic.unrollUVars but raises HasUVar if there are unification variables left
val unrollUVarsPredRaise : subst -> pred -> pred
val unrollExp : sexp -> sexp
Unroll only superficially
exception HasUVar
val unrollUVarsError : subst -> exp -> exp
Like Logic.unrollUVars but gives an error and stops the execution of there are unification variables left
val newSubst : int -> subst
Create a substitution for the given number of unification variables.
val emptySubst : subst
val newSubstFromList : exp list -> subst
val d_sexp : unit -> sexp -> Pretty.doc
val d_spred : unit -> spred -> Pretty.doc
val d_subst : unit -> subst -> Pretty.doc
val d_sexpNoUnroll : unit -> sexp -> Pretty.doc
Print an explicit substitution without trying to perform the substitution
val simplifyArith : exp -> int option
Try to simplify an expression to an integer

The visitor

type 'a visitAction =
| SkipChildren (*Do not visit the children. Return the node as it is.*)
| DoChildren (*Continue with the children of this node. Rebuild the node on return if any of the children changes (use == test)*)
| ChangeTo of 'a (*Replace the expression with the given one*)
| ChangeDoChildrenPost of 'a * ('a -> 'a) (*First consider that the entire exp is replaced by the first parameter. Then continue with the children. On return rebuild the node if any of the children has changed and then apply the function on the node*)
Different visiting actions. 'a will be instantiated with exp, pred
class type logicVisitor = object .. end
A visitor interface for traversing Logic expressions and predicates.
class nopLogicVisitor : logicVisitor
Default Visitor.
val visitLogicExp : logicVisitor -> exp -> exp
val visitLogicPred : logicVisitor -> pred -> pred

Pretty Printing

Logic has a fairly easy to use mechanism for printing error messages. This mechanism is built on top of the pretty-printer mechanism (see Pretty.doc) and the error-message modules (see Errormsg.error).

Here is a typical example for printing a log message:

ignore (Errormsg.log "Expression %a is not positive (at %s:%i)\n"
                        d_exp e loc.file loc.line)

and here is an example of how you print a fatal error message that stop the execution:

Errormsg.s (Errormsg.bug "Why am I here?")

Notice that you can use C format strings with some extension. The most useful extension is "%a" that means to consumer the next two argument from the argument list and to apply the first to unit and then to the second and to print the resulting Pretty.doc. For each major type in SAL there is a corresponding function that pretty-prints an element of that type:

val unop_to_string : unop -> string
Convert a unary operation to a string
val binop_to_string : binop -> string
Convert a binary operation to a string
class type logicPrinter = object .. end
A printer interface for Logic trees.
class defaultLogicPrinterClass : logicPrinter
val defaultLogicPrinter : logicPrinter
class infixLogicPrinterClass : logicPrinter
val infixLogicPrinter : logicPrinter
val printExp : logicPrinter -> exp -> Pretty.doc
Print an expression given a pretty printer
val printPred : logicPrinter -> pred -> Pretty.doc
Print a predicate given a pretty printer
val d_pred : unit -> pred -> Pretty.doc
Convert a predicate to a Pretty.doc
val d_exp : unit -> exp -> Pretty.doc
Convert an expression to a Pretty.doc
val d_explist : unit -> exp list -> Pretty.doc
Convert an expression list to a Pretty.doc
val d_loc : unit -> location -> Pretty.doc
class uvarLogicPrinterClass : subst -> logicPrinter
val renameVariable : pred -> string -> string -> pred
rename a variable in a predicate