Start implementing a bunch of the C backend.

Have basic implementations down for coarse registers. Working on getting
bitfields supported.

2 files changed, 81 insertions, 27 deletions

diff --git a/src/Language/Fiddle/Ast/Internal/MetaTypes.hs b/src/Language/Fiddle/Ast/Internal/MetaTypes.hs
index ec5948d..296324c 100644
--- a/src/Language/Fiddle/Ast/Internal/MetaTypes.hs
+++ b/src/Language/Fiddle/Ast/Internal/MetaTypes.hs
@@ -9,21 +9,22 @@ module Language.Fiddle.Ast.Internal.MetaTypes
     IsIdentity (..), -- Typeclass for unwrapping values from certain functors
     toMaybe, -- Function for converting a 'When' to a 'Maybe'
     module X, -- Re-exporting some commonly used modules
-    Guaranteed(..),
+    Guaranteed (..),
     guarantee,
     guaranteeM,
     revokeGuarantee,
-    Variant(..),
+    Variant (..),
     foldVariant,
-    toEither
+    toEither,
   )
 where
 
+import Data.Aeson (FromJSON (..), ToJSON (..))
+import Data.Bifunctor
 import Data.Functor.Identity as X
 import Data.List.NonEmpty as X (NonEmpty (..))
 import Data.Maybe (fromMaybe)
-import Data.Bifunctor
-import Data.Aeson (ToJSON(..))
+import Data.Type.Bool (Not)
 
 -- | 'IsMaybe' is a typeclass for converting a general functor into a Maybe.
 class IsMaybe f where
@@ -48,7 +49,7 @@ instance IsIdentity Identity where
 -- the first element of the non-empty list.
 instance IsIdentity NonEmpty where
   unwrap (a :| _) = a
-  wrap = (:|[])
+  wrap = (:| [])
 
 -- | 'Witness' is a type that can only be constructed if the
 -- type-level condition 's' is 'True'. It serves as a proof
@@ -68,6 +69,19 @@ data When (s :: Bool) t where
   Vacant :: When False t -- No value present
   Present :: t -> When True t -- Value is present
 
+instance (ToJSON t) => ToJSON (When s t) where
+  toJSON Vacant = toJSON ()
+  toJSON (Present t) = toJSON t
+
+instance (FromJSON t) => FromJSON (When False t) where
+  parseJSON v = unUnit <$> parseJSON v
+    where
+      unUnit :: () -> When False t
+      unUnit _ = Vacant
+
+instance (FromJSON t) => FromJSON (When True t) where
+  parseJSON v = Present <$> parseJSON v
+
 -- | Instance for converting a 'When' type to a 'Maybe', erasing type-level
 -- information about the presence of the value.
 instance IsMaybe (When s) where
@@ -125,27 +139,30 @@ data Guaranteed (s :: Bool) t where
   --   in a 'Maybe'.
   Guaranteed :: 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 
+-- | '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 
+-- | '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 
+-- | '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
 
+ofVariant :: Variant b (Maybe t) t -> Guaranteed (Not b) t
+ofVariant (LeftV l) = Perhaps l
+ofVariant (RightV r) = Guaranteed r
 
 instance Functor (Guaranteed s) where
   fmap _ (Perhaps Nothing) = Perhaps Nothing
@@ -181,7 +198,7 @@ instance IsIdentity (Guaranteed True) where
 --   'ifTrue' when the type-level boolean 'b' is 'True', or a value of type
 --   'ifFalse' when 'b' is 'False'.
 --
---   This data type allows encoding conditional behavior at the type level, 
+--   This data type allows encoding conditional behavior at the type level,
 --   where the actual type stored depends on a compile-time boolean. It provides
 --   a way to handle cases where certain fields or structures may vary based on
 --   type-level conditions.
@@ -198,7 +215,6 @@ data Variant (b :: Bool) ifTrue ifFalse where
   -- | Constructor for the 'Variant' when the type-level boolean is 'True'. It
   --   stores a value of type 'ifTrue'.
   LeftV :: ifTrue -> Variant True ifTrue ifFalse
-
   -- | Constructor for the 'Variant' when the type-level boolean is 'False'. It
   --   stores a value of type 'ifFalse'.
   RightV :: ifFalse -> Variant False ifTrue ifFalse
@@ -216,14 +232,20 @@ instance Functor (Variant b t) where
 
 instance Foldable (Variant b t) where
   foldMap f t = foldMap f (toEither t)
-  
+
 instance Bifunctor (Variant b) where
   bimap fl _ (LeftV l) = LeftV (fl l)
   bimap _ fr (RightV r) = RightV (fr r)
-  
+
 instance IsIdentity (Variant False t) where
   unwrap (RightV r) = r
   wrap = RightV
 
 instance (ToJSON f, ToJSON t) => ToJSON (Variant s t f) where
   toJSON = foldVariant toJSON toJSON
