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 -- TODO: actually this function already exists in hs-java-0.3!
  15 lookupMethod :: B.ByteString -> Class Resolved -> Maybe (Method Resolved)
  16 lookupMethod name cls = look (classMethods cls)
  17   where
  18     look [] = Nothing
  19     look (f:fs)
  20       | methodName f == name = Just f
  21       | otherwise  = look fs
  22
  23 buildMethodID :: Class Resolved -> Word16 -> MethodInfo
  24 buildMethodID cls idx = MethodInfo (ntName nt) rc (ntSignature nt)
  25   where (rc, nt) = case (constsPool cls) M.! idx of
  26                     (CMethod rc' nt') -> (rc', nt')
  27                     (CIfaceMethod rc' nt') -> (rc', nt')
  28                     _ -> error $ "buildMethodID: something wrong. abort."
  29
  30 buildStaticFieldID :: Class Resolved -> Word16 -> StaticFieldInfo
  31 buildStaticFieldID cls idx = StaticFieldInfo rc (ntName fnt)
  32   where (CField rc fnt) = (constsPool cls) M.! idx
  33
  34 buildFieldOffset :: Class Resolved -> Word16 -> (B.ByteString, B.ByteString)
  35 buildFieldOffset cls idx = (rc, ntName fnt)
  36   where (CField rc fnt) = (constsPool cls) M.! idx
  37
  38 buildClassID :: Class Resolved -> Word16 -> B.ByteString
  39 buildClassID cls idx = cl
  40   where (CClass cl) = (constsPool cls) M.! idx
  41
  42 methodGetArgsCount :: Class Resolved -> Word16 -> Word32
  43 methodGetArgsCount cls idx = fromIntegral $ length args
  44   where
  45   nt = case (constsPool cls) M.! idx of
  46     (CMethod _ nt') -> nt'
  47     (CIfaceMethod _ nt') -> nt'
  48     _ -> error $ "methodGetArgsCount: something wrong. abort."
  49   (MethodSignature args _) = ntSignature nt
  50
  51 -- TODO(bernhard): Extend it to more than just int, and provide typeinformation
  52 methodHaveReturnValue :: Class Resolved -> Word16 -> Bool
  53 methodHaveReturnValue cls idx = case ret of
  54     ReturnsVoid -> False;
  55     (Returns IntType) -> True;
  56     (Returns (ObjectType _)) -> True;
  57     _ -> error "methodHaveReturnValue: todo"
  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