suzanne.soy/tock-mirror
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Added (constant divisor, for now) modulo to the QuickCheck tests in ArrayUsageCheckTest

Browse Source
This commit is contained in:
Neil Brown 2008-02-09 11:36:37 +00:00
parent 7fbb83a813
commit d0b94e402c
2 changed files with 38 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
checks/ArrayUsageCheck.hs
View File

@ -16,7 +16,7 @@ You should have received a copy of the GNU General Public License along
with this program. If not, see <http://www.gnu.org/licenses/>. with this program. If not, see <http://www.gnu.org/licenses/>.
-} -}
module ArrayUsageCheck (BackgroundKnowledge(..), checkArrayUsage, FlattenedExp(..), makeEquations, VarMap) where module ArrayUsageCheck (BackgroundKnowledge(..), checkArrayUsage, FlattenedExp(..), onlyConst, makeEquations, VarMap) where
import Control.Monad.Error import Control.Monad.Error
import Control.Monad.State import Control.Monad.State

45
checks/ArrayUsageCheckTest.hs
View File

@ -115,7 +115,7 @@ leq [] = []
leq [_] = [] leq [_] = []
leq (x:y:zs) = (x <== y) : (leq (y:zs)) leq (x:y:zs) = (x <== y) : (leq (y:zs))
(&&&) :: [HandyIneq] -> [HandyIneq] -> [HandyIneq] (&&&) :: [a] -> [a] -> [a]
(&&&) = (++) (&&&) = (++)
infixr 4 === infixr 4 ===
@ -537,7 +537,7 @@ genNewItem specialAllowed
-- ,(20, return (A.Dyadic emptyMeta A.Mul (exprVariable $ "y" ++ show nextId) (exprVariable $ "y" ++ show nextId)) -- ,(20, return (A.Dyadic emptyMeta A.Mul (exprVariable $ "y" ++ show nextId) (exprVariable $ "y" ++ show nextId))
] ++ if not specialAllowed then [] ] ++ if not specialAllowed then []
else [(20, do ((eT,iT),fT) <- genNewItem False else [(20, do ((eT,iT),fT) <- genNewItem False
((eB,iB),fB) <- genNewItem False ((eB,iB),fB) <- genConst -- TODO enable variable divisor
m <- get m <- get
let nextId = 1 + maximum (0 : Map.elems m) let nextId = 1 + maximum (0 : Map.elems m)
return (A.Dyadic emptyMeta A.Rem eT eB, Modulo (Set.singleton fT) (Set.singleton fB), nextId) return (A.Dyadic emptyMeta A.Rem eT eB, Modulo (Set.singleton fT) (Set.singleton fB), nextId)
@ -555,19 +555,48 @@ generateEquationInput
= do ((items, upper),vm) <- flip runStateT Map.empty = do ((items, upper),vm) <- flip runStateT Map.empty
(do upper <- frequency' [(80, genConst >>* fst), (20, genNewItem False >>* fst)] (do upper <- frequency' [(80, genConst >>* fst), (20, genNewItem False >>* fst)]
itemCount <- lift $ choose (1,6) itemCount <- lift $ choose (1,6)
items <- replicateM itemCount (genNewItem False >>* fst) items <- replicateM itemCount (genNewItem True)
return (items, upper) return (items, upper)
) )
return (makeResults vm items upper, ParItems $ map (\(x,_) -> SeqItems [[x]]) items, fst upper) return (makeResults vm items upper, ParItems $ map (\((x,_),_) -> SeqItems [[x]]) items, fst upper)
where where
makeResults :: VarMap -> makeResults :: VarMap ->
[GenEqItems] -> [(GenEqItems, FlattenedExp)] ->
GenEqItems -> GenEqItems ->
[((A.Expression, A.Expression),VarMap,[HandyEq],[HandyIneq])] [((A.Expression, A.Expression),VarMap,[HandyEq],[HandyIneq])]
makeResults vm items upper = map (flip (makeResult vm) upper) (allPairs items) makeResults vm items upper = concatMap (flip (makeResult vm) upper) (allPairs items)
makeResult :: VarMap -> (GenEqItems, GenEqItems) -> GenEqItems -> ((A.Expression, A.Expression),VarMap,[HandyEq],[HandyIneq]) makeResult :: VarMap -> ((GenEqItems, FlattenedExp), (GenEqItems, FlattenedExp)) -> GenEqItems -> [((A.Expression, A.Expression),VarMap,[HandyEq],[HandyIneq])]
makeResult vm ((ex,x),(ey,y)) (_,u) = ((ex, ey), vm, [x === y], leq [con 0, x, u ++ con (-1)] &&& leq [con 0, y, u ++ con (-1)]) makeResult vm (((ex,x),fx),((ey,y),fy)) (_,u) = mkItem (ex, moduloEq vm fx) (ey, moduloEq vm fy)
where
mkItem :: (A.Expression, [([(CoeffIndex, Integer)], [HandyEq], [HandyIneq])]) ->
(A.Expression, [([(CoeffIndex, Integer)], [HandyEq], [HandyIneq])]) ->
[((A.Expression, A.Expression),VarMap,[HandyEq],[HandyIneq])]
mkItem (ex, xinfo) (ey, yinfo) = map (\(eq,ineq) -> ((ex,ey),vm,eq,ineq)) $ map (uncurry joinItems) (product2 (xinfo, yinfo))
joinItems :: ([(CoeffIndex, Integer)], [HandyEq], [HandyIneq]) ->
([(CoeffIndex, Integer)], [HandyEq], [HandyIneq]) ->
([HandyEq],[HandyIneq])
joinItems (x, xEq, xIneq) (y, yEq, yIneq) = ([x === y] &&& xEq &&& yEq, xIneq &&& yIneq &&& arrayBound x u &&& arrayBound y u)
arrayBound :: [(CoeffIndex, Integer)] -> [(CoeffIndex, Integer)] -> [HandyIneq]
arrayBound x u = leq [con 0, x, u ++ con (-1)]
moduloEq :: VarMap -> FlattenedExp -> [([(CoeffIndex, Integer)], [HandyEq], [HandyIneq])]
moduloEq vm m@(Modulo top bottom) = let topVar = lookupF (Set.findMin top {-TODO-} ) vm in let modVar = lookupF m vm in case onlyConst (Set.toList bottom) of
Just c -> [ ([(0,0)], [topVar === con 0], [])
, (topVar ++ (abs c)**modVar, [], [topVar >== con 1, modVar <== con 0] &&& leq [con 0, topVar ++ (abs c)**modVar, con (abs c - 1)])
, (topVar ++ (abs c)**modVar, [], [topVar <== con (-1), modVar >== con 0] &&& leq [con (1 - abs c), topVar ++ (abs c)**modVar, con 0])
]
Nothing -> [] --TODO (variable divisor)
-- TODO add divide here with equations
moduloEq vm exp = [(lookupF exp vm, [], [])]
lookupF :: FlattenedExp -> VarMap -> [(CoeffIndex, Integer)]
lookupF (Const c) _ = con c
lookupF f@(Scale a v) vm = [(fromJust $ Map.lookup f vm, a)]
lookupF f@(Modulo t b) vm = [(fromJust $ Map.lookup f vm, 1)]
lookupF f@(Divide t b) vm = [(fromJust $ Map.lookup f vm, 1)]
qcTestMakeEquations :: [LabelledQuickCheckTest] qcTestMakeEquations :: [LabelledQuickCheckTest]
qcTestMakeEquations = [("Turning Code Into Equations", scaleQC (100,100,100,100) prop)] qcTestMakeEquations = [("Turning Code Into Equations", scaleQC (100,100,100,100) prop)]