2 {-# LANGUAGE OverloadedStrings #-}
3 module Mate.Utilities where
6 import qualified Data.Map as M
7 import qualified Data.Set as S
8 import qualified Data.ByteString.Lazy as B
17 buildMethodID :: Class Direct -> Word16 -> MethodInfo
18 buildMethodID cls idx = MethodInfo (ntName nt) rc (ntSignature nt)
20 (rc, nt) = case constsPool cls M.! idx of
21 (CMethod rc' nt') -> (rc', nt')
22 (CIfaceMethod rc' nt') -> (rc', nt')
23 _ -> error "buildMethodID: something wrong. abort."
25 buildStaticFieldID :: Class Direct -> Word16 -> StaticFieldInfo
26 buildStaticFieldID cls idx = StaticFieldInfo rc (ntName fnt)
27 where (CField rc fnt) = constsPool cls M.! idx
29 buildFieldOffset :: Class Direct -> Word16 -> (B.ByteString, B.ByteString)
30 buildFieldOffset cls idx = (rc, ntName fnt)
31 where (CField rc fnt) = constsPool cls M.! idx
33 buildClassID :: Class Direct -> Word16 -> B.ByteString
34 buildClassID cls idx = cl
35 where (CClass cl) = constsPool cls M.! idx
38 methodNameTypeByIdx :: Class Direct -> Word16 -> NameType (Method Direct)
39 methodNameTypeByIdx cls idx = case constsPool cls M.! idx of
40 (CMethod _ nt') -> nt'
41 (CIfaceMethod _ nt') -> nt'
42 _ -> error "methodGetArgsCount: something wrong. abort."
44 methodGetArgsCount :: NameType (Method Direct) -> Word32
45 methodGetArgsCount nt = genericLength args
46 where (MethodSignature args _) = ntSignature nt
48 -- TODO(bernhard): Extend it to more than just int, and provide typeinformation
49 methodHaveReturnValue :: Class Direct -> Word16 -> Bool
50 methodHaveReturnValue cls idx = case ret of
52 (Returns BoolType) -> True
53 (Returns CharByte) -> True
54 (Returns IntType) -> True;
55 (Returns (Array _ _)) -> True
56 (Returns (ObjectType _)) -> True;
57 _ -> error $ "methodHaveReturnValue: todo: " ++ show ret
59 nt = case constsPool cls M.! idx of
60 (CMethod _ nt') -> nt'
61 (CIfaceMethod _ nt') -> nt'
62 _ -> error "methodHaveReturnValue: something wrong. abort."
63 (MethodSignature _ ret) = ntSignature nt
65 methodInfoToMethod :: MethodInfo -> Class Direct -> Method Direct
66 methodInfoToMethod mi cls =
67 fromJust $ lookupMethodSig (methName mi) (methSignature mi) cls
69 methodIsStatic :: Method Direct -> Bool
70 methodIsStatic = S.member ACC_STATIC . methodAccessFlags
72 lookupMethodSig :: B.ByteString -> MethodSignature -> Class Direct -> Maybe (Method Direct)
73 lookupMethodSig name sig cls =
74 find (\x -> methodName x == name && methodSignature x == sig) $ classMethods cls