diff options
Diffstat (limited to 'src/Language/Fiddle/Ast/Internal/SyntaxTree.hs')
| -rw-r--r-- | src/Language/Fiddle/Ast/Internal/SyntaxTree.hs | 38 |
1 files changed, 15 insertions, 23 deletions
diff --git a/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs b/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs index 8e3cd6c..73c4303 100644 --- a/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs +++ b/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs @@ -12,6 +12,7 @@ module Language.Fiddle.Ast.Internal.SyntaxTree ImportInterface, FiddleUnitInterface, QualificationMetadata, + CommonQualificationData (..), -- Witness Types Witness (..), WitnessType, @@ -48,18 +49,13 @@ module Language.Fiddle.Ast.Internal.SyntaxTree mapDirectedM, asDirected, undirected, - -- Utility Functions - squeeze, - nameToList, ) where import Control.Monad (forM_) -import Data.Functor.Identity import Data.Kind (Type) import Data.List.NonEmpty hiding (map) import Data.Text (Text) -import qualified Data.Text as Text import Data.Type.Bool import Data.Typeable import Data.Void (Void) @@ -67,11 +63,11 @@ 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 (UnitInterface) +import Language.Fiddle.Internal.UnitInterface -- | Common data for each qualified element. -newtype CommonQualifcationData - = CommonQualifcationData +newtype CommonQualificationData + = CommonQualificationData { -- The fully qualified path to this qualified element. fullyQualifiedPath :: [String] } @@ -79,7 +75,7 @@ newtype CommonQualifcationData type family QualificationMetadata stage t where QualificationMetadata stage t = - If (stage < Qualified) () (CommonQualifcationData, t) + If (stage < Qualified) () t -- | The type attached to import statements which describe the imported file's -- unit interface @@ -278,7 +274,7 @@ data Expression (s :: Stage) :: SynTree where -- | A variable reference. Var :: { -- | The identifier of the variable. - varIdentifier :: Identifier f a, + varIdentifier :: Name f a, -- | Annotation for the variable. varAnnot :: a } -> @@ -348,7 +344,8 @@ data FiddleDecl :: StagedSynTree where -- | A package declaration. PackageDecl :: { -- | Qualification metadata about this package statement. - packageQualificationMetadata :: QualificationMetadata stage (), + packageQualificationMetadata :: + f (QualificationMetadata stage ExportedPackageDecl), -- | The package name. packageName :: Name f a, -- | The body of the package. @@ -360,7 +357,8 @@ data FiddleDecl :: StagedSynTree where -- | A location declaration in the form 'location <identifier> = <expr>'. LocationDecl :: { -- | qualified metadata about this location. - locationQualificationMetadata :: QualificationMetadata stage (), + locationQualificationMetadata :: + f (QualificationMetadata stage ExportedLocationDecl), -- | The location identifier. locationIdent :: Identifier f a, -- | The associated expression. @@ -372,7 +370,7 @@ data FiddleDecl :: StagedSynTree where -- | A bits declaration in the form 'bits <identifier> : <type>'. BitsDecl :: { -- | Qualification metadata about this "bits" declaration. - bitsQualificationMetadata :: QualificationMetadata stage (), + bitsQualificationMetadata :: f (QualificationMetadata stage ExportedBitsDecl), -- | The identifier of the bits. bitsIdent :: Identifier f a, -- | The type of the bits. @@ -384,7 +382,7 @@ data FiddleDecl :: StagedSynTree where -- | An object type declaration. ObjTypeDecl :: { -- | Qualification metadata about this object type. - objTypeQualificationMetadata :: QualificationMetadata stage (), + objTypeQualificationMetadata :: f (QualificationMetadata stage ExportedTypeDecl), -- | The identifier of the object type. objTypeIdent :: Identifier f a, -- | The body of the object type. @@ -396,7 +394,7 @@ data FiddleDecl :: StagedSynTree where -- | An object declaration in the form 'object <ident> at <expr> : <type>'. ObjectDecl :: { -- | Qualification metadata about this object. - objectQualificationMetadata :: QualificationMetadata stage (), + objectQualificationMetadata :: f (QualificationMetadata stage ExportedObjectDecl), -- | The identifier of the object. objectIdent :: Identifier f a, -- | The location expression. @@ -448,7 +446,7 @@ data ObjType stage f a where ObjType stage f a -- | A reference to an existing type by name. ReferencedObjType :: - { refQualificationMetadata :: QualificationMetadata stage (), + { refQualificationMetadata :: f (QualificationMetadata stage ExportedTypeDecl), -- | The name of the referenced type. refName :: Name f a, -- | Annotation for the referenced type. @@ -609,7 +607,7 @@ data RegisterBitsTypeRef stage f a where -- | A reference to another type by name. RegisterBitsReference :: { -- | Qualification metadata about this Bits reference. - bitsRefQualificationMetadata :: QualificationMetadata stage (), + bitsRefQualificationMetadata :: f (QualificationMetadata stage ExportedBitsDecl), -- | The name of the referenced type. bitsRefName :: Name f a, -- | Annotation for the reference. @@ -714,9 +712,3 @@ data PackageBody (stage :: Stage) (f :: Type -> Type) a where } -> PackageBody stage f a deriving (Generic, Annotated, Typeable, Alter, Walk) - -squeeze :: (Alter t, Traversable f, Monad f) => t f a -> f (t Identity a) -squeeze = alter (fmap Identity) return - -nameToList :: Name f a -> [String] -nameToList (Name ids _) = map (Text.unpack . identifierName) (toList ids) |