refactor: style, fun, hlint, ...

[mate.git] / Mate / BasicBlocks.hs

diff --git a/Mate/BasicBlocks.hs b/Mate/BasicBlocks.hs
index b52f22d2c4a9e4b5f246f408572784613d67cf4e..fbb61f7a06ecf6a471d5b33385953f58228ee19b 100644 (file)
--- a/Mate/BasicBlocks.hs
+++ b/Mate/BasicBlocks.hs
@@ -8,7 +8,6 @@ module Mate.BasicBlocks(
   MapBB,
 #ifdef DBG_BB
   printMapBB,
-  test_main,
 #endif
   parseMethod,
   testCFG -- added by hs to perform benches from outside
@@ -26,6 +25,7 @@ import JVM.Assembler
 
 import Mate.Types
 import Mate.Debug
+import Mate.Utilities
 
 #ifdef DEBUG
 import Text.Printf
@@ -41,7 +41,7 @@ printMapBB :: Maybe MapBB -> IO ()
 printMapBB Nothing = putStrLn "No BasicBlock"
 printMapBB (Just hmap) = do
                      putStr "BlockIDs: "
-                     let keys = fst $ unzip $ M.toList hmap
+                     let keys = M.keys hmap
                      mapM_ (putStr . (flip (++)) ", " . show) keys
                      putStrLn "\n\nBasicBlocks:"
                      printMapBB' keys hmap
@@ -61,11 +61,12 @@ printMapBB (Just hmap) = do
                   Nothing -> error $ "BlockID " ++ show i ++ " not found."
 #endif
 
+#if 0
 #ifdef DBG_BB
-testInstance :: String -> B.ByteString -> IO ()
-testInstance cf method = do
+testInstance :: String -> B.ByteString -> MethodSignature -> IO ()
+testInstance cf method sig = do
                       cls <- parseClassFile cf
-                      hmap <- parseMethod cls method
+                      hmap <- parseMethod cls method sig
                       printMapBB hmap
 #endif
 
@@ -83,11 +84,12 @@ test_02 = testInstance "./tests/While.class" "f"
 test_03 = testInstance "./tests/While.class" "g"
 test_04 = testInstance "./tests/Fac.class" "fac"
 #endif
+#endif
 
 
-parseMethod :: Class Direct -> B.ByteString -> IO (Maybe MapBB)
-parseMethod cls method = do
-                     let maybe_bb = testCFG $ lookupMethod method cls
+parseMethod :: Class Direct -> B.ByteString -> MethodSignature -> IO (Maybe MapBB)
+parseMethod cls method sig = do
+                     let maybe_bb = testCFG $ lookupMethodSig method sig cls
                      let msig = methodSignature $ classMethods cls !! 1
                      printfBb "BB: analysing \"%s\"\n" $ toString (method `B.append` ": " `B.append` encode msig)
 #ifdef DBG_BB
@@ -96,7 +98,7 @@ parseMethod cls method = do
                      -- small example how to get information about
                      -- exceptions of a method
                      -- TODO: remove ;-)
-                     let (Just m) = lookupMethod method cls
+                     let (Just m) = lookupMethodSig method sig cls
                      case attrByName m "Code" of
                       Nothing -> printfBb "exception: no handler for this method\n"
                       Just exceptionstream -> printfBb "exception: \"%s\"\n" (show $ codeExceptions $ decodeMethod exceptionstream)
@@ -104,10 +106,10 @@ parseMethod cls method = do
 
 
 testCFG :: Maybe (Method Direct) -> Maybe MapBB
-testCFG (Just m) = case attrByName m "Code" of
-       Nothing -> Nothing
-       Just bytecode -> Just $ buildCFG $ codeInstructions $ decodeMethod bytecode
-testCFG _ = Nothing
+testCFG m = do
+  m' <- m
+  bytecode <- attrByName m' "Code"
+  return $ buildCFG $ codeInstructions $ decodeMethod bytecode
 
 
 buildCFG :: [Instruction] -> MapBB
@@ -193,6 +195,8 @@ calculateInstructionOffset = cio' (0, Nothing)
       IF _ w16 -> twotargets w16
       IF_ICMP _ w16 -> twotargets w16
       IF_ACMP _ w16 -> twotargets w16
+      IFNONNULL w16 -> twotargets w16
+      IFNULL w16 -> twotargets w16
       GOTO w16 -> onetarget w16
       IRETURN -> notarget
       ARETURN -> notarget