Remove some code duplication using Data.Default.

diff --git a/JVM/Builder/Monad.hs b/JVM/Builder/Monad.hs
index 01e93f16c675b756c092765c0d563f74f2c9d1c7..837c312ad9e2864168e38842cee659dd660c19f2 100644 (file)
--- a/JVM/Builder/Monad.hs
+++ b/JVM/Builder/Monad.hs
@@ -220,21 +220,13 @@ generate name gen =
         gen
       res = execState generator emptyGState
       code = genCode res
-  in  Class {
-        magic = 0xCAFEBABE,
-        minorVersion = 0,
-        majorVersion = 50,
+      d = defaultClass :: Class Direct
+  in  d {
         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 }
+        classMethods = doneMethods res }
 

diff --git a/JVM/ClassFile.hs b/JVM/ClassFile.hs
index 2b7e1e7f965add890444ee4ad1511439c4121cbf..d2f30297e955b720cef6382d4e38ba6f08e802f9 100644 (file)
--- a/JVM/ClassFile.hs
+++ b/JVM/ClassFile.hs
@@ -19,6 +19,7 @@ module JVM.ClassFile
    Constant (..),
    AccessFlag (..), AccessFlags,
    Attributes (..),
+   defaultClass,
    -- * Misc
    HasSignature (..), HasAttributes (..),
    NameType (..),
@@ -35,6 +36,7 @@ import Data.Binary.Get
 import Data.Binary.Put
 import Data.Char
 import Data.List
+import Data.Default
 import qualified Data.Set as S
 import qualified Data.Map as M
 import qualified Data.ByteString.Lazy as B
@@ -96,10 +98,16 @@ data family Attributes stage
 data instance Attributes File = AP {attributesList :: [Attribute]}
   deriving (Eq, Show)
 
+instance Default (Attributes File) where
+  def = AP []
+
 -- | At Direct stage, attributes are represented as a Map.
 data instance Attributes Direct = AR (M.Map B.ByteString B.ByteString)
   deriving (Eq, Show)
 
+instance Default (Attributes Direct) where
+  def = AR M.empty
+
 -- | Size of attributes set at Direct stage
 arsize :: Attributes Direct -> Int
 arsize (AR m) = M.size m
@@ -214,6 +222,26 @@ deriving instance Eq (Constant File)
 deriving instance Eq (Constant Direct)
 deriving instance Show (Constant File)
 
+defaultClass :: (Default (AccessFlags stage), Default (Link stage B.ByteString), Default (Attributes stage))
+             => Class stage
+defaultClass = Class {
+  magic = 0xCAFEBABE,
+  minorVersion = 0,
+  majorVersion = 50,
+  constsPoolSize = 0,
+  constsPool = def,
+  accessFlags = def,
+  thisClass = def,
+  superClass = def,
+  interfacesCount = 0,
+  interfaces = [],
+  classFieldsCount = 0,
+  classFields = [],
+  classMethodsCount = 0,
+  classMethods = [],
+  classAttributesCount = 0,
+  classAttributes = def }
+
 instance Binary (Class File) where
   put (Class {..}) = do
     put magic

diff --git a/JVM/Common.hs b/JVM/Common.hs
index b3762c38cec1e4a9839692ae2f0fdb4603880b5b..65a6c6fcf8425eb1f75e70ed2991c998e495e322 100644 (file)
--- a/JVM/Common.hs
+++ b/JVM/Common.hs
@@ -15,9 +15,16 @@ import qualified Data.ByteString.Lazy as B
 import Data.Char
 import Data.String
 import qualified Data.Map as M
+import Data.Default
 
 import JVM.ClassFile
 
+instance Default B.ByteString where
+  def = B.empty
+
+instance Default Word16 where
+  def = 0
+
 instance IsString B.ByteString where
   fromString s = B.pack $ map (fromIntegral . ord) $ encodeString s
 

diff --git a/JVM/Converter.hs b/JVM/Converter.hs
index a498c96e5319ee1e79637d59946c0e27ccb99e2e..911024c4fd8551f8042d79f465442d8e1dc8e8f1 100644 (file)
--- a/JVM/Converter.hs
+++ b/JVM/Converter.hs
@@ -16,6 +16,7 @@ import Data.List
 import Data.Word
 import Data.Bits
 import Data.Binary
+import Data.Default () -- import instances only
 import qualified Data.ByteString.Lazy as B
 import qualified Data.Set as S
 import qualified Data.Map as M
@@ -39,10 +40,8 @@ classFile2Direct :: Class File -> Class Direct
 classFile2Direct (Class {..}) =
   let pool = poolFile2Direct constsPool
       superName = className $ pool ! superClass
-  in Class {
-      magic = 0xCAFEBABE,
-      minorVersion = 0,
-      majorVersion = 50,
+      d = defaultClass :: Class Direct
+  in d {
       constsPoolSize = fromIntegral (M.size pool),
       constsPool = pool,
       accessFlags = accessFile2Direct accessFlags,
@@ -58,10 +57,9 @@ classFile2Direct (Class {..}) =
       classAttributes = attributesFile2Direct pool classAttributes }
 
 classDirect2File :: Class Direct -> Class File
-classDirect2File (Class {..}) = Class {
-    magic = 0xCAFEBABE,
-    minorVersion = 0,
-    majorVersion = 50,
+classDirect2File (Class {..}) =
+  let d = defaultClass :: Class File
+  in d {
     constsPoolSize = fromIntegral (M.size poolInfo + 1),
     constsPool = poolInfo,
     accessFlags = access2word16 accessFlags,