From 8082f91fd9fd1bdcbde5ebf74ed4710cdbb0c6c5 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Fri, 11 Oct 2024 14:51:37 -0600 Subject: Change register identifiers to Guarantee a value in qualification. This remove the burden of generating names from the backend. --- src/Language/Fiddle/Ast/Internal/Instances.hs | 43 +++++++++++++++++++++++--- src/Language/Fiddle/Ast/Internal/MetaTypes.hs | 23 +++++++++++++- src/Language/Fiddle/Ast/Internal/SyntaxTree.hs | 6 ++-- 3 files changed, 65 insertions(+), 7 deletions(-) (limited to 'src/Language/Fiddle/Ast') diff --git a/src/Language/Fiddle/Ast/Internal/Instances.hs b/src/Language/Fiddle/Ast/Internal/Instances.hs index 1ab943f..8ffd83b 100644 --- a/src/Language/Fiddle/Ast/Internal/Instances.hs +++ b/src/Language/Fiddle/Ast/Internal/Instances.hs @@ -81,16 +81,51 @@ class type TreeType (t :: StagedSynTree) (s :: Stage) = t s (StageFunctor s) (StageAnnotation s) +-- | 'StageConvertible' is a typeclass that defines how to convert between +-- different representations of a syntax tree or its components within a +-- specific compilation stage. +-- +-- This typeclass is particularly useful when performing transformations +-- between different types while staying within the context of a particular +-- stage of the compilation pipeline. It allows a value of type 'from' to be +-- converted to a value of type 'to', with the transformation potentially +-- depending on the current stage's local state and annotation. +-- +-- The parameters of 'StageConvertible' include: +-- * 'stage' - The current compilation stage, which influences how the +-- conversion is performed. +-- * 'from' - The source type to be converted. +-- * 'to' - The target type after conversion. +-- +-- The conversion process is performed using the 'convertInStage' method, +-- which takes a proxy for the current stage, the annotation type associated +-- with the stage, and the local state for the stage. It then converts the +-- source value to the target type within the monadic context of the stage. class (CompilationStage stage) => StageConvertible stage from to where + -- | 'convertInStage' performs the conversion from the 'from' type to the 'to' + -- type within the given stage. + -- + -- This function takes: + -- * 'proxy stage' - A proxy representing the current stage of the compilation. + -- * 'StageAnnotation stage' - The annotation associated with the current + -- stage, which may provide additional context for the conversion. + -- For derived instance of AdvanceStage, this holds the annotation for the + -- element being advanced. + -- * 'StageState stage' - The local state for the current stage, which may + -- influence the transformation. + -- * 'from' - The value to be converted. + -- + -- It returns a monadic action within 'StageMonad stage' that produces the + -- converted value of type 'to'. convertInStage :: proxy stage -> - StageAnnotation stage -> - StageState stage -> - from -> - StageMonad stage to + StageAnnotation stage -> -- Annotation associated with the current stage + StageState stage -> -- Local state for the current stage + from -> -- The source value to be converted + StageMonad stage to -- The resulting converted value instance (CompilationStage s, Applicative (StageMonad s)) => StageConvertible s a a where convertInStage _ _ _ = pure diff --git a/src/Language/Fiddle/Ast/Internal/MetaTypes.hs b/src/Language/Fiddle/Ast/Internal/MetaTypes.hs index 7e5e9da..b2fdb26 100644 --- a/src/Language/Fiddle/Ast/Internal/MetaTypes.hs +++ b/src/Language/Fiddle/Ast/Internal/MetaTypes.hs @@ -11,6 +11,8 @@ module Language.Fiddle.Ast.Internal.MetaTypes module X, -- Re-exporting some commonly used modules Guaranteed(..), guarantee, + guaranteeM, + revokeGuarantee ) where @@ -118,9 +120,28 @@ data Guaranteed (s :: Bool) t where -- in a 'Maybe'. Guaranteed :: t -> Guaranteed True t -guarantee :: t -> Guaranteed s t -> Guaranteed True t +-- | 'guaranteeM' takes a monadic action and a 'Guaranteed' value that may or +-- may not hold a value ('Guaranteed False'). If the input contains a value +-- ('Perhaps (Just t)'), it simply wraps that value in 'Guaranteed True'. +-- Otherwise, it performs the monadic action to produce a new value and wraps +-- it in 'Guaranteed True'. +guaranteeM :: (Monad m) => m t -> Guaranteed False t -> m (Guaranteed True t) +guaranteeM _ (Perhaps (Just t)) = return (Guaranteed t) +guaranteeM act _ = Guaranteed <$> act + +-- | 'guarantee' converts a 'Guaranteed False' value to 'Guaranteed True', +-- providing a fallback value. If the original 'Guaranteed False' value +-- contains a value, that value is used. Otherwise, the fallback value is used. +guarantee :: t -> Guaranteed False t -> Guaranteed True t guarantee v = Guaranteed . fromMaybe v . toMaybe +-- | 'revokeGuarantee' converts a 'Guaranteed True' value back to +-- 'Guaranteed False'. It wraps the contained value in 'Perhaps' to indicate +-- that the guarantee is no longer present. +revokeGuarantee :: Guaranteed True t -> Guaranteed False t +revokeGuarantee = Perhaps . toMaybe + + instance Functor (Guaranteed s) where fmap _ (Perhaps Nothing) = Perhaps Nothing fmap f (Perhaps (Just t)) = Perhaps (Just (f t)) diff --git a/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs b/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs index 6f67149..610fdb2 100644 --- a/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs +++ b/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs @@ -452,8 +452,10 @@ data ObjTypeDecl stage f a where regOffset :: RegisterOffset stage, -- | Optional register modifier. regModifier :: Maybe (Modifier f a), - -- | Optional register identifier. - regIdent :: Maybe (Identifier f a), + -- | Optional register identifier. This is guaranteed to exist after + -- Qualification, where a generated identifier will be provided if it + -- doesn't exist. + regIdent :: Guaranteed (stage .>= Qualified) (Identifier f a), -- | Size of the register. regSize :: Expression stage f a, -- | Optional register body. -- cgit