Rearrange modules.

[hs-java.git] / JVM / Generator.hs

diff --git a/JVM/Generator.hs b/JVM/Generator.hs
deleted file mode 100644 (file)
index 34b27ed..0000000
--- a/JVM/Generator.hs
+++ /dev/null
@@ -1,188 +0,0 @@
-{-# LANGUAGE FlexibleContexts, TypeFamilies, OverloadedStrings #-}
-module JVM.Generator where
-
-import Control.Monad.State as St
-import Data.Word
-import Data.List
-import Data.Binary
-import qualified Data.Map as M
-import qualified Data.Set as S
-import qualified Data.ByteString.Lazy as B
-
-import JVM.Types
-import JVM.ClassFile
-import JVM.Assembler
-
-data GState = GState {
-  generated :: [Instruction],
-  currentPool :: Pool Resolved,
-  doneMethods :: [Method Resolved],
-  currentMethod :: Maybe (Method Resolved)}
-  deriving (Eq,Show)
-
-emptyGState = GState {
-  generated = [],
-  currentPool = M.empty,
-  doneMethods = [],
-  currentMethod = Nothing }
-
-type Generate a = State GState a
-
-appendPool :: Constant Resolved -> Pool Resolved -> (Pool Resolved, Word16)
-appendPool c pool =
-  let size = fromIntegral (M.size pool)
-      pool' = M.insert size c pool
-  in  (pool', size)
-
-addItem :: Constant Resolved -> Generate Word16
-addItem c = do
-  pool <- St.gets currentPool
-  case lookupPool c pool of
-    Just i -> return (i+1)
-    Nothing -> do
-      let (pool', i) = appendPool c pool
-      st <- St.get
-      St.put $ st {currentPool = pool'}
-      return (i+1)
-
-lookupPool :: Constant Resolved -> Pool Resolved -> Maybe Word16
-lookupPool c pool =
-  fromIntegral `fmap` findIndex (== c) (M.elems pool)
-
-addNT :: Binary (Signature a) => NameType a -> Generate Word16
-addNT (NameType name sig) = do
-  let bsig = encode sig
-  x <- addItem (CNameType name bsig)
-  addItem (CUTF8 name)
-  addItem (CUTF8 bsig)
-  return x
-
-addSig :: MethodSignature -> Generate Word16
-addSig c@(MethodSignature args ret) = do
-  let bsig = encode c
-  addItem (CUTF8 bsig)
-
-addToPool :: Constant Resolved -> Generate Word16
-addToPool c@(CClass str) = do
-  addItem (CUTF8 str)
-  addItem c
-addToPool c@(CField cls name) = do
-  addToPool (CClass cls)
-  addNT name
-  addItem c
-addToPool c@(CMethod cls name) = do
-  addToPool (CClass cls)
-  addNT name
-  addItem c
-addToPool c@(CIfaceMethod cls name) = do
-  addToPool (CClass cls)
-  addNT name
-  addItem c
-addToPool c@(CString str) = do
-  addToPool (CUTF8 str)
-  addItem c
-addToPool c@(CNameType name sig) = do
-  addItem (CUTF8 name)
-  addItem (CUTF8 sig)
-  addItem c
-addToPool c = addItem c
-
-putInstruction :: Instruction -> Generate ()
-putInstruction instr = do
-  st <- St.get
-  let code = generated st
-  St.put $ st {generated = code ++ [instr]}
-
-i0 :: Instruction -> Generate ()
-i0 = putInstruction
-
-i1 :: (Word16 -> Instruction) -> Constant Resolved -> Generate ()
-i1 fn c = do
-  ix <- addToPool c
-  i0 (fn ix)
-
-i8 :: (Word8 -> Instruction) -> Constant Resolved -> Generate ()
-i8 fn c = do
-  ix <- addToPool c
-  i0 (fn $ fromIntegral ix)
-
-startMethod :: [AccessFlag] -> B.ByteString -> MethodSignature -> Generate ()
-startMethod flags name sig = do
-  addToPool (CString name)
-  addSig sig
-  st <- St.get
-  let method = Method {
-    methodAccessFlags = S.fromList flags,
-    methodName = name,
-    methodSignature = sig,
-    methodAttributesCount = 0,
-    methodAttributes = AR M.empty }
-  St.put $ st {generated = [],
-               currentMethod = Just method }
-
-endMethod :: Generate ()
-endMethod = do
-  m <- St.gets currentMethod
-  code <- St.gets genCode
-  case m of
-    Nothing -> fail "endMethod without startMethod!"
-    Just method -> do
-      let method' = method {methodAttributes = AR $ M.fromList [("Code", encodeMethod code)],
-                            methodAttributesCount = 1}
-      st <- St.get
-      St.put $ st {generated = [],
-                   currentMethod = Nothing,
-                   doneMethods = doneMethods st ++ [method']}
-
-newMethod :: [AccessFlag] -> B.ByteString -> [ArgumentSignature] -> ReturnSignature -> Generate () -> Generate (NameType Method)
-newMethod flags name args ret gen = do
-  let sig = MethodSignature args ret
-  startMethod flags name sig
-  gen
-  endMethod
-  return (NameType name sig)
-
-genCode :: GState -> Code
-genCode st = Code {
-    codeStackSize = 4096,
-    codeMaxLocals = 100,
-    codeLength = len,
-    codeInstructions = generated st,
-    codeExceptionsN = 0,
-    codeExceptions = [],
-    codeAttrsN = 0,
-    codeAttributes = AP [] }
-  where
-    len = fromIntegral $ B.length $ encodeInstructions (generated st)
-
-initClass :: B.ByteString -> Generate Word16
-initClass name = do
-  addToPool (CClass "java/lang/Object")
-  addToPool (CClass name)
-  addToPool (CString "Code")
-
-generate :: B.ByteString -> Generate () -> Class Resolved
-generate name gen =
-  let generator = do
-        initClass name
-        gen
-      res = execState generator emptyGState
-      code = genCode res
-  in  Class {
-        magic = 0xCAFEBABE,
-        minorVersion = 0,
-        majorVersion = 50,
-        constsPoolSize = fromIntegral $ M.size (currentPool res),
-        constsPool = currentPool res,
-        accessFlags = S.fromList [ACC_PUBLIC, ACC_STATIC],
-        thisClass = name,
-        superClass = "java/lang/Object",
-        interfacesCount = 0,
-        interfaces = [],
-        classFieldsCount = 0,
-        classFields = [],
-        classMethodsCount = fromIntegral $ length (doneMethods res),
-        classMethods = doneMethods res,
-        classAttributesCount = 0,
-        classAttributes = AR M.empty }
-