# Types + Logical Predicates

``````type Name = Text

-- | Predicates of the refinement logic
data Predicate =
BoolLit Bool
| IntLit Int
| Var Name
| Unknown Name
| Relation BinOp Predicate Predicate

-- if p1 is true then p2 must also be true
| Implies Predicate Predicate
| Not Predicate

data BinOp =
Equal
| And
| Or
| LEqual
| Lesser
| GEqual
| Greater``````
``````-- | To Z3 AST
toZ3 :: Predicate -> Z3 Z3.AST
toZ3 predicate = case predicate of
BoolLit True  -> Z3.mkTrue
BoolLit False -> Z3.mkFalse
IntLit i      -> Z3.mkIntNum i
Var nm        -> do
sort <- intSort
s    <- Z3.mkStringSymbol \$ toS nm
Z3.mkConst s sort
Not  p -> toZ3 p >>= Z3.mkNot

Implies p1 p2 -> join \$ Z3.mkImplies <\$> toZ3 p1 <*> toZ3 p2

Relation op p1 p2 -> join \$ binOp <\$> toZ3 p1 <*> toZ3 p2
where
binOp = case op of
Equal   -> Z3.mkEq
And     -> \x y -> Z3.mkAnd [x, y]
Or      -> \x y -> Z3.mkOr [x, y]
LEqual  -> Z3.mkLe
GEqual  -> Z3.mkGe
Greater -> Z3.mkGt
Lesser  -> Z3.mkLt``````
``````-- | Search space for a single unknown
type PredicateSpace = [Predicate]
type PredicateMap = Map.Map Name PredicateSpace

-- | Valuation of a predicate unknown as a set of predicates
type Valuation = Set Predicate
-- | (Candidate) solutions for predicate unknowns
type Solution = Map.Map Name Valuation

-- | Top of the solutions
-- (maps every unknown in unknowns to the empty set of qualifiers)
topSolution :: PredicateMap -> Solution
topSolution quals =
Map.fromSet (const Set.empty) (Map.keysSet quals)
``````
``````-- | Substitute solutions from sol
--   for all unknowns in predicate
substitute :: Solution -> Predicate -> Predicate
substitute sol predicate = case predicate of
Unknown ident -> case Map.lookup ident sol of
Just quals -> conjunction quals
Nothing    -> predicate
Not p             -> Not (substitute sol p)
Implies f1 f2     ->
Implies (substitute sol f1) (substitute sol f2)
Relation op f1 f2 ->
Relation op (substitute sol f1) (substitute sol f2)
otherwise         -> predicate

conjunction predicates = if Set.null predicates
then BoolLit True
else foldr1 (Relation And) (Set.toList predicates)
``````
``````solve :: [Solution] -> [Predicate] -> Z3 (Maybe Solution)
solve (sol:sols) predicates = do
valid <- validSolution
case valid of
Just s  -> return \$ Just s -- Solution found
Nothing -> do
new   <- newSolutions
solve (new ++ sols) predicates
where
newSolutions = do
modifiedCS <- modifiedConstraint
strengthen quals modifiedCS sol

validSolution = do
new       <- newSolutions
invalidCS <- invalidConstraint
findM
(\s -> and <\$> mapM (isValid . substitute s)
(delete invalidCS predicates)) new

invalidConstraint, modifiedConstraint :: Z3 Predicate
invalidConstraint = do
fromJust <\$>
findM
(\predicate -> liftM not . isValid . substitute sol\$  predicate)
predicates

modifiedConstraint = do
cs <- invalidConstraint
case cs of
Implies lhs rhs ->
return \$ Implies lhs (substitute sol rhs)
_ -> panic \$ toS \$ "encountered ill-formed constraint " ++ (show cs)``````
``````solve :: [Solution] -> [Predicate] -> Z3 (Maybe Solution)
solve (sol:sols) predicates = do
valid <- validSolution
case valid of
Just s  -> return \$ Just s -- Solution found
Nothing -> do
new   <- newSolutions
solve (new ++ sols) predicates
where
newSolutions = do
modifiedCS <- modifiedConstraint
strengthen quals modifiedCS sol

validSolution = do
new       <- newSolutions
invalidCS <- invalidConstraint
findM
(\s -> and <\$> mapM (isValid . substitute s)
(delete invalidCS predicates)) new

invalidConstraint, modifiedConstraint :: Z3 Predicate
invalidConstraint = do
fromJust <\$>
findM
(\predicate -> liftM not . isValid . substitute sol\$  predicate)
predicates

modifiedConstraint = do
cs <- invalidConstraint
case cs of
Implies lhs rhs ->
return \$ Implies lhs (substitute sol rhs)
_ -> panic \$ toS \$ "encountered ill-formed constraint " ++ (show cs)``````
``````-- | 'strengthen' @quals predicate sol@: all minimal strengthenings of
-- @sol@ using predicates from @quals@ that make @predicate@ valid
strengthen :: PredicateMap -> Predicate -> Solution -> Z3 [Solution]
strengthen quals (Implies lhs rhs) sol = ...``````
``````condPredicates :: [Name] -> [Predicate]
condPredicates  vars = do
lhs <- map Var vars
op  <- [GEqual, Greater]
rhs <- map Var vars
guard \$ lhs /= rhs
return \$ Relation op lhs rhs

varPredicates :: [Name] -> [Predicate]
varPredicates vars = do
var <- map Var vars
return \$ result |=| var

vars = ["x", "y"]

space = Map.fromList
[ ("condT",  (condPredicates vars))
, ("condF", (condPredicates vars))
, ("then" , (varPredicates vars) )
, ("else" , (varPredicates vars) )
]

maxType = (Var "x" |<=| result) |&| (Var "y" |<=| result)

predicates =
[ BoolLit True |==>| (Unknown "condT" ||| Unknown "condF")
, (Unknown "condT" |&| Unknown "then") |==>| maxType
, (Unknown "condF" |&| Unknown "else") |==>| maxType
]``````

By ..

• 541