Mate/Utilities.hs

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