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.ByteString.Lazy as B
   8 import Data.List
   9
  10 import JVM.ClassFile
  11
  12 import Mate.Types
  13
  14
  15 buildMethodID :: Class Direct -> Word16 -> MethodInfo
  16 buildMethodID cls idx = MethodInfo (ntName nt) rc (ntSignature nt)
  17   where (rc, nt) = case constsPool cls M.! idx of
  18                     (CMethod rc' nt') -> (rc', nt')
  19                     (CIfaceMethod rc' nt') -> (rc', nt')
  20                     _ -> error "buildMethodID: something wrong. abort."
  21
  22 buildStaticFieldID :: Class Direct -> Word16 -> StaticFieldInfo
  23 buildStaticFieldID cls idx = StaticFieldInfo rc (ntName fnt)
  24   where (CField rc fnt) = constsPool cls M.! idx
  25
  26 buildFieldOffset :: Class Direct -> Word16 -> (B.ByteString, B.ByteString)
  27 buildFieldOffset cls idx = (rc, ntName fnt)
  28   where (CField rc fnt) = constsPool cls M.! idx
  29
  30 buildClassID :: Class Direct -> Word16 -> B.ByteString
  31 buildClassID cls idx = cl
  32   where (CClass cl) = constsPool cls M.! idx
  33
  34 methodGetArgsCount :: Class Direct -> Word16 -> Word32
  35 methodGetArgsCount cls idx = fromIntegral $ length args
  36   where
  37   nt = case constsPool cls M.! idx of
  38     (CMethod _ nt') -> nt'
  39     (CIfaceMethod _ nt') -> nt'
  40     _ -> error "methodGetArgsCount: something wrong. abort."
  41   (MethodSignature args _) = ntSignature nt
  42
  43 -- TODO(bernhard): Extend it to more than just int, and provide typeinformation
  44 methodHaveReturnValue :: Class Direct -> Word16 -> Bool
  45 methodHaveReturnValue cls idx = case ret of
  46     ReturnsVoid -> False;
  47     (Returns BoolType) -> True
  48     (Returns CharByte) -> True
  49     (Returns IntType) -> True;
  50     (Returns (Array _ _)) -> True
  51     (Returns (ObjectType _)) -> True;
  52     _ -> error $ "methodHaveReturnValue: todo: " ++ show ret
  53   where
  54   nt = case constsPool cls M.! idx of
  55     (CMethod _ nt') -> nt'
  56     (CIfaceMethod _ nt') -> nt'
  57     _ -> error "methodHaveReturnValue: something wrong. abort."
  58   (MethodSignature _ ret) = ntSignature nt
  59
  60 lookupMethodSig :: B.ByteString -> MethodSignature -> Class Direct -> Maybe (Method Direct)
  61 lookupMethodSig name sig cls =
  62   find (\x -> methodName x == name && methodSignature x == sig) $ classMethods cls