Added a coefficient for modulo and divide items
This commit is contained in:
Neil Brown
parent
c6b384d5d6
commit
25be01cb47
|
|
@ -163,21 +163,25 @@ checkArrayUsage (m,p) = mapM_ (checkIndexes m) $ Map.toList $
|
|||
showFlattenedExp (Const n) = return $ show n
|
||||
showFlattenedExp (Scale n ((A.Variable _ vn),vi))
|
||||
= do vn' <- getRealName vn >>* (++ replicate vi '\'')
|
||||
case n of
|
||||
1 -> return vn'
|
||||
-1 -> return $ "-" ++ vn'
|
||||
_ -> return $ (show n) ++ "*" ++ vn'
|
||||
showFlattenedExp (Modulo top bottom)
|
||||
return $ showScale vn' n
|
||||
showFlattenedExp (Modulo n top bottom)
|
||||
= do top' <- showFlattenedExpSet top
|
||||
bottom' <- showFlattenedExpSet bottom
|
||||
case onlyConst (Set.toList bottom) of
|
||||
Just _ -> return $ "-(" ++ top' ++ " / " ++ bottom' ++ ")"
|
||||
Nothing -> return $ "((" ++ top' ++ " REM " ++ bottom' ++ ") - " ++ top' ++ ")"
|
||||
showFlattenedExp (Divide top bottom)
|
||||
Just _ -> return $ showScale ("(" ++ top' ++ " / " ++ bottom' ++ ")") (-n)
|
||||
Nothing -> return $ showScale ("((" ++ top' ++ " REM " ++ bottom' ++ ") - " ++ top' ++ ")") n
|
||||
showFlattenedExp (Divide n top bottom)
|
||||
= do top' <- showFlattenedExpSet top
|
||||
bottom' <- showFlattenedExpSet bottom
|
||||
return $ "(" ++ top' ++ " / " ++ bottom' ++ ")"
|
||||
return $ showScale ("(" ++ top' ++ " / " ++ bottom' ++ ")") n
|
||||
|
||||
showScale :: String -> Integer -> String
|
||||
showScale s n =
|
||||
case n of
|
||||
1 -> s
|
||||
-1 -> "-" ++ s
|
||||
_ -> (show n) ++ "*" ++ s
|
||||
|
||||
showFlattenedExpSet :: Set.Set FlattenedExp -> m String
|
||||
showFlattenedExpSet s = liftM concat $ sequence $ intersperse (return " + ") $ map showFlattenedExp $ Set.toList s
|
||||
|
||||
|
|
@ -192,10 +196,10 @@ data FlattenedExp
|
|||
-- against a sub-indexed (with "1") version (denoted "i'"). The sub-index
|
||||
-- is what differentiates i from i', given that they are technically the
|
||||
-- same A.Variable
|
||||
| Modulo (Set.Set FlattenedExp) (Set.Set FlattenedExp)
|
||||
-- ^ A modulo, with the given top and bottom (in that order)
|
||||
| Divide (Set.Set FlattenedExp) (Set.Set FlattenedExp)
|
||||
-- ^ An integer division, with the given top and bottom (in that order)
|
||||
| Modulo Integer (Set.Set FlattenedExp) (Set.Set FlattenedExp)
|
||||
-- ^ A modulo, with a coefficient/scale and given top and bottom (in that order)
|
||||
| Divide Integer (Set.Set FlattenedExp) (Set.Set FlattenedExp)
|
||||
-- ^ An integer division, with a coefficient/scale and the given top and bottom (in that order)
|
||||
deriving (Show)
|
||||
|
||||
instance Eq FlattenedExp where
|
||||
|
|
@ -211,11 +215,11 @@ instance Ord FlattenedExp where
|
|||
compare (Scale _ (lv,li)) (Scale _ (rv,ri)) = combineCompare [customVarCompare lv rv, compare li ri]
|
||||
compare (Scale {}) _ = LT
|
||||
compare _ (Scale {}) = GT
|
||||
compare (Modulo ltop lbottom) (Modulo rtop rbottom)
|
||||
compare (Modulo _ ltop lbottom) (Modulo _ rtop rbottom)
|
||||
= combineCompare [compare ltop rtop, compare lbottom rbottom]
|
||||
compare (Modulo {}) _ = LT
|
||||
compare _ (Modulo {}) = GT
|
||||
compare (Divide ltop lbottom) (Divide rtop rbottom)
|
||||
compare (Divide _ ltop lbottom) (Divide _ rtop rbottom)
|
||||
= combineCompare [compare ltop rtop, compare lbottom rbottom]
|
||||
|
||||
-- | Checks if an expression list contains only constants. Returns Just (the aggregate constant) if so,
|
||||
|
|
@ -374,11 +378,11 @@ makeEquations otherInfo accesses bound
|
|||
setIndexVar' tv ti s@(Scale n (v,_))
|
||||
| EQ == customVarCompare tv v = Scale n (v,ti)
|
||||
| otherwise = s
|
||||
setIndexVar' tv ti (Modulo top bottom) = Modulo top' bottom'
|
||||
setIndexVar' tv ti (Modulo n top bottom) = Modulo n top' bottom'
|
||||
where
|
||||
top' = Set.map (setIndexVar' tv ti) top
|
||||
bottom' = Set.map (setIndexVar' tv ti) bottom
|
||||
setIndexVar' tv ti (Divide top bottom) = Divide top' bottom'
|
||||
setIndexVar' tv ti (Divide n top bottom) = Divide n top' bottom'
|
||||
where
|
||||
top' = Set.map (setIndexVar' tv ti) top
|
||||
bottom' = Set.map (setIndexVar' tv ti) bottom
|
||||
|
|
@ -493,8 +497,8 @@ flatten (A.ExprVariable _ v) = return [Scale 1 (v,0)]
|
|||
flatten (A.Dyadic m op lhs rhs) | op == A.Add = combine' (flatten lhs) (flatten rhs)
|
||||
| op == A.Subtr = combine' (flatten lhs) (mapM (scale (-1)) =<< flatten rhs)
|
||||
| op == A.Mul = multiplyOut' (flatten lhs) (flatten rhs)
|
||||
| op == A.Rem = liftM2L Modulo (flatten lhs) (flatten rhs)
|
||||
| op == A.Div = liftM2L Divide (flatten lhs) (flatten rhs)
|
||||
| op == A.Rem = liftM2L (Modulo 1) (flatten lhs) (flatten rhs)
|
||||
| op == A.Div = liftM2L (Divide 1) (flatten lhs) (flatten rhs)
|
||||
| otherwise = throwError ("Unhandleable operator found in expression: " ++ show op)
|
||||
where
|
||||
-- liftM2L :: (Ord a, Ord b, Monad m) => (Set.Set a -> Set.Set b -> c) -> m [a] -> m [b] -> m [c]
|
||||
|
|
@ -618,7 +622,7 @@ varIndex (Scale _ (var@(A.Variable _ (A.Name _ _ varName)),vi))
|
|||
(Map.insert (Scale 1 (var,vi)) newId st, newId)
|
||||
put st'
|
||||
return ind
|
||||
varIndex mod@(Modulo top bottom)
|
||||
varIndex mod@(Modulo _ top bottom)
|
||||
= do st <- get
|
||||
let (st',ind) = case Map.lookup mod st of
|
||||
Just val -> (st,val)
|
||||
|
|
@ -692,7 +696,7 @@ makeEquation l t summedItems
|
|||
[([ModuloCase], Map.Map Int Integer,[Map.Map Int Integer], [Map.Map Int Integer])]
|
||||
makeEquation' m (Const n) = return $ add (0,n) m
|
||||
makeEquation' m sc@(Scale n v) = varIndex sc >>* (\ind -> add (ind, n) m)
|
||||
makeEquation' m mod@(Modulo top bottom)
|
||||
makeEquation' m mod@(Modulo _ top bottom) -- TODO use the scale properly
|
||||
= do top' <- process (Set.toList top) >>* map (\(_,a,b,c) -> (a,b,c))
|
||||
top'' <- getSingleItem "Modulo or divide not allowed in the numerator of Modulo" top'
|
||||
bottom' <- process (Set.toList bottom) >>* map (\(_,a,b,c) -> (a,b,c))
|
||||
|
|
@ -783,7 +787,7 @@ makeEquation l t summedItems
|
|||
(False, False, True ) -> XNegYNegANonZero
|
||||
(False, False, False) -> XNegYNegAZero
|
||||
|
||||
makeEquation' m (Divide top bottom) = throwError "TODO Divide"
|
||||
makeEquation' m (Divide _ top bottom) = throwError "TODO Divide"
|
||||
|
||||
empty :: [([ModuloCase],Map.Map Int Integer,[Map.Map Int Integer], [Map.Map Int Integer])]
|
||||
empty = [([],Map.empty,[],[])]
|
||||
|
|
|
|||
|
|
@ -477,16 +477,16 @@ testMakeEquations = TestLabel "testMakeEquations" $ TestList
|
|||
ijk_mapping :: VarMap
|
||||
ijk_mapping = Map.fromList [(Scale 1 $ (variable "i",0),1),(Scale 1 $ (variable "j",0),2),(Scale 1 $ (variable "k",0),3)]
|
||||
i_mod_mapping :: Integer -> VarMap
|
||||
i_mod_mapping n = Map.fromList [(Scale 1 $ (variable "i",0),1),(Modulo (Set.singleton $ Scale 1 $ (variable "i",0)) (Set.singleton $ Const n),2)]
|
||||
i_mod_mapping n = Map.fromList [(Scale 1 $ (variable "i",0),1),(Modulo 1 (Set.singleton $ Scale 1 $ (variable "i",0)) (Set.singleton $ Const n),2)]
|
||||
i_mod_j_mapping :: VarMap
|
||||
i_mod_j_mapping = Map.fromList [(Scale 1 $ (variable "i",0),1),(Scale 1 $ (variable "j",0),2),
|
||||
(Modulo (Set.singleton $ Scale 1 $ (variable "i",0)) (Set.singleton $ Scale 1 $ (variable "j",0)),3)]
|
||||
(Modulo 1 (Set.singleton $ Scale 1 $ (variable "i",0)) (Set.singleton $ Scale 1 $ (variable "j",0)),3)]
|
||||
_3i_2j_mod_mapping n = Map.fromList [(Scale 1 $ (variable "i",0),1),(Scale 1 $ (variable "j",0),2),
|
||||
(Modulo (Set.fromList [(Scale 3 $ (variable "i",0)),(Scale (-2) $ (variable "j",0))]) (Set.singleton $ Const n),3)]
|
||||
(Modulo 1 (Set.fromList [(Scale 3 $ (variable "i",0)),(Scale (-2) $ (variable "j",0))]) (Set.singleton $ Const n),3)]
|
||||
-- i REM m, i + 1 REM n
|
||||
i_ip1_mod_mapping m n = Map.fromList [(Scale 1 $ (variable "i",0),1)
|
||||
,(Modulo (Set.singleton $ Scale 1 $ (variable "i",0)) (Set.singleton $ Const m),2)
|
||||
,(Modulo (Set.fromList [Scale 1 $ (variable "i",0), Const 1]) (Set.singleton $ Const n),3)
|
||||
,(Modulo 1 (Set.singleton $ Scale 1 $ (variable "i",0)) (Set.singleton $ Const m),2)
|
||||
,(Modulo 1 (Set.fromList [Scale 1 $ (variable "i",0), Const 1]) (Set.singleton $ Const n),3)
|
||||
]
|
||||
|
||||
rep_i_mapping :: VarMap
|
||||
|
|
@ -498,8 +498,8 @@ testMakeEquations = TestLabel "testMakeEquations" $ TestList
|
|||
|
||||
rep_i_mod_mapping :: Integer -> VarMap
|
||||
rep_i_mod_mapping n = Map.fromList [((Scale 1 (variable "i",0)),1), ((Scale 1 (variable "i",1)),2)
|
||||
,(Modulo (Set.singleton $ Scale 1 $ (variable "i",0)) (Set.singleton $ Const n),3)
|
||||
,(Modulo (Set.singleton $ Scale 1 $ (variable "i",1)) (Set.singleton $ Const n),4)]
|
||||
,(Modulo 1 (Set.singleton $ Scale 1 $ (variable "i",0)) (Set.singleton $ Const n),3)
|
||||
,(Modulo 1 (Set.singleton $ Scale 1 $ (variable "i",1)) (Set.singleton $ Const n),4)]
|
||||
|
||||
-- Helper functions for i REM 2 vs (i + 1) REM 4. Each one is a pair of equalities, inequalities
|
||||
rr_i_zero = ([i === con 0], leq [con 0,con 0,con 7])
|
||||
|
|
@ -562,7 +562,7 @@ genNewItem specialAllowed
|
|||
((eB,iB),fB) <- genNewItem False
|
||||
m <- get
|
||||
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 1 (Set.singleton fT) (Set.singleton fB), nextId)
|
||||
)]
|
||||
modify (Map.insert fexp nextId)
|
||||
return ((exp, [(nextId,1)]), fexp)
|
||||
|
|
@ -572,9 +572,10 @@ genConst = do val <- lift $ choose (1, 10)
|
|||
let exp = intLiteral val
|
||||
return ((exp, [(0,val)]), Const val)
|
||||
|
||||
genNewExp :: StateT VarMap Gen (GenEqItems, [FlattenedExp])
|
||||
genNewExp = do num <- lift $ choose (1,4)
|
||||
items <- replicateM num $ frequency' [(20, maybeMult genConst), (80, maybeMult $ genNewItem True)]
|
||||
genNewExp :: Bool -> StateT VarMap Gen (GenEqItems, [FlattenedExp])
|
||||
genNewExp specialAllowed
|
||||
= do num <- lift $ choose (1,4)
|
||||
items <- replicateM num $ frequency' [(20, maybeMult genConst), (80, maybeMult $ genNewItem specialAllowed)]
|
||||
return $ fromJust $ foldl join Nothing items
|
||||
where
|
||||
maybeMult :: StateT VarMap Gen (GenEqItems, FlattenedExp) -> StateT VarMap Gen (GenEqItems, FlattenedExp)
|
||||
|
|
@ -631,24 +632,24 @@ generateEquationInput
|
|||
arrayBound x u = leq [con 0, x, u ++ con (-1)]
|
||||
|
||||
moduloEq :: VarMap -> FlattenedExp -> [([ModuloCase], [(CoeffIndex, Integer)], [HandyEq], [HandyIneq])]
|
||||
moduloEq vm m@(Modulo top bottom) =
|
||||
moduloEq vm m@(Modulo n top bottom) =
|
||||
let topVar = lookupF (Set.findMin top {-TODO-} ) vm
|
||||
botVar = lookupF (Set.findMin bottom {-TODO-} ) vm
|
||||
modVar = lookupF m vm
|
||||
in case onlyConst (Set.toList bottom) of
|
||||
Just c -> let v = topVar ++ (abs c)**modVar in
|
||||
Just c -> let v = n**(topVar ++ (abs c)**modVar) in
|
||||
|
||||
[ ([XZero], [(0,0)], [topVar === con 0], [])
|
||||
[ ([XZero], [(0,0)], [n**topVar === con 0], [])
|
||||
, ([XPos], v, [], [topVar >== con 1, modVar <== con 0] &&& leq [con 0, v, con (abs c - 1)])
|
||||
, ([XNeg], v, [], [topVar <== con (-1), modVar >== con 0] &&& leq [con (1 - abs c), v, con 0])
|
||||
]
|
||||
Nothing -> let v = topVar ++ modVar in
|
||||
[ ([XZero], [(0,0)], [topVar === con 0], []) -- TODO stop the divisor being zero
|
||||
Nothing -> let v = n**(topVar ++ modVar) in
|
||||
[ ([XZero], [(0,0)], [n**topVar === con 0], []) -- TODO stop the divisor being zero
|
||||
|
||||
, ([XPosYPosAZero], topVar, [], [topVar >== con 1] &&& leq [con 0, topVar, botVar ++ con (-1)])
|
||||
, ([XPosYNegAZero], topVar, [], [topVar >== con 1] &&& leq [con 0, topVar, (-1)**botVar ++ con (-1)])
|
||||
, ([XNegYPosAZero], topVar, [], [topVar <== con (-1)] &&& leq [(-1)**botVar ++ con 1, topVar, con 0])
|
||||
, ([XNegYNegAZero], topVar, [], [topVar <== con (-1)] &&& leq [botVar ++ con 1, topVar, con 0])
|
||||
, ([XPosYPosAZero], n**topVar, [], [topVar >== con 1] &&& leq [con 0, topVar, botVar ++ con (-1)])
|
||||
, ([XPosYNegAZero], n**topVar, [], [topVar >== con 1] &&& leq [con 0, topVar, (-1)**botVar ++ con (-1)])
|
||||
, ([XNegYPosAZero], n**topVar, [], [topVar <== con (-1)] &&& leq [(-1)**botVar ++ con 1, topVar, con 0])
|
||||
, ([XNegYNegAZero], n**topVar, [], [topVar <== con (-1)] &&& leq [botVar ++ con 1, topVar, con 0])
|
||||
|
||||
, ([XPosYPosANonZero], v, [], [topVar >== con 1, modVar <== (-1)**botVar] &&& leq [con 0, v, botVar ++ con (-1)])
|
||||
, ([XPosYNegANonZero], v, [], [topVar >== con 1, modVar <== botVar] &&& leq [con 0, v, (-1)**botVar ++ con (-1)])
|
||||
|
|
@ -663,8 +664,8 @@ generateEquationInput
|
|||
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)]
|
||||
lookupF f@(Modulo a t b) vm = [(fromJust $ Map.lookup f vm, a)]
|
||||
lookupF f@(Divide a t b) vm = [(fromJust $ Map.lookup f vm, a)]
|
||||
|
||||
qcTestMakeEquations :: [LabelledQuickCheckTest]
|
||||
qcTestMakeEquations = [("Turning Code Into Equations", scaleQC (100,1000,5000,10000) prop)]
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user