diff --git a/checks/ArrayUsageCheck.hs b/checks/ArrayUsageCheck.hs index de7e13b..245f600 100644 --- a/checks/ArrayUsageCheck.hs +++ b/checks/ArrayUsageCheck.hs @@ -16,7 +16,7 @@ You should have received a copy of the GNU General Public License along with this program. If not, see . -} -module ArrayUsageCheck (BackgroundKnowledge(..), checkArrayUsage, FlattenedExp(..), makeEquations, makeExpSet, ModuloCase(..), onlyConst, VarMap) where +module ArrayUsageCheck (BackgroundKnowledge(..), checkArrayUsage, FlattenedExp(..), makeEquations, makeExpSet, ModuloCase(..), onlyConst, showFlattenedExp, VarMap) where import Control.Monad.Error import Control.Monad.State @@ -135,7 +135,7 @@ checkArrayUsage (m,p) = mapM_ (checkIndexes m) $ Map.toList $ showItem :: (CoeffIndex, Integer) -> m String showItem (n, a) = case find ((== n) . snd) $ Map.assocs varToIndex of - Just (exp,_) -> showFlattenedExp exp >>* (mult ++) + Just (exp,_) -> showFlattenedExp showCode exp >>* (mult ++) Nothing -> return "" where mult = case a of @@ -150,42 +150,42 @@ checkArrayUsage (m,p) = mapM_ (checkIndexes m) $ Map.toList $ where valOfVar (varExp,k) = case Map.lookup k indexToConst of Nothing -> return Nothing - Just val -> do varExp' <- showFlattenedExp varExp + Just val -> do varExp' <- showFlattenedExp showCode varExp return $ Just $ varExp' ++ " = " ++ show val -- TODO this is surely defined elsewhere already? getRealName :: A.Name -> m String getRealName n = lookupName n >>* A.ndOrigName - - -- Shows a FlattenedExp legibly by looking up real names for variables, and formatting things. - -- The output for things involving modulo might be a bit odd, but there isn't really anything - -- much that can be done about that - showFlattenedExp :: FlattenedExp -> m String - showFlattenedExp (Const n) = return $ show n - showFlattenedExp (Scale n (e,vi)) - = do vn' <- showCode e >>* (++ replicate vi '\'') - return $ showScale vn' n - showFlattenedExp (Modulo n top bottom) - = do top' <- showFlattenedExpSet top - bottom' <- showFlattenedExpSet bottom - case onlyConst (Set.toList bottom) of - 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 $ showScale ("(" ++ top' ++ " / " ++ bottom' ++ ")") n - - showScale :: String -> Integer -> String - showScale s n = + +showFlattenedExpSet :: Monad m => (A.Expression -> m String) -> Set.Set FlattenedExp -> m String +showFlattenedExpSet showExp s = liftM concat $ sequence $ intersperse (return " + ") $ map (showFlattenedExp showExp) $ Set.toList s + +-- Shows a FlattenedExp legibly by looking up real names for variables, and formatting things. +-- The output for things involving modulo might be a bit odd, but there isn't really anything +-- much that can be done about that +showFlattenedExp :: Monad m => (A.Expression -> m String) -> FlattenedExp -> m String +showFlattenedExp _ (Const n) = return $ show n +showFlattenedExp showExp (Scale n (e,vi)) + = do vn' <- showExp e >>* (++ replicate vi '\'') + return $ showScale vn' n +showFlattenedExp showExp (Modulo n top bottom) + = do top' <- showFlattenedExpSet showExp top + bottom' <- showFlattenedExpSet showExp bottom + case onlyConst (Set.toList bottom) of + Just _ -> return $ showScale ("(" ++ top' ++ " / " ++ bottom' ++ ")") (-n) + Nothing -> return $ showScale ("((" ++ top' ++ " REM " ++ bottom' ++ ") - " ++ top' ++ ")") n +showFlattenedExp showExp (Divide n top bottom) + = do top' <- showFlattenedExpSet showExp top + bottom' <- showFlattenedExpSet showExp 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 - -- | A type for inside makeEquations: data FlattenedExp = Const Integer @@ -201,7 +201,6 @@ data 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 a == b = EQ == compare a b diff --git a/checks/ArrayUsageCheckTest.hs b/checks/ArrayUsageCheckTest.hs index 1909c21..b916950 100644 --- a/checks/ArrayUsageCheckTest.hs +++ b/checks/ArrayUsageCheckTest.hs @@ -42,6 +42,9 @@ import TestUtils hiding (m) import UsageCheckUtils hiding (Var) import Utils +instance Show FlattenedExp where + show fexp = runIdentity $ showFlattenedExp (return . showOccam) fexp + testArrayCheck :: Test testArrayCheck = TestList [