Further implement C backend.

There is a problem where I'm mixing up bits and bytes. I think I'll try
to resolve that using more type-level constraints.

1 files changed, 44 insertions, 8 deletions

diff --git a/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs b/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs
index 610fdb2..f467141 100644
--- a/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs
+++ b/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs
@@ -1,9 +1,10 @@
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE IncoherentInstances #-}
-{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 
@@ -12,7 +13,10 @@ module Language.Fiddle.Ast.Internal.SyntaxTree
     NumberType,
     RegisterOffset,
     BitsOffset,
-    QMd (..),
+    QMd,
+    N (..),
+    Unit (..),
+    FieldSpan (..),
     -- Witness Types
     Witness (..),
     -- AST Types
@@ -48,11 +52,12 @@ module Language.Fiddle.Ast.Internal.SyntaxTree
     mapDirectedM,
     asDirected,
     undirected,
+    bitsToBytes,
   )
 where
 
 import Control.Monad (forM_)
-import Data.Aeson (ToJSON (..))
+import Data.Aeson (FromJSON (..), ToJSON (..))
 import Data.Kind (Type)
 import Data.List.NonEmpty hiding (map)
 import Data.Text (Text)
@@ -69,6 +74,33 @@ import Language.Fiddle.Internal.UnitInterface
 
 type QMd s t = When (s .>= Qualified) t
 
+-- | Phantom type used to ensure Bits and Bytes don't get mixed up in the code.
+data Unit = Bits | Bytes
+
+-- | An integer with a unit.
+newtype N (u :: Unit) = N Word32
+  deriving newtype (Real, Enum, Num, Eq, Ord, Integral)
+
+instance (Show (N u)) where
+  show (N b) = show b
+
+instance (ToJSON (N u)) where
+  toJSON (N b) = toJSON b
+
+instance (FromJSON (N u)) where
+  parseJSON v = N <$> parseJSON v
+
+bitsToBytes :: N Bits -> (N Bytes, N Bits)
+bitsToBytes (N a) = let (y, i) = divMod a 8 in (N y, N i)
+
+data FieldSpan (u :: Unit) where
+  FieldSpan ::
+    { offset :: N u,
+      size :: N u
+    } ->
+    FieldSpan u
+  deriving (Eq, Ord, Show, Generic, ToJSON, FromJSON)
+
 type BitsOffset stage = RegisterOffset stage
 
 -- | Type used for the RegisterOffset type. This is populated in the check
@@ -449,7 +481,7 @@ 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.
-      regOffset :: RegisterOffset stage,
+      regSpan :: When (stage .>= Checked) (FieldSpan Bytes),
       -- | Optional register modifier.
       regModifier :: Maybe (Modifier f a),
       -- | Optional register identifier. This is guaranteed to exist after
@@ -466,7 +498,11 @@ data ObjTypeDecl stage f a where
     ObjTypeDecl stage f a
   -- | A reserved declaration for padding or alignment.
   ReservedDecl ::
-    { -- | The expression for reserved space.
+    { -- | Offset and size of this reserved block.
+      regSpan :: When (stage .>= Checked) (FieldSpan Bytes),
+      -- | Generated identifier for this reserved field.
+      reservedIdent :: When (stage .>= Qualified) String,
+      -- | The expression for reserved space.
       reservedExpr :: Expression stage f a,
       -- | Annotation for the reserved declaration.
       reservedAnnot :: a
@@ -503,8 +539,7 @@ data ModifierKeyword = Rw | Ro | Wo
 --   declarations.
 data DeferredRegisterBody stage f a where
   DeferredRegisterBody ::
-    { -- | Bit declarations.
-      deferredBits :: [Directed RegisterBitsDecl stage f a],
+    { deferredBits :: [Directed RegisterBitsDecl stage f a],
       -- | Annotation for the deferred register body.
       deferredAnnot :: a
     } ->
@@ -553,7 +588,8 @@ 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 ().
-      definedBitsOffset :: BitsOffset stage,
+      definedBitsSpan :: When (stage .>= Checked) (FieldSpan Bits),
+      -- | Bit declarations.
       -- | Optional modifier for the bits.
       definedBitsModifier :: Maybe (Modifier f a),
       -- | Identifier for the bits.