From 68480a027565cce928726f5aaa6b6a6e9638617f Mon Sep 17 00:00:00 2001 From: "Ilya V. Portnov" Date: Tue, 4 Oct 2011 12:00:20 +0600 Subject: [PATCH] Some documentation. --- JVM/Builder/Monad.hs | 8 +++++--- Java/ClassPath/Common.hs | 11 +++++++++++ Java/ClassPath/Types.hs | 11 +++++++---- Java/JAR/Archive.hs | 5 ++++- Java/META.hs | 5 ++++- Java/META/Parser.hs | 3 ++- TestGen.hs | 7 +++++++ 7 files changed, 40 insertions(+), 10 deletions(-) diff --git a/JVM/Builder/Monad.hs b/JVM/Builder/Monad.hs index 623a44e..005492f 100644 --- a/JVM/Builder/Monad.hs +++ b/JVM/Builder/Monad.hs @@ -53,6 +53,7 @@ emptyGState = GState { -- | Generate monad type Generate a = StateT GState IO a +-- | Update ClassPath withClassPath :: ClassPath () -> Generate () withClassPath cp = do res <- liftIO $ execClassPath cp @@ -202,6 +203,7 @@ newMethod flags name args ret gen = do endMethod return (NameType name sig) +-- | Get a class from current ClassPath getClass :: String -> Generate (Class Direct) getClass name = do cp <- St.gets classPath @@ -213,6 +215,7 @@ getClass name = do Just (LoadedJAR _ c) -> return c Nothing -> fail $ "No such class in ClassPath: " ++ name +-- | Get class field signature from current ClassPath getClassField :: String -> B.ByteString -> Generate (NameType Field) getClassField clsName fldName = do cls <- getClass clsName @@ -220,6 +223,7 @@ getClassField clsName fldName = do Just fld -> return (fieldNameType fld) Nothing -> fail $ "No such field in class " ++ clsName ++ ": " ++ toString fldName +-- | Get class method signature from current ClassPath getClassMethod :: String -> B.ByteString -> Generate (NameType Method) getClassMethod clsName mName = do cls <- getClass clsName @@ -253,10 +257,8 @@ generate :: [Tree CPEntry] -> B.ByteString -> Generate () -> IO (Class Direct) generate cp name gen = do let generator = do initClass name - st <- St.get - St.put $ st {classPath = cp} gen - res <- execStateT generator emptyGState + res <- execStateT generator (emptyGState {classPath = cp}) let code = genCode res d = defaultClass :: Class Direct return $ d { diff --git a/Java/ClassPath/Common.hs b/Java/ClassPath/Common.hs index 0b8a528..3c61a35 100644 --- a/Java/ClassPath/Common.hs +++ b/Java/ClassPath/Common.hs @@ -6,18 +6,26 @@ import Data.String.Utils (split) import Java.ClassPath.Types +-- | map on forest mapF :: (t -> a) -> [Tree t] -> [Tree a] mapF fn forest = map (mapT fn) forest +-- | mapM on forest +mapFM :: (Monad m, Functor m) => (t -> m a) -> [Tree t] -> m [Tree a] mapFM fn forest = mapM (mapTM fn) forest +-- | mapM on tree +mapTM :: (Monad m, Functor m) => (t -> m a) -> Tree t -> m (Tree a) mapTM fn (Directory dir forest) = Directory dir `fmap` mapFM fn forest mapTM fn (File a) = File `fmap` fn a +-- | map on tree mapT :: (t -> a) -> Tree t -> Tree a mapT fn (Directory dir forest) = Directory dir (mapF fn forest) mapT fn (File a) = File (fn a) +-- | Build tree from list of filenames. +-- For example, ["org/haskell", "org/java"] --> [org/{haskell, java}] buildTree :: [FilePath] -> [Tree FilePath] buildTree strs = let build :: [[String]] -> [Tree FilePath] @@ -36,11 +44,14 @@ buildTree strs = in build ls +-- | Merge ClassPath forest. +-- For example, [org/haskell, org/java] --> [org/{haskell, java}]. merge :: [Tree CPEntry] -> [Tree CPEntry] merge [] = [] merge [t1,t2] = merge1 [t1] t2 merge (t:ts) = foldl merge1 [t] ts +-- | Add one ClassPath tree to forest. merge1 :: [Tree CPEntry] -> Tree CPEntry -> [Tree CPEntry] merge1 [] x = [x] merge1 (x@(File e): es) y@(File e') | e == e' = x: es diff --git a/Java/ClassPath/Types.hs b/Java/ClassPath/Types.hs index 6efb155..cffd0ea 100644 --- a/Java/ClassPath/Types.hs +++ b/Java/ClassPath/Types.hs @@ -6,6 +6,7 @@ import Data.List import JVM.ClassFile +-- | Directories tree data Tree a = Directory FilePath [Tree a] | File a @@ -15,11 +16,12 @@ instance Show a => Show (Tree a) where show (Directory dir forest) = dir ++ "/{" ++ intercalate ", " (map show forest) ++ "}" show (File a) = show a +-- | ClassPath entry data CPEntry = - NotLoaded FilePath - | Loaded FilePath (Class Direct) - | NotLoadedJAR FilePath FilePath - | LoadedJAR FilePath (Class Direct) + NotLoaded FilePath -- ^ Not loaded .class file + | Loaded FilePath (Class Direct) -- ^ Class loaded from .class file + | NotLoadedJAR FilePath FilePath -- ^ Not loaded .jar file + | LoadedJAR FilePath (Class Direct) -- ^ Class loaded from .jar file deriving (Eq) instance Show CPEntry where @@ -28,5 +30,6 @@ instance Show CPEntry where show (NotLoadedJAR jar path) = "" show (LoadedJAR path cls) = "" +-- | ClassPath monad type ClassPath a = StateT [Tree CPEntry] IO a diff --git a/Java/JAR/Archive.hs b/Java/JAR/Archive.hs index 035f1e1..d84be49 100644 --- a/Java/JAR/Archive.hs +++ b/Java/JAR/Archive.hs @@ -1,4 +1,4 @@ - +-- | This module defines functions to read Java JAR files. module Java.JAR.Archive where import Control.Monad.Trans @@ -12,17 +12,20 @@ import Java.ClassPath.Common import JVM.ClassFile import JVM.Converter +-- | Read all entires from JAR file readJAR :: FilePath -> IO [Tree CPEntry] readJAR jarfile = do files <- Zip.withArchive [] jarfile $ Zip.fileNames [] return $ mapF (NotLoadedJAR jarfile) (buildTree files) +-- | Read one class from JAR file readFromJAR :: FilePath -> FilePath -> IO (Class Direct) readFromJAR jarfile path = do content <- Zip.withArchive [] jarfile $ Zip.fileContents [] path let bstr = B.pack content return $ classFile2Direct (decode bstr) +-- | Add given JAR file to ClassPath addJAR :: FilePath -> ClassPath () addJAR jarfile = do classes <- liftIO $ readJAR jarfile diff --git a/Java/META.hs b/Java/META.hs index 47c6de7..b04b30a 100644 --- a/Java/META.hs +++ b/Java/META.hs @@ -1,4 +1,5 @@ - +-- | This module declares functions and data types for +-- JAR meta-information classes, such as MANIFEST.MF etc. module Java.META (module Java.META.Types, module Java.META.Parser, @@ -9,6 +10,7 @@ import Java.META.Types import Java.META.Parser import Java.META.Spec +-- | JAR MANIFEST.MF data Manifest = Manifest { manifestVersion :: String, createdBy :: String, @@ -19,6 +21,7 @@ data Manifest = Manifest { manifestEntries :: [ManifestEntry]} deriving (Eq, Show) +-- | Manifest entry data ManifestEntry = ManifestEntry { meName :: String, meSealed :: Bool, diff --git a/Java/META/Parser.hs b/Java/META/Parser.hs index b27cecc..14c1407 100644 --- a/Java/META/Parser.hs +++ b/Java/META/Parser.hs @@ -1,5 +1,6 @@ -module Java.META.Parser where +module Java.META.Parser + (parseMetaFile) where import qualified Data.Map as M import Text.Parsec diff --git a/TestGen.hs b/TestGen.hs index 0e5ff90..c8cd0ef 100644 --- a/TestGen.hs +++ b/TestGen.hs @@ -14,10 +14,13 @@ import qualified Java.IO test :: Generate () test = do withClassPath $ do + -- Add current directory (with Hello.class) to ClassPath addDirectory "." + -- Load method signature: Hello.hello() helloJava <- getClassMethod "./Hello" "hello" + -- Initializer method. Just calls java.lang.Object. newMethod [ACC_PUBLIC] "" [] ReturnsVoid $ do setStackSize 1 @@ -25,6 +28,7 @@ test = do invokeSpecial Java.Lang.object Java.Lang.objectInit i0 RETURN + -- Declare hello() method and bind it's signature to hello. hello <- newMethod [ACC_PUBLIC, ACC_STATIC] "hello" [IntType] ReturnsVoid $ do setStackSize 8 @@ -45,15 +49,18 @@ test = do pop i0 RETURN + -- Main class method. newMethod [ACC_PUBLIC, ACC_STATIC] "main" [arrayOf Java.Lang.stringClass] ReturnsVoid $ do setStackSize 1 iconst_5 + -- Call previously declared method invokeStatic "Test" hello i0 RETURN return () +main :: IO () main = do testClass <- generate [] "Test" test B.writeFile "Test.class" (encodeClass testClass) -- 2.25.1