From 25be01cb47ece2f5d52e14016596dfce2136834b Mon Sep 17 00:00:00 2001 From: Neil Brown Date: Sat, 9 Feb 2008 15:08:10 +0000 Subject: [PATCH] Added a coefficient for modulo and divide items --- checks/ArrayUsageCheck.hs | 48 +++++++++++++++++++---------------- checks/ArrayUsageCheckTest.hs | 45 ++++++++++++++++---------------- 2 files changed, 49 insertions(+), 44 deletions(-) diff --git a/checks/ArrayUsageCheck.hs b/checks/ArrayUsageCheck.hs index 8d434e1..44b54a4 100644 --- a/checks/ArrayUsageCheck.hs +++ b/checks/ArrayUsageCheck.hs @@ -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,[],[])] diff --git a/checks/ArrayUsageCheckTest.hs b/checks/ArrayUsageCheckTest.hs index 08a2dad..4d4590c 100644 --- a/checks/ArrayUsageCheckTest.hs +++ b/checks/ArrayUsageCheckTest.hs @@ -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)]