GaloisInc/cryptol
1
1
Fork 0
mirror of https://github.com/GaloisInc/cryptol.git synced 2024-12-18 05:21:57 +03:00
Code Issues Projects Releases Wiki Activity

Fix-up export to SMT to deal correctly with finiteness.

Browse Source
This commit is contained in:
Iavor S. Diatchki 2015-01-08 11:49:17 -08:00
parent f8773be505
commit 2ac2ddbc4a
4 changed files with 23 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
src/Cryptol/TypeCheck/Solver/CrySAT.hs
View File

@ -313,7 +313,6 @@ declareVar Solver { .. } a =
let fin_a = smtFinName a
_ <- SMT.declare solver fin_a SMT.tBool
SMT.assert solver (SMT.geq e (SMT.int 0))
-- SMT.assert solver (SMT.const fin_a) -- HMM ???
modifyIORef' declared (viInsert a)
-- | Add an assertion to the current context.

4
src/Cryptol/TypeCheck/Solver/Numeric/NonLin.hs
View File

@ -49,12 +49,12 @@ isNonLinOp expr =
Div _ y ->
case y of
K _ -> False
K (Nat n) -> n /= 0
_ -> True
Mod _ y ->
case y of
K _ -> False
K (Nat n) -> n /= 0
_ -> True
_ :^^ _ -> True

22
src/Cryptol/TypeCheck/Solver/Numeric/SMT.hs
View File

@ -59,10 +59,10 @@ desugarProp prop =
p :&& q -> (:&&) `fmap` desugarProp p `ap` desugarProp q
p :|| q -> (:||) `fmap` desugarProp p `ap` desugarProp q
Fin (Var _) -> return prop
Fin _ -> unexpected
x :==: y -> (:==:) `fmap` desugarExpr x `ap` desugarExpr y
x :>: y -> (:>:) `fmap` desugarExpr x `ap` desugarExpr y
Fin _ -> unexpected
_ :== _ -> unexpected
_ :>= _ -> unexpected
_ :> _ -> unexpected
@ -86,9 +86,17 @@ propToSmtLib prop =
Not p -> SMT.not (propToSmtLib p)
p :&& q -> SMT.and (propToSmtLib p) (propToSmtLib q)
p :|| q -> SMT.or (propToSmtLib p) (propToSmtLib q)
Fin (Var x) -> SMT.const (smtFinName x)
x :==: y -> SMT.eq (exprToSmtLib x) (exprToSmtLib y)
x :>: y -> SMT.gt (exprToSmtLib x) (exprToSmtLib y)
Fin (Var x) -> fin x
{- For the linear constraints, if the term is finite, then all of
its variables must have been finite.
XXX: Adding the `fin` decls at the leaves leads to some duplication:
We could add them just once for each conjunctoin of simple formulas,
but I am not sure how much this matters.
-}
x :==: y -> addFin x y $ SMT.eq (exprToSmtLib x) (exprToSmtLib y)
x :>: y -> addFin x y $ SMT.gt (exprToSmtLib x) (exprToSmtLib y)
Fin _ -> unexpected
_ :== _ -> unexpected
@ -97,20 +105,24 @@ propToSmtLib prop =
where
unexpected = panic "desugarProp" [ show (ppProp prop) ]
fin x = SMT.const (smtFinName x)
addFin x y e = foldr (\x e' -> SMT.and (fin x) e') e
(Set.toList (cryExprFVS x `Set.union` cryExprFVS y))
exprToSmtLib :: Expr -> SExpr
exprToSmtLib expr =
case expr of
K (Nat n) -> SMT.int n
K Inf -> unexpected
Var a -> SMT.const (smtName a)
x :+ y -> SMT.add (exprToSmtLib x) (exprToSmtLib y)
x :- y -> SMT.sub (exprToSmtLib x) (exprToSmtLib y)
x :* y -> SMT.mul (exprToSmtLib x) (exprToSmtLib y)
Div x y -> SMT.div (exprToSmtLib x) (exprToSmtLib y)
Mod x y -> SMT.mod (exprToSmtLib x) (exprToSmtLib y)
K Inf -> unexpected
_ :^^ _ -> unexpected
Min {} -> unexpected
Max {} -> unexpected

19
src/Cryptol/TypeCheck/Solver/Numeric/Simplify.hs
View File

@ -22,8 +22,6 @@ import qualified Cryptol.TypeCheck.Solver.InfNat as IN
import Cryptol.Utils.Panic( panic )
import Cryptol.Utils.Misc ( anyJust )
import Cryptol.Utils.Debug(trace)
import Control.Monad ( mplus )
import Data.List ( sortBy )
import Data.Maybe ( fromMaybe )
@ -32,15 +30,7 @@ import qualified Data.Set as Set
-- | Simplify a property, if possible.
crySimplify :: Prop -> Prop
crySimplify p = trace ("simp: " ++ show (ppProp p)) $
case crySimplifyMaybe p of
Nothing -> trace "-> (no change)" p
Just p1 -> trace ("-> " ++ show (ppProp p1)) p1
-- | Simplify a property, if possible.
crySimplify' :: Prop -> Prop
crySimplify' p = crySimplify p -- fromMaybe p (crySimplifyMaybe p)
crySimplify p = fromMaybe p (crySimplifyMaybe p)
-- | Simplify a property, if possibly.
crySimplifyMaybe :: Prop -> Maybe Prop
@ -49,8 +39,8 @@ crySimplifyMaybe p =
exprsSimped = fromMaybe p mbSimpExprs
mbRearrange = tryRearrange exprsSimped
rearranged = fromMaybe exprsSimped mbRearrange
in crySimplify' `fmap` (crySimpStep rearranged `mplus` mbRearrange
`mplus` mbSimpExprs)
in crySimplify `fmap` (crySimpStep rearranged `mplus` mbRearrange
`mplus` mbSimpExprs)
where
tryRearrange q = case q of
@ -426,7 +416,7 @@ cryIsFin expr =
Just ( Fin t1 :&& Fin t2
:|| t1 :== inf :&& t2 :== zero -- inf ^^ 0
:|| t2 :== inf :&& (t1 :== zero :|| t1 :== one)
-- 0 ^^ inf, 1 ^^ inf
-- 0 ^^ inf, 1 ^^ inf
)
Min t1 t2 -> Just (Fin t1 :|| Fin t2)
@ -716,7 +706,6 @@ cryNoInf expr =
-- The rest just propagates
K _ -> return expr