Mate/Utilities.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 module Mate.Utilities where
   3
   4 import Data.Char
   5 import Data.Word
   6 import qualified Data.Map as M
   7 import qualified Data.ByteString.Lazy as B
   8 -- import qualified Data.ByteString.Lazy.Char8 as B8
   9 import Codec.Binary.UTF8.String hiding (encode,decode)
  10
  11 import JVM.ClassFile
  12
  13 import Debug.Trace
  14
  15
  16 data MethodInfo = MethodInfo {
  17   methodname :: B.ByteString,
  18   classname :: B.ByteString,
  19   signature :: MethodSignature,
  20   index :: Word16 }
  21
  22 instance Eq MethodInfo where
  23   (MethodInfo m_a c_a s_a i_a) == (MethodInfo m_b c_b s_b i_b) =
  24     (m_a == m_b) && (c_a == c_b) && (s_a == s_b) && (i_a == i_b)
  25
  26 -- TODO(bernhard): not really efficient. also, outsource that to hs-java
  27 instance Ord MethodSignature where
  28   compare (MethodSignature args_a ret_a) (MethodSignature args_b ret_b)
  29     | cmp_args /= EQ = cmp_args
  30     | otherwise = (show ret_a) `compare` (show ret_b)
  31     where
  32     cmp_args = (show args_a) `compare` (show args_b)
  33
  34 instance Ord MethodInfo where
  35   compare (MethodInfo m_a c_a s_a i_a) (MethodInfo m_b c_b s_b i_b)
  36     | cmp_m /= EQ = cmp_m
  37     | cmp_c /= EQ = cmp_c
  38     | cmp_s /= EQ = cmp_s
  39     | otherwise = i_a `compare` i_b
  40     where
  41     cmp_m = m_a `compare` m_b
  42     cmp_c = c_a `compare` c_b
  43     cmp_s = s_a `compare` s_b
  44
  45 instance Show MethodInfo where
  46   show (MethodInfo method c sig idx) =
  47     (toString c) ++ "." ++ (toString method) ++ "." ++ (show sig) ++ "@" ++ (show idx)
  48
  49
  50 -- TODO: actually this function already exists in hs-java-0.3!
  51 lookupMethod :: B.ByteString -> Class Resolved -> Maybe (Method Resolved)
  52 lookupMethod name cls = look (classMethods cls)
  53   where
  54     look [] = Nothing
  55     look (f:fs)
  56       | methodName f == name = Just f
  57       | otherwise  = look fs
  58
  59 toString :: B.ByteString -> String
  60 toString bstr = decodeString $ map (chr . fromIntegral) $ B.unpack bstr
  61
  62 buildMethodID :: Class Resolved -> Word16 -> MethodInfo
  63 buildMethodID cls idx = MethodInfo (ntName nt) rc (ntSignature nt) idx
  64   where
  65   (CMethod rc nt) = (constsPool cls) M.! idx
  66
  67 methodGetArgsCount :: Class Resolved -> Word16 -> Word32
  68 methodGetArgsCount cls idx = fromIntegral $ length args
  69   where
  70   (CMethod _ nt) = (constsPool cls) M.! idx
  71   (MethodSignature args _) = ntSignature nt
  72
  73 -- TODO(bernhard): Extend it to more than just int, and provide typeinformation
  74 methodHaveReturnValue :: Class Resolved -> Word16 -> Bool
  75 methodHaveReturnValue cls idx = case ret of
  76     ReturnsVoid -> False;
  77     (Returns IntType) -> True;
  78     _ -> error "methodHaveReturnValue: todo"
  79   where
  80   (CMethod _ nt) = (constsPool cls) M.! idx
  81   (MethodSignature _ ret) = ntSignature nt