instanceOf: also consider interfaces

diff --git a/Mate/ClassHierarchy.hs b/Mate/ClassHierarchy.hs
index 628d426f41fe62fe7e9f4793daf6580bf1664f66..67c6a180359ee3a3fc095414c51da9b6fe94e878 100644 (file)
--- a/Mate/ClassHierarchy.hs
+++ b/Mate/ClassHierarchy.hs
@@ -1,15 +1,16 @@
 module Mate.ClassHierarchy
   ( isInstanceOf
   , addClassEntry
+  , addInterfaceEntry
   ) where
 
 import qualified Data.Map as M
 import qualified Data.ByteString.Lazy as B
-import Control.Applicative
+import Data.List
 import Control.Monad
-import Text.Printf
 
-import Foreign
+import Foreign hiding (unsafePerformIO)
+import System.IO.Unsafe
 import Data.IORef
 
 import Mate.NativeSizes
@@ -17,54 +18,77 @@ import Mate.ClassPool
 
 
 data Class
-  = Class
-    { clMtable :: NativeWord
-    , clSuperClass :: NativeWord
-    , clInterfaces :: [Interface]
-    }
+  = Class NativeWord [B.ByteString]
   | JavaLangObject
-    { clMtable :: NativeWord
-    }
 
-data Interface
-  = Interface
-    { ifSuperInterfaces :: [Interface]
-    }
-
-type HierMap = (M.Map NativeWord Class)
-classHier :: IORef HierMap
+type ClassHier = M.Map NativeWord Class
+classHier :: IORef ClassHier
 {-# NOINLINE classHier #-}
 classHier = unsafePerformIO $ newIORef M.empty
 
-readHier :: IO HierMap
-readHier = readIORef classHier
+type InterfaceHier = M.Map B.ByteString [B.ByteString]
+interfaceHier :: IORef InterfaceHier
+{-# NOINLINE interfaceHier #-}
+interfaceHier = unsafePerformIO $ newIORef M.empty
+
+readClass :: IO ClassHier
+readClass = readIORef classHier
+readInterface :: IO InterfaceHier
+readInterface = readIORef interfaceHier
 
-writeHier :: HierMap -> IO ()
-writeHier = writeIORef classHier
+writeClass :: ClassHier -> IO ()
+writeClass = writeIORef classHier
+writeInterface :: InterfaceHier -> IO ()
+writeInterface = writeIORef interfaceHier
 
 
 isInstanceOf :: NativeWord -> B.ByteString -> IO Bool
 isInstanceOf 0 _ = return False
 isInstanceOf obj classname = do
   obj_mtable <- peek (intPtrToPtr . fromIntegral $ obj)
-  class_mtable <- getMethodTable classname
-  ch <- readHier
-  return $ checkInstance obj_mtable class_mtable ch
+  ch <- readClass
+  ih <- readInterface
+  if M.member classname ih
+    then do -- interface check
+      let ai = allInterfaces obj_mtable ch
+      return $ checkInterfaces ai classname ih
+    else do -- class check
+      class_mtable <- getMethodTable classname
+      return $ checkInstance obj_mtable class_mtable ch
+
+allInterfaces :: NativeWord -> ClassHier -> [B.ByteString]
+allInterfaces obj_mtable ch =
+  case ch M.! obj_mtable of
+    JavaLangObject -> []
+    Class superclass ifaces -> ifaces ++ allInterfaces superclass ch
 
-checkInstance :: NativeWord -> NativeWord -> HierMap -> Bool
+checkInterfaces :: [B.ByteString] -> B.ByteString -> InterfaceHier -> Bool
+checkInterfaces [] _ _ = False
+checkInterfaces ifaces target ih
+  | target `elem` ifaces = True
+  | otherwise = checkInterfaces (nextifaces \\ ifaces) target ih
+    where
+      nextifaces = concatMap (\x -> ih M.! x) ifaces
+
+checkInstance :: NativeWord -> NativeWord -> ClassHier -> Bool
 checkInstance obj cl_mtable ch
   | obj == cl_mtable = True
   | otherwise =
       case ch M.! obj of
-        Class _ super _ -> checkInstance super cl_mtable ch
-        JavaLangObject _ -> False
-
-addClassEntry :: NativeWord -> NativeWord -> IO ()
-addClassEntry mtable 0 = do
-  ch <- readHier
-  writeHier (M.insert mtable (JavaLangObject mtable) ch)
-addClassEntry mtable super_mtable = do
-  ch <- readHier
-  when (not $ M.member super_mtable ch) $ error "classhierarchy: superclass should be in hierarchy!"
-  let cl = Class mtable super_mtable []
-  writeHier (M.insert mtable cl ch)
+        Class super _ -> checkInstance super cl_mtable ch
+        JavaLangObject -> False
+
+addClassEntry :: NativeWord -> NativeWord -> [B.ByteString] -> IO ()
+addClassEntry mtable 0 _ = do
+  ch <- readClass
+  writeClass (M.insert mtable JavaLangObject ch)
+addClassEntry mtable super_mtable ifaces = do
+  ch <- readClass
+  unless (M.member super_mtable ch) $ error "classhierarchy: superclass should be in hierarchy!"
+  writeClass (M.insert mtable (Class super_mtable ifaces) ch)
+
+addInterfaceEntry :: B.ByteString -> [B.ByteString] -> IO ()
+addInterfaceEntry iface super_ifaces = do
+  ch <- readInterface
+  -- TODO: check super if's
+  writeInterface (M.insert iface super_ifaces ch)

diff --git a/Mate/ClassHierarchy.hs-boot b/Mate/ClassHierarchy.hs-boot
index f274b8393e835572c364207791ebb05656b06bdd..9a0febeebf843b7e51ac1c5fe5b1e0d93ca2f777 100644 (file)
--- a/Mate/ClassHierarchy.hs-boot
+++ b/Mate/ClassHierarchy.hs-boot
@@ -1,10 +1,12 @@
 module Mate.ClassHierarchy
   ( isInstanceOf
   , addClassEntry
+  , addInterfaceEntry
   ) where
 
 import qualified Data.ByteString.Lazy as B
 import Mate.NativeSizes
 
 isInstanceOf :: NativeWord -> B.ByteString -> IO Bool
-addClassEntry :: NativeWord -> NativeWord -> IO ()
+addClassEntry :: NativeWord -> NativeWord -> [B.ByteString] -> IO ()
+addInterfaceEntry :: B.ByteString -> [B.ByteString] -> IO ()

diff --git a/Mate/ClassPool.hs b/Mate/ClassPool.hs
index 0e188a6f5a80f22f6ad0ca972d4c0067859437e2..8b1cb4107c7f1c7216c30ef7327582ba21324c75 100644 (file)
--- a/Mate/ClassPool.hs
+++ b/Mate/ClassPool.hs
@@ -171,7 +171,7 @@ readClass path = do
       super_mtable <- case superclass of
         Nothing -> return 0
         Just x -> getMethodTable $ ciName x
-      addClassEntry mbase super_mtable
+      addClassEntry mbase super_mtable (interfaces cfile)
 
       return new_ci
 
@@ -196,7 +196,7 @@ loadInterface path = do
       -- create index of methods by this interface
       let mm = zipbase max_off (classMethods cfile)
 
-      -- create for each method from *every* superinterface a entry to,
+      -- create for each method from *every* superinterface an entry too,
       -- but just put in the same offset as it is already in the map
       let (ifnames, methodnames) = unzip $ concat
             [ zip (repeat ifname) (classMethods $ imap' M.! ifname)
@@ -206,6 +206,9 @@ loadInterface path = do
       -- merge all offset tables
       setInterfaceMethodMap $ M.fromList sm `M.union` M.fromList mm `M.union` immap
       setInterfaceMap $ M.insert path cfile imap'
+
+      -- add Interface to Hierarchy
+      addInterfaceEntry path (interfaces cfile)
   where
     zipbase base = zipWith (\x y -> (entry y, x + base)) [0,ptrSize..]
     entry = getname path

diff --git a/tests/InstanceOf3.java b/tests/InstanceOf3.java
new file mode 100644 (file)
index 0000000..580f615
--- /dev/null
+++ b/tests/InstanceOf3.java
@@ -0,0 +1,42 @@
+package tests;
+
+public class InstanceOf3 {
+       static interface i1 { };
+       static interface i2 { };
+       static interface i3 extends i2 { };
+       static interface i4 extends i3 { };
+       static interface i5 { };
+       static class c1 { };
+       static class c2 extends c1 implements i1 { };
+       static class c3 extends c2 implements i4 { };
+       static class c4 { };
+
+       public static void main(String []args) {
+               Object x = new c3();
+               checkInstance(x instanceof i1, "x", "i1");
+               checkInstance(x instanceof i2, "x", "i2");
+               checkInstance(x instanceof i3, "x", "i3");
+               checkInstance(x instanceof i4, "x", "i4");
+               checkInstance(x instanceof i5, "x", "i5");
+               checkInstance(x instanceof c1, "x", "c1");
+               checkInstance(x instanceof c2, "x", "c2");
+               checkInstance(x instanceof c3, "x", "c3");
+               checkInstance(x instanceof c4, "x", "c4");
+               checkInstance(x instanceof String, "x", "String");
+               checkInstance(x instanceof Integer, "x", "Integer");
+               checkInstance(x instanceof Object, "x", "Object");
+       }
+
+       public static void checkInstance(boolean cond, String obj, String classname) {
+               System.out.printf(obj);
+               if (cond) {
+                       System.out.printf(" is instance of ");
+                       System.out.printf(classname);
+                       System.out.printf(" :-)\n");
+               } else {
+                       System.out.printf(" is *not* instance of ");
+                       System.out.printf(classname);
+                       System.out.printf(" :-(\n");
+               }
+       }
+}