From f309c5f92c4883f660789d4aefcb9ba103c871ed Mon Sep 17 00:00:00 2001 From: VegOwOtenks Date: Thu, 21 Aug 2025 08:54:36 +0200 Subject: [PATCH] feat[classfile]: stages the entire file --- src/Language/Java/Classfile.hs | 19 +++++----- src/Language/Java/Classfile/Attributes.hs | 29 +++++++++++---- .../Java/Classfile/ConstantPool/Entry.hs | 21 +++++------ .../Java/Classfile/ConstantPool/References.hs | 16 +++++---- src/Language/Java/Classfile/Fields.hs | 35 +++++++++++++------ src/Language/Java/Classfile/Interfaces.hs | 20 ++++++++--- src/Language/Java/Classfile/Methods.hs | 34 ++++++++++++------ 7 files changed, 117 insertions(+), 57 deletions(-) diff --git a/src/Language/Java/Classfile.hs b/src/Language/Java/Classfile.hs index 7f1c727..32afd59 100644 --- a/src/Language/Java/Classfile.hs +++ b/src/Language/Java/Classfile.hs @@ -17,6 +17,9 @@ module Language.Java.Classfile (Classfile(..)) where import GHC.Generics (Generic, Generically(Generically)) import Data.Kind (Type) +import Data.Word (Word16) + +import Pretty.Serialize (PrettySerialize) import Language.Java.Classfile.Stage (Stage(Parse)) import Language.Java.Classfile.Version (Version) @@ -24,13 +27,11 @@ import Language.Java.Classfile.Magic (Magic) import Language.Java.Classfile.Extractable (Extractable) import Language.Java.Classfile.ConstantPool (ConstantPool) import Language.Java.Classfile.Flags (Flags, FlagMask (..)) -import Language.Java.Classfile.ConstantPool.References (Class) +import Language.Java.Classfile.ConstantPool.References (Class, Utf8) import Language.Java.Classfile.Interfaces (Interfaces) import Language.Java.Classfile.Fields (Fields) import Language.Java.Classfile.Methods (Methods) -import Language.Java.Classfile.Attributes (Attributes) -import Data.Word (Word16) -import Pretty.Serialize (PrettySerialize) +import Language.Java.Classfile.Attributes (Attributes, Attribute) -- | 'Stage'-indexed classfile. It can represent a class, an interface or a module. @@ -43,14 +44,14 @@ data Classfile stage = Classfile , accessFlags :: ClassFlags stage , this :: Class stage , super :: Class stage - , interfaces :: Interfaces - , fields :: Fields - , methods :: Methods - , attributes :: Attributes + , interfaces :: Interfaces stage + , fields :: Fields stage + , methods :: Methods stage + , attributes :: Attributes stage } deriving stock (Generic) -deriving instance (Show (Magic stage), Show (ConstantPool stage), Show (ClassFlags stage), Show (Class stage)) => Show (Classfile stage) +deriving instance (Show (Attribute stage), Show (Utf8 stage), Show (Magic stage), Show (ConstantPool stage), Show (ClassFlags stage), Show (Class stage)) => Show (Classfile stage) deriving via Generically (Classfile Parse) instance (Extractable (Classfile Parse)) deriving via Generically (Classfile Parse) instance (PrettySerialize (Classfile Parse)) diff --git a/src/Language/Java/Classfile/Attributes.hs b/src/Language/Java/Classfile/Attributes.hs index 6d3d586..d1c79cb 100644 --- a/src/Language/Java/Classfile/Attributes.hs +++ b/src/Language/Java/Classfile/Attributes.hs @@ -3,28 +3,43 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE StandaloneKindSignatures #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE UndecidableInstances #-} module Language.Java.Classfile.Attributes (Attributes(..), Attribute(..)) where import Data.Array.IArray (Array) import Data.Word (Word16, Word32) import Language.Java.Classfile.Extractable (Extractable) -import Language.Java.Classfile.ConstantPool.References (Utf8Reference) +import Language.Java.Classfile.ConstantPool.References (Utf8) import Language.Java.Classfile.Extractable.SizedBytes (SizedBytes) import GHC.Generics ( Generic, Generically(..) ) import Pretty.Serialize (PrettySerialize) +import Language.Java.Classfile.Stage (Stage(Parse)) +import Data.Kind (Type) +import Data.Typeable (Typeable) -- | Generic Attribute array used everywhere. -- -- Will not respect Attribute location restrictions, does not attempt to parse anything specific. -newtype Attributes = Attributes (Array Word16 Attribute) - deriving stock (Show) - deriving newtype (Extractable, PrettySerialize) +type Attributes :: Stage -> Type +newtype Attributes stage = Attributes (Array Word16 (Attribute stage)) + +deriving stock instance Show (Attribute stage) => Show (Attributes stage) +deriving newtype instance (Extractable (Attribute stage), Typeable stage) => Extractable (Attributes stage) +deriving newtype instance (PrettySerialize (Attribute stage), Typeable stage) => PrettySerialize (Attributes stage) -- | Unknown Attribute -data Attribute = Attribute - { name :: Utf8Reference +type Attribute :: Stage -> Type +data family Attribute stage + +data instance Attribute Parse = RawAttribute + { name :: Utf8 Parse , info :: SizedBytes Word32 } deriving stock (Show, Generic) - deriving (Extractable, PrettySerialize) via Generically Attribute + deriving (Extractable, PrettySerialize) via Generically (Attribute Parse) diff --git a/src/Language/Java/Classfile/ConstantPool/Entry.hs b/src/Language/Java/Classfile/ConstantPool/Entry.hs index 8c6e07b..3501e93 100644 --- a/src/Language/Java/Classfile/ConstantPool/Entry.hs +++ b/src/Language/Java/Classfile/ConstantPool/Entry.hs @@ -11,9 +11,10 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Language.Java.Classfile.ConstantPool.Entry (Entry(..), StorageCount(..), storageCount, MethodHandleInfo(..)) where import GHC.Generics (Generic, Generically(..)) +import Language.Java.Classfile.Stage (Stage(Parse)) import Language.Java.Classfile.Extractable (Extractable (extract)) import Language.Java.Classfile.Extractable.WithTag (Word8Tag) -import Language.Java.Classfile.ConstantPool.References (ClassReference, NameAndTypeReference, MethodHandleReferenceKind, OpaqueReference, BootstrapMethodIndex, Utf8Reference) +import Language.Java.Classfile.ConstantPool.References (Class, NameAndTypeReference, MethodHandleReferenceKind, OpaqueReference, BootstrapMethodIndex, Utf8) import Data.Int (Int32, Int64) import Data.Word (Word16) import Data.Text (Text) @@ -36,29 +37,29 @@ data Entry -- ^ Constant value for ldc | Double (Word8Tag 6 Double) -- ^ Constant value for ldc - | Class (Word8Tag 7 Utf8Reference) + | Class (Word8Tag 7 (Utf8 Parse)) -- ^ Reference to another class: full name - | String (Word8Tag 8 Utf8Reference) + | String (Word8Tag 8 (Utf8 Parse)) -- ^ Constant value for ldc or ConstantValue attributes. - | FieldRef (Word8Tag 9 (ClassReference, NameAndTypeReference)) + | FieldRef (Word8Tag 9 (Class Parse, NameAndTypeReference)) -- ^ Reference to a field: (containing class, descriptor) - | MethodRef (Word8Tag 10 (ClassReference, NameAndTypeReference)) + | MethodRef (Word8Tag 10 (Class Parse, NameAndTypeReference)) -- ^ Reference to a method: (containing class, descriptor) - | InterfaceMethodRef (Word8Tag 11 (ClassReference, NameAndTypeReference)) + | InterfaceMethodRef (Word8Tag 11 (Class Parse, NameAndTypeReference)) -- ^ Reference to an interface method: (containing class, descriptor) - | NameAndType (Word8Tag 12 (Utf8Reference, Utf8Reference)) + | NameAndType (Word8Tag 12 (Utf8 Parse, Utf8 Parse)) -- ^ Name and Type: (name, type) | MethodHandle (Word8Tag 15 MethodHandleInfo) -- ^ Reference to a Method, but more *dynamic* - | MethodType (Word8Tag 16 Utf8Reference) + | MethodType (Word8Tag 16 (Utf8 Parse)) -- ^ Descriptor of a Method | Dynamic (Word8Tag 17 (BootstrapMethodIndex, NameAndTypeReference)) -- ^ Unspeakable horrors: index into the bootstrapmethod attribute array, NameAndType must refer to a field | InvokeDynamic (Word8Tag 18 (BootstrapMethodIndex, NameAndTypeReference)) -- ^ Unspeakable horrors: index into the bootstrapmethod attribute array, NameAndType must refer to a method - | Module (Word8Tag 19 Utf8Reference) + | Module (Word8Tag 19 (Utf8 Parse)) -- ^ Some module description - | Package (Word8Tag 20 Utf8Reference) + | Package (Word8Tag 20 (Utf8 Parse)) -- ^ Some package description deriving stock (Show, Generic) deriving Extractable via Generically Entry diff --git a/src/Language/Java/Classfile/ConstantPool/References.hs b/src/Language/Java/Classfile/ConstantPool/References.hs index 10829b5..63d853b 100644 --- a/src/Language/Java/Classfile/ConstantPool/References.hs +++ b/src/Language/Java/Classfile/ConstantPool/References.hs @@ -8,7 +8,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE StandaloneKindSignatures #-} {-# LANGUAGE DeriveGeneric #-} -module Language.Java.Classfile.ConstantPool.References (Utf8Reference(..), ClassReference(..), NameAndTypeReference(..), MethodHandleReferenceKind(..), OpaqueReference(..), BootstrapMethodIndex(..), Class) where +module Language.Java.Classfile.ConstantPool.References (Utf8(..), Class(..), NameAndTypeReference(..), MethodHandleReferenceKind(..), OpaqueReference(..), BootstrapMethodIndex(..), ) where import Data.Word (Word16, Word8) import Language.Java.Classfile.Extractable (Extractable) import Language.Java.Classfile.Extractable.AsTag @@ -20,23 +20,25 @@ import GHC.Generics (Generically(..), Generic) -- | Wrapper for constant-pool reference to text. -newtype Utf8Reference = Utf8Reference Word16 +type Utf8 :: Stage -> Type +data family Utf8 stage + +newtype instance Utf8 Parse = Utf8Reference Word16 deriving stock (Show, Generic) deriving newtype Extractable - deriving PrettySerialize via Generically Utf8Reference + deriving PrettySerialize via Generically (Utf8 Parse) -- | 'Stage'-indexed type, either a Class or only a t'ClassReference'. type Class :: Stage -> Type -type family Class stage where - Class Parse = ClassReference +data family Class stage -- | Reference to a class in a constant-pool. This will resolve into a class. -newtype ClassReference = ClassReference Word16 +newtype instance Class Parse = ClassReference Word16 deriving stock (Show, Generic) deriving newtype Extractable - deriving PrettySerialize via Generically ClassReference + deriving PrettySerialize via Generically (Class Parse) -- | Reference to a class in a constant-pool. This will resolve to Name and Type. diff --git a/src/Language/Java/Classfile/Fields.hs b/src/Language/Java/Classfile/Fields.hs index 79af340..3d6f710 100644 --- a/src/Language/Java/Classfile/Fields.hs +++ b/src/Language/Java/Classfile/Fields.hs @@ -6,21 +6,32 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE StandaloneKindSignatures #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE UndecidableInstances #-} module Language.Java.Classfile.Fields (Fields(..)) where import Data.Array.IArray (Array) import Data.Word (Word16) import Language.Java.Classfile.Extractable (Extractable) import GHC.Generics ( Generically, Generic, Generically(..) ) import Language.Java.Classfile.Flags (Flags, FlagMask (..)) -import Language.Java.Classfile.ConstantPool.References (Utf8Reference) +import Language.Java.Classfile.ConstantPool.References (Utf8) import Language.Java.Classfile.Attributes (Attributes) import Pretty.Serialize (PrettySerialize) +import Language.Java.Classfile.Stage (Stage) +import Data.Kind (Type) +import Data.Typeable (Typeable) -- | Word16-Array of Fields. -newtype Fields = Fields (Array Word16 Field) - deriving stock Show - deriving newtype (Extractable, PrettySerialize) +type Fields :: Stage -> Type +newtype Fields stage = Fields (Array Word16 (Field stage)) + +deriving stock instance (Show (Field stage)) => Show (Fields stage) +deriving newtype instance (Typeable stage, Extractable (Utf8 stage), Extractable (Attributes stage)) => Extractable (Fields stage) +deriving newtype instance (Typeable stage, PrettySerialize (Utf8 stage), PrettySerialize (Attributes stage)) => PrettySerialize (Fields stage) -- | All the access flags a field can have @@ -53,11 +64,15 @@ instance FlagMask FieldFlag where -- | A singular field of a class. -data Field = Field +type Field :: Stage -> Type +data Field stage = Field { flags :: Flags FieldFlag - , name :: Utf8Reference - , descriptor :: Utf8Reference - , attribute :: Attributes + , name :: Utf8 stage + , descriptor :: Utf8 stage + , attribute :: Attributes stage } - deriving stock (Show, Generic) - deriving (Extractable, PrettySerialize) via Generically Field + deriving stock (Generic) + +deriving stock instance (Show (Utf8 stage), Show (Attributes stage)) => Show (Field stage) +deriving via Generically (Field stage) instance (Extractable (Utf8 stage), Extractable (Attributes stage)) => Extractable (Field stage) +deriving via Generically (Field stage) instance (PrettySerialize (Utf8 stage), PrettySerialize (Attributes stage)) => PrettySerialize (Field stage) diff --git a/src/Language/Java/Classfile/Interfaces.hs b/src/Language/Java/Classfile/Interfaces.hs index f1af737..e545bbe 100644 --- a/src/Language/Java/Classfile/Interfaces.hs +++ b/src/Language/Java/Classfile/Interfaces.hs @@ -2,16 +2,28 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingVia #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE StandaloneKindSignatures #-} +{-# LANGUAGE DataKinds #-} module Language.Java.Classfile.Interfaces (Interfaces(..)) where import Data.Array.IArray (Array) import Data.Word (Word16) -import Language.Java.Classfile.ConstantPool.References (ClassReference) +import Language.Java.Classfile.ConstantPool.References (Class) import Language.Java.Classfile.Extractable (Extractable) import GHC.Generics ( Generic, Generically, Generically(..) ) import Pretty.Serialize (PrettySerialize) +import Language.Java.Classfile.Stage (Stage) +import Data.Kind (Type) +import Data.Typeable (Typeable) -- | A list of classes something implements. -newtype Interfaces = Interfaces (Array Word16 ClassReference) - deriving stock (Show, Generic) - deriving (Extractable, PrettySerialize) via Generically Interfaces +type Interfaces :: Stage -> Type +newtype Interfaces stage = Interfaces (Array Word16 (Class stage)) + deriving stock (Generic) + +deriving stock instance (Show (Class stage)) => Show (Interfaces stage) +deriving via Generically (Interfaces stage) instance (Extractable (Class stage), Typeable stage) => Extractable (Interfaces stage) +deriving via Generically (Interfaces stage) instance (PrettySerialize (Class stage), Typeable stage) => PrettySerialize (Interfaces stage) diff --git a/src/Language/Java/Classfile/Methods.hs b/src/Language/Java/Classfile/Methods.hs index fe6970f..2bae462 100644 --- a/src/Language/Java/Classfile/Methods.hs +++ b/src/Language/Java/Classfile/Methods.hs @@ -6,32 +6,46 @@ {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE StandaloneKindSignatures #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE UndecidableInstances #-} module Language.Java.Classfile.Methods (Methods(..), Method(..), MethodFlag(..)) where import Data.Array.IArray (Array) import Data.Word (Word16) import Language.Java.Classfile.Flags (Flags, FlagMask (..)) import Language.Java.Classfile.Extractable (Extractable) import GHC.Generics ( Generically, Generic, Generically(..) ) -import Language.Java.Classfile.ConstantPool.References (Utf8Reference) +import Language.Java.Classfile.ConstantPool.References (Utf8) import Language.Java.Classfile.Attributes (Attributes) import Pretty.Serialize (PrettySerialize) +import Language.Java.Classfile.Stage (Stage) +import Data.Kind (Type) +import Data.Typeable (Typeable) -- | Alias for the methods structure from the constant-pool. -newtype Methods = Methods (Array Word16 Method) - deriving stock (Show) - deriving newtype (Extractable, PrettySerialize) +newtype Methods stage = Methods (Array Word16 (Method stage)) + +deriving stock instance (Show (Utf8 stage), Show (Attributes stage)) => Show (Methods stage) +deriving newtype instance (Typeable stage, Extractable (Utf8 stage), Extractable (Attributes stage)) => Extractable (Methods stage) +deriving newtype instance (Typeable stage, PrettySerialize (Utf8 stage), PrettySerialize (Attributes stage)) => PrettySerialize (Methods stage) -- | A single method record, contains attributes, name and access flags. -data Method = Method +type Method :: Stage -> Type +data Method stage = Method { flags :: Flags MethodFlag - , name :: Utf8Reference - , descriptor :: Utf8Reference - , attributes :: Attributes + , name :: Utf8 stage + , descriptor :: Utf8 stage + , attributes :: Attributes stage } - deriving stock (Show, Generic) - deriving (Extractable, PrettySerialize) via Generically Method + deriving stock (Generic) + +deriving stock instance (Show (Utf8 stage), Show (Attributes stage)) => Show (Method stage) +deriving via Generically (Method stage) instance (Extractable (Utf8 stage), Extractable (Attributes stage)) => Extractable (Method stage) +deriving via Generically (Method stage) instance (PrettySerialize (Utf8 stage), PrettySerialize (Attributes stage)) => PrettySerialize (Method stage) -- | Flags for the method, such as abstract, public or static.