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