From 00898b18dc667b62596a774c4b38a93825ea3bf8 Mon Sep 17 00:00:00 2001 From: VegOwOtenks Date: Sun, 13 Jul 2025 10:00:15 +0200 Subject: [PATCH] feat: partial classfile staging --- app/Main.hs | 4 +- java-classfile.cabal | 2 + src/Language/Java/Classfile.hs | 30 ++++++++++-- src/Language/Java/Classfile/ConstantPool.hs | 17 +++++-- .../Java/Classfile/ConstantPool/References.hs | 46 +++++++++++++------ .../Java/Classfile/Extractable/AsTag.hs | 30 ++++++++++++ src/Language/Java/Classfile/Flags.hs | 15 +++--- src/Language/Java/Classfile/Magic.hs | 20 ++++++-- src/Language/Java/Classfile/Stage.hs | 6 +++ src/Language/Java/Classfile/Version.hs | 1 - 10 files changed, 136 insertions(+), 35 deletions(-) create mode 100644 src/Language/Java/Classfile/Extractable/AsTag.hs create mode 100644 src/Language/Java/Classfile/Stage.hs diff --git a/app/Main.hs b/app/Main.hs index 05b302c..aee2853 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,5 +1,6 @@ {-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE DataKinds #-} module Main (main) where import Data.ByteString.Lazy qualified as ByteString @@ -7,8 +8,9 @@ import Data.ByteString.Lazy qualified as ByteString import Language.Java.Classfile (Classfile) import Language.Java.Classfile.Extract (runExtract) import Language.Java.Classfile.Extractable (extract) +import Language.Java.Classfile.Stage (Stage(Parse)) main :: IO () main = do input <- ByteString.getContents - print $ runExtract input (extract @Classfile) + print $ runExtract input (extract @(Classfile Parse)) diff --git a/java-classfile.cabal b/java-classfile.cabal index 85f9259..5944842 100644 --- a/java-classfile.cabal +++ b/java-classfile.cabal @@ -35,6 +35,7 @@ library Language.Java.Classfile.ConstantPool.References Language.Java.Classfile.Extract Language.Java.Classfile.Extractable + Language.Java.Classfile.Extractable.AsTag Language.Java.Classfile.Extractable.SizedBytes Language.Java.Classfile.Extractable.WithTag Language.Java.Classfile.Fields @@ -44,6 +45,7 @@ library Language.Java.Classfile.Interfaces Language.Java.Classfile.Magic Language.Java.Classfile.Methods + Language.Java.Classfile.Stage Language.Java.Classfile.Version other-modules: Paths_java_classfile diff --git a/src/Language/Java/Classfile.hs b/src/Language/Java/Classfile.hs index 68b3dba..84b5e12 100644 --- a/src/Language/Java/Classfile.hs +++ b/src/Language/Java/Classfile.hs @@ -1,9 +1,19 @@ {-# LANGUAGE DerivingVia #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE StandaloneKindSignatures #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE TypeFamilies #-} module Language.Java.Classfile (Classfile(..)) where import GHC.Generics (Generic, Generically(Generically)) +import Data.Kind (Type) + +import Language.Java.Classfile.Stage (Stage(Parse)) import Language.Java.Classfile.Version (Version) import Language.Java.Classfile.Magic (Magic) import Language.Java.Classfile.Extractable (Extractable) @@ -17,11 +27,12 @@ import Language.Java.Classfile.Methods (Methods) import Language.Java.Classfile.Attributes (Attributes) -data Classfile = Classfile - { magic :: Magic +type Classfile :: Stage -> Type +data Classfile stage = Classfile + { magic :: Magic stage , version :: Version - , constantPool :: ConstantPool - , accessFlags :: Flags ClassFlag + , constantPool :: ConstantPool stage + , accessFlags :: ClassFlags stage , this :: ClassReference , super :: ClassReference , interfaces :: Interfaces @@ -29,5 +40,14 @@ data Classfile = Classfile , methods :: Methods , attributes :: Attributes } + deriving stock (Generic) + +deriving instance (Show (Magic stage), Show (ConstantPool stage), Show (ClassFlags stage)) => Show (Classfile stage) +deriving via Generically (Classfile Parse) instance (Extractable (Classfile Parse)) + +type ClassFlags :: Stage -> Type +data family ClassFlags stage + +newtype instance ClassFlags Parse = ClassFlags (Flags ClassFlag) deriving stock (Show, Generic) - deriving Extractable via Generically Classfile + deriving Extractable via Generically (ClassFlags Parse) diff --git a/src/Language/Java/Classfile/ConstantPool.hs b/src/Language/Java/Classfile/ConstantPool.hs index 7040d65..0df605c 100644 --- a/src/Language/Java/Classfile/ConstantPool.hs +++ b/src/Language/Java/Classfile/ConstantPool.hs @@ -2,6 +2,10 @@ {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StandaloneKindSignatures #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleInstances #-} module Language.Java.Classfile.ConstantPool (ConstantPool(..)) where import Data.Word (Word16) import Data.Array.IArray (Array, listArray) @@ -9,12 +13,19 @@ import Language.Java.Classfile.ConstantPool.Entry (Entry, StorageCount (..), sto import Language.Java.Classfile.Extractable (Extractable (extract)) import Language.Java.Classfile.Extract (Extract, traceIndex, traceType) import qualified Data.Text as Text +import Language.Java.Classfile.Stage (Stage(..)) +import Data.Kind (Type) -newtype ConstantPool = ConstantPool (Array Word16 Entry) +type ConstantPool :: Stage -> Type +data family ConstantPool stage + +newtype instance ConstantPool Parse = ConstantPool (Array Word16 Entry) deriving stock (Show) -instance Extractable ConstantPool where - extract :: Extract ConstantPool +data instance ConstantPool Resolve = NoPool + +instance Extractable (ConstantPool Parse) where + extract :: Extract (ConstantPool Parse) extract = do count <- extract @Word16 diff --git a/src/Language/Java/Classfile/ConstantPool/References.hs b/src/Language/Java/Classfile/ConstantPool/References.hs index 09e8216..a9e3fca 100644 --- a/src/Language/Java/Classfile/ConstantPool/References.hs +++ b/src/Language/Java/Classfile/ConstantPool/References.hs @@ -1,12 +1,14 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingVia #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE LambdaCase #-} module Language.Java.Classfile.ConstantPool.References (Utf8Reference(..), ClassReference(..), NameAndTypeReference(..), MethodHandleReferenceKind(..), OpaqueReference(..), BootstrapMethodIndex(..)) where -import Data.Word (Word16) +import Data.Word (Word16, Word8) import Language.Java.Classfile.Extractable (Extractable) -import Language.Java.Classfile.Extractable.WithTag (Word8Tag) -import GHC.Generics (Generically(..), Generic) +import Language.Java.Classfile.Extractable.AsTag + ( TagValue(..), AsTag, AsTag(..) ) newtype Utf8Reference = Utf8Reference Word16 deriving stock (Show) @@ -29,14 +31,28 @@ newtype BootstrapMethodIndex = BootstrapMethodIndex Word16 deriving newtype Extractable data MethodHandleReferenceKind - = GetField (Word8Tag 1 ()) -- I kind of want to redo this - | GetStatic (Word8Tag 2 ()) - | PutField (Word8Tag 3 ()) - | PutStatic (Word8Tag 4 ()) - | InvokeVirtual (Word8Tag 5 ()) - | InvokeStatic (Word8Tag 6 ()) - | InvokeSpecial (Word8Tag 7 ()) - | NewInvokeSpecial (Word8Tag 8 ()) - | InvokeInterface (Word8Tag 9 ()) - deriving stock (Show, Generic) - deriving Extractable via Generically MethodHandleReferenceKind + = GetField + | GetStatic + | PutField + | PutStatic + | InvokeVirtual + | InvokeStatic + | InvokeSpecial + | NewInvokeSpecial + | InvokeInterface + deriving stock (Show, Enum, Bounded) + deriving Extractable via AsTag MethodHandleReferenceKind + +instance TagValue MethodHandleReferenceKind where + type TagType MethodHandleReferenceKind = Word8 + tagOf :: MethodHandleReferenceKind -> TagType MethodHandleReferenceKind + tagOf = \case + GetField -> 1 + GetStatic -> 2 + PutField -> 3 + PutStatic -> 4 + InvokeVirtual -> 5 + InvokeStatic -> 6 + InvokeSpecial -> 7 + NewInvokeSpecial -> 8 + InvokeInterface -> 9 diff --git a/src/Language/Java/Classfile/Extractable/AsTag.hs b/src/Language/Java/Classfile/Extractable/AsTag.hs new file mode 100644 index 0000000..7d3de50 --- /dev/null +++ b/src/Language/Java/Classfile/Extractable/AsTag.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE UndecidableInstances #-} +module Language.Java.Classfile.Extractable.AsTag (AsTag(..), TagValue(..)) where +import Data.Kind (Type) +import Language.Java.Classfile.Extractable (Extractable (extract), expectConstant) +import Language.Java.Classfile.Extract (Extract) +import Data.Enum.Util (enumerate) +import Control.Applicative (asum) +import Data.Functor (($>)) +import Data.Typeable ( Typeable ) + +newtype AsTag a = AsTag a + deriving Show + +instance (Extractable (TagType a), Bounded a, Enum a, Eq (TagType a), Show (TagType a), Typeable (TagType a), TagValue a ) => Extractable (AsTag a) where + extract :: Extract (AsTag a) + extract = do + let expectTag con = expectConstant (tagOf con) $> con + let allConstructors = expectTag <$> enumerate @a + + AsTag <$> asum allConstructors + + +class TagValue a where + type TagType a :: Type + tagOf :: a -> TagType a diff --git a/src/Language/Java/Classfile/Flags.hs b/src/Language/Java/Classfile/Flags.hs index 5cbe929..a3d1b42 100644 --- a/src/Language/Java/Classfile/Flags.hs +++ b/src/Language/Java/Classfile/Flags.hs @@ -5,13 +5,16 @@ {-# LANGUAGE UndecidableInstances #-} module Language.Java.Classfile.Flags (Flags(..)) where -import Data.Set (Set) -import Language.Java.Classfile.Extractable (Extractable (extract)) -import Language.Java.Classfile.Extract (Extract) -import Language.Java.Classfile.Flag (FlagMask(..)) -import Data.Enum.Util (enumerate) -import qualified Data.Set as Set + import Data.Bits (Bits((.&.))) +import Data.Enum.Util (enumerate) +import Data.Set (Set) + +import qualified Data.Set as Set + +import Language.Java.Classfile.Extract (Extract) +import Language.Java.Classfile.Extractable (Extractable (extract)) +import Language.Java.Classfile.Flag (FlagMask(..)) newtype Flags a = Flags (Set a) deriving (Show) diff --git a/src/Language/Java/Classfile/Magic.hs b/src/Language/Java/Classfile/Magic.hs index d690c0d..1c19846 100644 --- a/src/Language/Java/Classfile/Magic.hs +++ b/src/Language/Java/Classfile/Magic.hs @@ -1,19 +1,31 @@ {-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE StandaloneKindSignatures #-} +{-# LANGUAGE FlexibleInstances #-} module Language.Java.Classfile.Magic (Magic(..)) where import Data.Word (Word32) import Language.Java.Classfile.Extractable (Extractable, extract, expectConstant) import Language.Java.Classfile.Extract (Extract) import Data.Hex (Hex (Hex)) +import Language.Java.Classfile.Stage (Stage(Parse, Resolve)) +import Data.Kind (Type) -newtype Magic = Magic (Hex Word32) +type Magic :: Stage -> Type +data family Magic stage + +newtype instance Magic Parse = Magic (Hex Word32) deriving Show -instance Extractable Magic where - extract :: Extract Magic +data instance Magic Resolve = Cafebabe + deriving Show + +instance Extractable (Magic Parse) where + extract :: Extract (Magic Parse) extract = Magic . Hex <$> expectConstant 0xCAFEBABE -- >>> :set -XOverloadedLists -- >>> import Language.Java.Classfile.Extract (runExtract) -- >>> runExtract [0xCA, 0xFE, 0xBA, 0xBE] (Hex <$> (extract :: Extract (Word32))) --- Just ("",Hex 0xbebafeca) +-- Right ("",Hex 0xcafebabe) diff --git a/src/Language/Java/Classfile/Stage.hs b/src/Language/Java/Classfile/Stage.hs new file mode 100644 index 0000000..ebdf5bc --- /dev/null +++ b/src/Language/Java/Classfile/Stage.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE DataKinds #-} +module Language.Java.Classfile.Stage (Stage(..)) where + +data Stage + = Parse + | Resolve diff --git a/src/Language/Java/Classfile/Version.hs b/src/Language/Java/Classfile/Version.hs index f2e2198..a5704a1 100644 --- a/src/Language/Java/Classfile/Version.hs +++ b/src/Language/Java/Classfile/Version.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingVia #-} module Language.Java.Classfile.Version (Version(..)) where