+
+instance (FromJSON t) => FromJSON (Variant True t f) where
+  parseJSON v = LeftV <$> parseJSON v
+
+instance (FromJSON f) => FromJSON (Variant False t f) where
+  parseJSON v = RightV <$> parseJSON v
diff --git a/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs b/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs
index ec62c84..5a8aa6d 100644
--- a/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs
+++ b/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs
@@ -14,8 +14,10 @@ module Language.Fiddle.Ast.Internal.SyntaxTree
     RegisterOffset,
     BitsOffset,
     QMd,
-    NamedUnit(..),
+    NamedUnit (..),
     FieldSpan (..),
+    QRegMetadata (..),
+    QBitsMetadata (..),
     -- Witness Types
     Witness (..),
     -- AST Types
@@ -81,6 +83,38 @@ data FieldSpan u where
     FieldSpan u
   deriving (Eq, Ord, Show, Generic, ToJSON, FromJSON)
 
+-- | Metadata about a register.
+data QRegMetadata (checkStage :: Bool) where
+  QRegMetadata ::
+    { -- | The span of the register. Only reified in the Check stage.
+      regSpan :: When checkStage (FieldSpan Bytes),
+      -- | Is this a reified "reserved" register?
+      regIsPadding :: Bool,
+      -- | Was this register unnamed? This implies that the register should not
+      -- emit getters and setters.
+      regIsUnnamed :: Bool,
+      -- | Full path to the register.
+      regFullPath :: NonEmpty String
+    } ->
+    QRegMetadata checkStage
+  deriving (Generic, ToJSON)
+
+deriving instance
+  (FromJSON (When s (FieldSpan Bytes))) =>
+  FromJSON (QRegMetadata s)
+
+data QBitsMetadata (checkStage :: Bool) where
+  QBitsMetadata ::
+    { bitsSpan :: When checkStage (FieldSpan Bits),
+      bitsFullPath :: NonEmpty String
+    } ->
+    QBitsMetadata checkStage
+  deriving (Generic, ToJSON)
+
+deriving instance
+  (FromJSON (When s (FieldSpan Bits))) =>
+  FromJSON (QBitsMetadata s)
+
 type BitsOffset stage = RegisterOffset stage
 
 -- | Type used for the RegisterOffset type. This is populated in the check
@@ -461,9 +495,9 @@ data ObjTypeDecl stage f a where
   RegisterDecl ::
     { -- | Offset within the register. Calculated during the consistency check.
       -- The offset is calculated from the top-level structure.
-      regSpan :: When (stage .>= Checked) (FieldSpan Bytes),
+      qRegMeta :: When (stage .>= Qualified) (QRegMetadata (stage .>= Checked)),
       -- | Optional register modifier.
-      regModifier :: Maybe (Modifier f a),
+      regModifier :: Guaranteed (stage .>= Qualified) (Modifier f a),
       -- | Optional register identifier. This is guaranteed to exist after
       -- Qualification, where a generated identifier will be provided if it
       -- doesn't exist.
@@ -478,10 +512,8 @@ data ObjTypeDecl stage f a where
     ObjTypeDecl stage f a
   -- | A reserved declaration for padding or alignment.
   ReservedDecl ::
-    { -- | Offset and size of this reserved block.
-      regSpan :: When (stage .>= Checked) (FieldSpan Bytes),
-      -- | Generated identifier for this reserved field.
-      reservedIdent :: When (stage .>= Qualified) String,
+    { -- | Reserved "registers" should be reified in the qualification phase.
+      noReservedAfterQualification :: Witness (stage .< Qualified),
       -- | The expression for reserved space.
       reservedExpr :: Expression Bits stage f a,
       -- | Annotation for the reserved declaration.
@@ -512,7 +544,7 @@ data Modifier f a where
   deriving (Generic, Annotated, Alter, Typeable, Walk)
 
 -- | Enumerates the different types of register modifiers.
-data ModifierKeyword = Rw | Ro | Wo
+data ModifierKeyword = Rw | Ro | Wo | Pr
   deriving (Eq, Ord, Show, Read, Typeable)
 
 -- | Represents a deferred register body, consisting of a list of bit
@@ -568,7 +600,7 @@ data RegisterBitsDecl stage f a where
   DefinedBits ::
     { -- | The offset for these bits. This is calculated during the
       -- ConsistencyCheck phase, so until this phase it's just ().
-      definedBitsSpan :: When (stage .>= Checked) (FieldSpan Bits),
+      qBitsMetadata :: When (stage .>= Qualified) (QBitsMetadata (stage .>= Checked)),
       -- | Bit declarations.
       -- | Optional modifier for the bits.
       definedBitsModifier :: Maybe (Modifier f a),