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
  16
  17 buildMethodID :: Class Direct -> Word16 -> MethodInfo
  18 buildMethodID cls idx = MethodInfo (ntName nt) rc (ntSignature nt)
  19   where
  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."
  24
  25 buildStaticFieldID :: Class Direct -> Word16 -> StaticFieldInfo
  26 buildStaticFieldID cls idx = StaticFieldInfo rc (ntName fnt)
  27   where (CField rc fnt) = constsPool cls M.! idx
  28
  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
  32
  33 buildClassID :: Class Direct -> Word16 -> B.ByteString
  34 buildClassID cls idx = cl
  35   where (CClass cl) = constsPool cls M.! idx
  36
  37
  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."
  43
  44 methodGetArgsCount :: NameType (Method Direct) -> Word32
  45 methodGetArgsCount nt = genericLength args
  46   where (MethodSignature args _) = ntSignature nt
  47
  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
  51     ReturnsVoid -> False;
  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
  58   where
  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
  64
  65 methodInfoToMethod :: MethodInfo -> Class Direct -> Method Direct
  66 methodInfoToMethod mi cls =
  67   fromJust $ lookupMethodSig (methName mi) (methSignature mi) cls
  68
  69 methodIsStatic :: Method Direct -> Bool
  70 methodIsStatic = S.member ACC_STATIC . methodAccessFlags
  71
  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