Mate/Utilities.hs

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