From a4bb7e3e5262cf10f1a013705d8908ad28225491 Mon Sep 17 00:00:00 2001 From: Bernhard Urban Date: Wed, 29 Aug 2012 00:24:20 +0200 Subject: [PATCH] instanceOf: also consider interfaces --- Mate/ClassHierarchy.hs | 98 +++++++++++++++++++++++-------------- Mate/ClassHierarchy.hs-boot | 4 +- Mate/ClassPool.hs | 7 ++- tests/InstanceOf3.java | 42 ++++++++++++++++ 4 files changed, 111 insertions(+), 40 deletions(-) create mode 100644 tests/InstanceOf3.java diff --git a/Mate/ClassHierarchy.hs b/Mate/ClassHierarchy.hs index 628d426..67c6a18 100644 --- 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 f274b83..9a0febe 100644 --- 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 0e188a6..8b1cb41 100644 --- 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 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"); + } + } +} -- 2.25.1