{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE IncoherentInstances #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} module Language.Fiddle.Ast.Internal.SyntaxTree ( -- Type Families NumberType, ImportInterface, FiddleUnitInterface, QualificationMetadata, CommonQualificationData (..), -- Witness Types Witness (..), WitnessType, -- AST Types Name (..), Directive (..), DirectiveBody (..), DirectiveElement (..), DirectiveExpression (..), Directed (..), FiddleUnit (..), Identifier (..), Expression (..), ImportStatement (..), ImportList (..), FiddleDecl (..), ObjTypeBody (..), ObjType (..), ObjTypeDecl (..), Modifier (..), ModifierKeyword (..), DeferredRegisterBody (..), BodyType (..), RegisterBody (..), RegisterBitsDecl (..), RegisterBitsTypeRef (..), AnonymousBitsType (..), BitType (..), EnumBody (..), EnumConstantDecl (..), PackageBody (..), -- Helper Functions mapDirected, mapDirectedM, asDirected, undirected, ) where import Control.Monad (forM_) import Data.Kind (Type) import Data.List.NonEmpty hiding (map) import Data.Text (Text) import Data.Type.Bool import Data.Typeable import Data.Void (Void) import GHC.Generics import Language.Fiddle.Ast.Internal.Instances import Language.Fiddle.Ast.Internal.Kinds import Language.Fiddle.Ast.Internal.Stage import Language.Fiddle.Internal.UnitInterface -- | Common data for each qualified element. newtype CommonQualificationData = CommonQualificationData { -- The fully qualified path to this qualified element. fullyQualifiedPath :: [String] } deriving (Eq, Ord, Show) type family QualificationMetadata stage t where QualificationMetadata stage t = If (stage < Qualified) () t -- | The type attached to import statements which describe the imported file's -- unit interface type family FiddleUnitInterface (s :: Stage) :: Type where FiddleUnitInterface s = If (s < Checked) () UnitInterface -- | The Type of number during each stage of compilation. When in the first stage, -- numbers are just strings like anything else. In later stages, numbers get -- parsed into actual integers. This makes it easier to process later. type family NumberType (a :: Stage) :: Type where NumberType s = If (s < Expanded) Text Integer -- | The type used for ImportInterfaces attached to ImportStatements. Before import -- resolution, this type is just '()', but when imports are resolved, it turns -- into a 'UnitInterface'. type family ImportInterface (stage :: Stage) :: Type where ImportInterface s = If (s < ImportsResolved) () UnitInterface -- | A way to disable or enable a subtree type based on a type-level boolean. -- -- This is used over GADT's specific parameterization to allow for deriving -- generics and reduce boilerplate. -- -- This is a wrapper type to allow defining instances. data Witness (s :: Bool) where Witness :: (WitnessType s) -> Witness s -- | If the type level expression is true, the witness type is the Unit type, if -- it is false, the witness type is Void, thus making whatever it touches -- uninhabitable. This is how parts of the AST is enabled or disabled during -- compilation. type family WitnessType (s :: Bool) where WitnessType True = () WitnessType False = Void -- A Name is multiple identifiers separated by dots. It's the way of namespaces -- to different packages. data Name :: SynTree where Name :: NonEmpty (Identifier f a) -> a -> Name f a deriving (Generic, Annotated, Alter, Typeable, Walk) -- | Represents a directive in the Fiddle language. A directive provides -- additional metadata or instructions that the compiler can use during -- code generation. Directives can be attached to many elements in the -- syntax tree. data Directive :: SynTree where Directive :: { -- | The body of the directive. directiveBody :: f (DirectiveBody f a), -- | Annotation for the directive. directiveAnnot :: a } -> Directive f a deriving (Generic, Annotated, Alter, Typeable, Walk) -- | Represents the body of a directive, which consists of multiple elements. data DirectiveBody :: SynTree where DirectiveBody :: { -- | Elements of the directive. directiveElements :: [DirectiveElement f a], -- | Annotation for the directive body. directiveBodyAnnot :: a } -> DirectiveBody f a deriving (Generic, Annotated, Alter, Typeable, Walk) -- | Represents an element in a directive. Can be either a key or a key-value -- pair. data DirectiveElement :: SynTree where -- | A simple directive element with a key. The mere presence of this key -- holds semantic value. DirectiveElementKey :: { -- | Optional backend target. directiveBackend :: Maybe (Identifier f a), -- | The key of the directive. directiveKey :: Identifier f a, -- | Annotation for the directive element. directiveKeyAnnot :: a } -> DirectiveElement f a -- | A more complex directive element with a key-value pair, optionally -- specifying a backend. DirectiveElementKeyValue :: { -- | Optional backend target. directiveBackend :: Maybe (Identifier f a), -- | The key of the directive. directiveKey :: Identifier f a, -- | The value of the directive. directiveValue :: DirectiveExpression f a, -- | Annotation for the key-value directive. directiveKeyValueAnnot :: a } -> DirectiveElement f a deriving (Generic, Annotated, Alter, Typeable, Walk) -- | Represents expressions that can be used within a directive, either a -- string or a number. data DirectiveExpression f a where DirectiveString :: { -- | String value of the directive. directiveStringValue :: Text, -- | Annotation for the directive string. directiveStringAnnot :: a } -> DirectiveExpression f a DirectiveNumber :: { -- | Number value of the directive. directiveNumberValue :: Text, -- | Annotation for the directive number. directiveNumberAnnot :: a } -> DirectiveExpression f a deriving (Generic, Annotated, Alter, Typeable, Walk) -- | A type that wraps another syntax tree and applies a list of directives to -- it. data Directed t stage f a where Directed :: { -- | List of directives. directedDirectives :: [Directive f a], -- | The wrapped syntax tree. directedSubtree :: t stage f a, -- | Annotation for the directed subtree. directedAnnot :: a } -> Directed t stage f a deriving (Generic, Annotated, Alter, Typeable) instance (Typeable (Directed t stage), Walk (t stage)) => Walk (Directed t stage) where walk fn (Directed directives subtree _) s = do s' <- fn subtree s walk fn subtree s' forM_ directives $ \d -> do s' <- fn d s walk fn d s' -- | Apply a function to the underlying subtree in a 'Directed' type. mapDirected :: (t s f a -> t' s' f a) -> Directed t s f a -> Directed t' s' f a mapDirected fn (Directed dr tfa a) = Directed dr (fn tfa) a -- | Apply a monadic function to the underlying subtree in a 'Directed' type. mapDirectedM :: (Monad m) => (t s f a -> m (t' s' f a)) -> Directed t s f a -> m (Directed t' s' f a) mapDirectedM fn (Directed dr tfa a) = Directed dr <$> fn tfa <*> pure a -- | Convert an annotated syntax tree element to a 'Directed' type with -- an empty directive list. asDirected :: (Annotated (t s)) => t s f a -> Directed t s f a asDirected tfa = Directed [] tfa (annot tfa) -- | Extract the underlying subtree from a 'Directed' type, discarding any -- directives. undirected :: Directed t s f a -> t s f a undirected (Directed _ tfa _) = tfa -- | The root of the parse tree, containing a list of top-level declarations. data FiddleUnit (stage :: Stage) (f :: Type -> Type) a where FiddleUnit :: { -- | The interface for this FiddleUnit. Early on, this is just () because -- not enough information is provided to determine the interface.. fiddleUnitInterface :: FiddleUnitInterface stage, -- | List of declarations. fiddleDecls :: [Directed FiddleDecl stage f a], -- | Annotation for the 'FiddleUnit'. fiddleUnitAnnot :: a } -> FiddleUnit stage f a deriving (Generic, Annotated, Typeable, Alter, Walk) -- | Represents an identifier with an associated annotation. data Identifier f a = Identifier { -- | The name of the identifier. identifierName :: !Text, -- | Annotation for the identifier. identifierAnnot :: a } deriving (Generic, Annotated, Alter, Typeable, Walk) -- | Expressions used within Fiddle, including literals and variables. data Expression (s :: Stage) :: SynTree where -- | A numeric literal, whose value is dependent on the compilation stage. LitNum :: { -- | The numeric value. litNumValue :: NumberType stage, -- | Annotation for the literal. litNumAnnot :: a } -> Expression stage f a -- | A variable reference. Var :: { -- | The identifier of the variable. varIdentifier :: Name f a, -- | Annotation for the variable. varAnnot :: a } -> Expression stage f a deriving (Generic, Annotated, Alter, Typeable, Walk) -- | Represents an import statement in the Fiddle language. data ImportStatement stage f a where ImportStatement :: { -- | The path to import. importPath :: Text, -- | Optional list of imported items. importList :: Maybe (ImportList f a), importInterface :: ImportInterface stage, -- | Annotation for the import statement. importStatementAnnot :: a } -> ImportStatement stage f a deriving (Generic, Annotated, Alter, Typeable, Walk) -- | A list of imported identifiers. data ImportList f a where ImportList :: { -- | The list of identifiers. importIdentifiers :: [Identifier f a], -- | Annotation for the import list. importListAnnot :: a } -> ImportList f a deriving (Generic, Annotated, Alter, Typeable, Walk) -- | Represents top-level declarations in Fiddle. data FiddleDecl :: StagedSynTree where -- | An option declaration in the form 'option '. OptionDecl :: { -- | The key of the option. optionKey :: Identifier f a, -- | The value of the option. optionValue :: Identifier f a, -- | Annotation for the option declaration. optionAnnot :: a } -> FiddleDecl stage f a -- | An import declaration. ImportDecl :: { -- | The imported type. importStatement :: ImportStatement stage f a, -- \| Annotation for the import declaration. -- | The interface for this imported file. This type depends on the stage -- of compilation. Initially it's just '()', but will eventually be resolved -- into a 'UnitInterface'. importDeclAnnot :: a } -> FiddleDecl stage f a -- | A using declaration. UsingDecl :: { -- Using decls should be removed during qualification. disableUsingDeclAfterQualification :: Witness True, -- TODO change to < Qualified. -- | The name being used. usingName :: Name f a, -- | Annotation for the using declaration. usingAnnot :: a } -> FiddleDecl stage f a -- | A package declaration. PackageDecl :: { -- | Qualification metadata about this package statement. packageQualificationMetadata :: f (QualificationMetadata stage ExportedPackageDecl), -- | The package name. packageName :: Name f a, -- | The body of the package. packageBody :: f (PackageBody stage f a), -- | Annotation for the package declaration. packageAnnot :: a } -> FiddleDecl stage f a -- | A location declaration in the form 'location = '. LocationDecl :: { -- | qualified metadata about this location. locationQualificationMetadata :: f (QualificationMetadata stage ExportedLocationDecl), -- | The location identifier. locationIdent :: Identifier f a, -- | The associated expression. locationExpr :: Expression stage f a, -- | Annotation for the location declaration. locationAnnot :: a } -> FiddleDecl stage f a -- | A bits declaration in the form 'bits : '. BitsDecl :: { -- | Qualification metadata about this "bits" declaration. bitsQualificationMetadata :: f (QualificationMetadata stage ExportedBitsDecl), -- | The identifier of the bits. bitsIdent :: Identifier f a, -- | The type of the bits. bitsType :: BitType stage f a, -- | Annotation for the bits declaration. bitsAnnot :: a } -> FiddleDecl stage f a -- | An object type declaration. ObjTypeDecl :: { -- | Qualification metadata about this object type. objTypeQualificationMetadata :: f (QualificationMetadata stage ExportedTypeDecl), -- | The identifier of the object type. objTypeIdent :: Identifier f a, -- | The body of the object type. objTypeBody :: f (ObjTypeBody stage f a), -- | Annotation for the object type declaration. objTypeAnnot :: a } -> FiddleDecl stage f a -- | An object declaration in the form 'object at : '. ObjectDecl :: { -- | Qualification metadata about this object. objectQualificationMetadata :: f (QualificationMetadata stage ExportedObjectDecl), -- | The identifier of the object. objectIdent :: Identifier f a, -- | The location expression. objectLocation :: Expression stage f a, -- | The type of the object. objectType :: ObjType stage f a, -- | Annotation for the object declaration. objectAnnot :: a } -> FiddleDecl stage f a deriving (Generic, Annotated, Alter, Typeable, Walk) -- | Represents the body of an object type, containing a body type (struct or -- union), a list of object declarations, and an annotation. data ObjTypeBody (stage :: Stage) (f :: Type -> Type) a where ObjTypeBody :: { -- | The body type (struct or union). objBodyType :: BodyType f a, -- | Object declarations. objBodyDecls :: [Directed ObjTypeDecl stage f a], -- | Annotation for the object type body. objBodyAnnot :: a } -> ObjTypeBody stage f a deriving (Generic, Annotated, Alter, Typeable, Walk) -- | Represents an object type, which can be anonymous, an array, or a -- reference to another type. data ObjType stage f a where -- | An anonymous object type, allowed only in Parsed. AnonymousObjType :: { -- | Witness for stage constraint. disableAnonymousTypesAfterExpansion :: Witness (stage < Expanded), -- | The body of the anonymous type. anonBody :: f (ObjTypeBody stage f a), -- | Annotation for the anonymous type. anonAnnot :: a } -> ObjType stage f a -- | An array of object types. ArrayObjType :: { -- | The type of the array elements. arrayObjType :: ObjType stage f a, -- | The size of the array. arraySize :: Expression stage f a, -- | Annotation for the array type. arrayAnnot :: a } -> ObjType stage f a -- | A reference to an existing type by name. ReferencedObjType :: { refQualificationMetadata :: f (QualificationMetadata stage ExportedTypeDecl), -- | The name of the referenced type. refName :: Name f a, -- | Annotation for the referenced type. refAnnot :: a } -> ObjType stage f a deriving (Typeable, Generic, Alter, Annotated, Typeable, Walk) -- | Represents a declaration inside an object type, such as a register, an -- assertion, or a substructure. data ObjTypeDecl stage f a where -- | An assertion statement for a specific position. AssertPosStatement :: { -- | Witness for stage constraint. disableAssertStatementsAfterConsistencyCheck :: Witness (stage < Checked), -- | The expression for the assertion. assertExpr :: Expression stage f a, -- | Annotation for the assertion. assertAnnot :: a } -> ObjTypeDecl stage f a -- | A register declaration. RegisterDecl :: { -- | Optional register modifier. regModifier :: Maybe (Modifier f a), -- | Optional register identifier. regIdent :: Maybe (Identifier f a), -- | Size of the register. regSize :: Expression stage f a, -- | Optional register body. regBody :: Maybe (RegisterBody stage f a), -- | Annotation for the register declaration. regAnnot :: a } -> ObjTypeDecl stage f a -- | A reserved declaration for padding or alignment. ReservedDecl :: { -- | The expression for reserved space. reservedExpr :: Expression stage f a, -- | Annotation for the reserved declaration. reservedAnnot :: a } -> ObjTypeDecl stage f a -- | A declaration for a substructure (struct or union). TypeSubStructure :: { -- | The body of the substructure. subStructureBody :: f (ObjTypeBody stage f a), -- | Optional name for the substructure. subStructureName :: Maybe (Identifier f a), -- | Annotation for the substructure. subStructureAnnot :: a } -> ObjTypeDecl stage f a deriving (Generic, Annotated, Alter, Typeable, Walk) -- | Represents a modifier for registers (e.g., read-only, read-write). data Modifier f a where ModifierKeyword :: { -- | The keyword for the modifier. modifierKey :: ModifierKeyword, -- | Annotation for the modifier. modifierAnnot :: a } -> Modifier f a deriving (Generic, Annotated, Alter, Typeable, Walk) -- | Enumerates the different types of register modifiers. data ModifierKeyword = Rw | Ro | Wo deriving (Eq, Ord, Show, Read, Typeable) -- | Represents a deferred register body, consisting of a list of bit -- declarations. data DeferredRegisterBody stage f a where DeferredRegisterBody :: { -- | Bit declarations. deferredBits :: [Directed RegisterBitsDecl stage f a], -- | Annotation for the deferred register body. deferredAnnot :: a } -> DeferredRegisterBody stage f a deriving (Generic, Annotated, Alter, Typeable, Walk) -- | Represents the body type (struct or union) in an object. data BodyType (f :: Type -> Type) a where Union :: { -- | Annotation for the union. unionAnnot :: a } -> BodyType f a Struct :: { -- | Annotation for the struct. structAnnot :: a } -> BodyType f a deriving (Generic, Annotated, Alter, Typeable, Walk) -- | Represents a register body with a body type and deferred bit declarations. data RegisterBody stage f a where RegisterBody :: { -- | The body type of the register. regBodyType :: BodyType f a, -- | Deferred body. regDeferredBody :: f (DeferredRegisterBody stage f a), -- | Annotation for the register body. regBodyAnnot :: a } -> RegisterBody stage f a deriving (Generic, Annotated, Alter, Typeable, Walk) -- | Represents declarations within a register, such as defined bits, -- reserved bits, or substructures. data RegisterBitsDecl stage f a where -- | Declaration for reserved bits. ReservedBits :: { -- | Expression for reserved bits. reservedBitsExpr :: Expression stage f a, -- | Annotation for the reserved bits. reservedBitsAnnot :: a } -> RegisterBitsDecl stage f a -- | Declaration for defined bits in a register. DefinedBits :: { -- | Optional modifier for the bits. definedBitsModifier :: Maybe (Modifier f a), -- | Identifier for the bits. definedBitsIdent :: Identifier f a, -- | Type reference for the bits. definedBitsTypeRef :: RegisterBitsTypeRef stage f a, -- | Annotation for the defined bits. definedBitsAnnot :: a } -> RegisterBitsDecl stage f a -- | Substructure within a register. BitsSubStructure :: { -- | The body of the substructure. bitsSubRegBody :: RegisterBody stage f a, -- | Optional name for the substructure. bitsSubName :: Maybe (Identifier f a), -- | Annotation for the substructure. bitsSubAnnot :: a } -> RegisterBitsDecl stage f a deriving (Generic, Annotated, Alter, Typeable, Walk) -- | Represents different ways to refer to register bits, either as an array, -- a reference to a type, an anonymous type, or just bits. data RegisterBitsTypeRef stage f a where -- | An array of bits with a specified size. RegisterBitsArray :: { -- | Reference to the array type. bitsArrayTypeRef :: RegisterBitsTypeRef stage f a, -- | Size of the array. bitsArraySize :: Expression stage f a, -- | Annotation for the array. bitsArrayAnnot :: a } -> RegisterBitsTypeRef stage f a -- | A reference to another type by name. RegisterBitsReference :: { -- | Qualification metadata about this Bits reference. bitsRefQualificationMetadata :: f (QualificationMetadata stage ExportedBitsDecl), -- | The name of the referenced type. bitsRefName :: Name f a, -- | Annotation for the reference. bitsRefAnnot :: a } -> RegisterBitsTypeRef stage f a -- | An anonymous type for register bits, used in Parsed. RegisterBitsAnonymousType :: { -- | Witness for stage constraint. disableAnonymousBitsAfterExpansion :: Witness (stage < Expanded), -- | The anonymous type. anonBitsType :: AnonymousBitsType stage f a, -- | Annotation for the anonymous type. anonBitsAnnot :: a } -> RegisterBitsTypeRef stage f a -- | A direct specification of bits as an expression. RegisterBitsJustBits :: { -- | Expression for the bits. justBitsExpr :: Expression stage f a, -- | Annotation for the bits. justBitsAnnot :: a } -> RegisterBitsTypeRef stage f a deriving (Generic, Annotated, Alter, Typeable, Walk) -- | Represents an anonymous bit type, such as an enum, used in Parsed. data AnonymousBitsType stage f a where AnonymousEnumBody :: { -- | Expression defining the enum size. anonEnumExpr :: Expression stage f a, -- | The body of the enum. anonEnumBody :: f (EnumBody stage f a), -- | Annotation for the anonymous enum. anonEnumAnnot :: a } -> AnonymousBitsType stage f a deriving (Generic, Annotated, Alter, Typeable, Walk) -- | Represents a bit type, either an enumeration or raw bits. data BitType (stage :: Stage) (f :: Type -> Type) a where -- | An enumeration type for bits. EnumBitType :: { -- | Expression defining the enum size. enumBitExpr :: Expression stage f a, -- | The body of the enum. enumBitBody :: f (EnumBody stage f a), -- | Annotation for the enumeration. enumBitAnnot :: a } -> BitType stage f a -- | A raw bit type. RawBits :: { -- | Expression defining the bits. rawBitsExpr :: Expression stage f a, -- | Annotation for the raw bits. rawBitsAnnot :: a } -> BitType stage f a deriving (Generic, Annotated, Alter, Typeable, Walk) -- | Represents the body of an enumeration. data EnumBody (stage :: Stage) (f :: Type -> Type) a where EnumBody :: { -- | Enum constant declarations. enumConsts :: [Directed EnumConstantDecl stage f a], -- | Annotation for the enum body. enumBodyAnnot :: a } -> EnumBody stage f a deriving (Generic, Annotated, Alter, Typeable, Walk) -- | Represents a declaration for an enumeration constant. data EnumConstantDecl stage f a where -- | A named constant in the enum. EnumConstantDecl :: { -- | Identifier for the constant. enumConstIdent :: Identifier f a, -- | Expression defining the constant. enumConstExpr :: Expression stage f a, -- | Annotation for the constant. enumConstAnnot :: a } -> EnumConstantDecl stage f a -- | A reserved value in the enum. EnumConstantReserved :: { -- | Expression for the reserved value. enumReservedExpr :: Expression stage f a, -- | Annotation for the reserved value. enumReservedAnnot :: a } -> EnumConstantDecl stage f a deriving (Generic, Annotated, Alter, Typeable, Walk) -- | Represents the body of a package, containing a list of declarations. data PackageBody (stage :: Stage) (f :: Type -> Type) a where PackageBody :: { -- | Declarations in the package. packageBodyDecls :: [Directed FiddleDecl stage f a], -- | Annotation for the package body. packageBodyAnnot :: a } -> PackageBody stage f a deriving (Generic, Annotated, Typeable, Alter, Walk)