Added syntax for skip_to and buffer.

buffer tells fiddle to create a buffer of a number of bytes.

skip_to tells fiddle to skip to some new offset. It's essentially an
unnamed buffer

1 files changed, 75 insertions, 23 deletions

diff --git a/src/Language/Fiddle/Compiler/Qualification.hs b/src/Language/Fiddle/Compiler/Qualification.hs
index 103c7a1..8bae2de 100644
--- a/src/Language/Fiddle/Compiler/Qualification.hs
+++ b/src/Language/Fiddle/Compiler/Qualification.hs
@@ -14,11 +14,9 @@ import Control.Monad.RWS (MonadWriter (tell))
 import Control.Monad.State
 import Data.Foldable (foldlM, toList)
 import Data.List (intercalate)
-import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as NonEmpty
 import Data.Maybe (isNothing, mapMaybe)
 import qualified Data.Text
-import Data.Word
 import Language.Fiddle.Ast
 import Language.Fiddle.Compiler
 import Language.Fiddle.Compiler.ConsistencyCheck ()
@@ -193,6 +191,41 @@ instance AdvanceStage S ObjTypeDecl where
   advanceStage localState = \case
     AssertPosStatement d e a ->
       AssertPosStatement d <$> advanceStage localState e <*> pure a
+    SkipToStatement d _ e a -> do
+      ident' <- uniqueIdentifier "reg" a
+      let (qualified, localState') = pushRegister (identToString ident') localState
+
+      let qRegMeta =
+            QRegMetadata
+              { regSpan = Vacant,
+                regIsPadding = True,
+                regIsUnnamed = True,
+                regFullPath = qualified
+              }
+
+      SkipToStatement d (Present qRegMeta) <$> advanceStage localState' e <*> pure a
+    BufferDecl _ ident sz ann -> do
+      ident' <- guaranteeM (uniqueIdentifier "reg" ann) ident
+
+      let (qualified, localState') =
+            pushRegister (identToString $ unwrap ident') localState
+          -- Avoid pushing the anonymized name onto the stack.
+          localState'' =
+            if isNothing (toMaybe ident) then localState else localState'
+
+      let qRegMeta =
+            QRegMetadata
+              { regSpan = Vacant,
+                regIsPadding = False,
+                regIsUnnamed = isNothing (toMaybe ident),
+                regFullPath = qualified
+              }
+
+      BufferDecl
+        (Present qRegMeta)
+        ident'
+        <$> advanceStage localState'' sz
+        <*> pure ann
     RegisterDecl _ mod ident size bod ann -> do
       ident' <- guaranteeM (uniqueIdentifier "reg" ann) ident
 
@@ -430,18 +463,14 @@ advanceFiddleDecls localState decls = fmap (reverse . fst) $ do
                             (fmap identToString ids)
                             localState'
                      in do
-                          typeSize <- calculateTypeSize =<< resolveOrFail body
+                          body' <- mapM (advanceStage localState'') body
+                          typeSize <- calculateTypeSize =<< resolveOrFail body'
                           let decl =
                                 ExportedTypeDecl
                                   (metadata qualifiedName)
                                   typeSize
                           insertDecl decl
-                          doReturn
-                            =<< ObjTypeDecl
-                              (qMd decl)
-                              name
-                              <$> mapM (advanceStage localState'') body
-                              <*> pure ann
+                          doReturn $ ObjTypeDecl (qMd decl) name body' ann
                   ObjectDecl _ ident loc typ ann ->
                     let qualifiedName =
                           fmap
@@ -482,21 +511,44 @@ objTypeToExport ls = \case
     (td :: ExportedTypeDecl) <- resolveOrFail =<< resolveName n ls
     return $ ReferencedObjectType (metadataFullyQualifiedPath $ getMetadata td)
 
-calculateTypeSize :: ObjTypeBody Expanded F A -> M (N Bytes)
-calculateTypeSize (ObjTypeBody bodyType decls _) =
-  ( case bodyType of
-      Union {} -> maximum
-      Struct {} -> sum
-  )
-    <$> mapM calculateDeclSize decls
+calculateTypeSize :: ObjTypeBody Qualified F A -> M (N Bytes)
+calculateTypeSize (ObjTypeBody bodyType decls _) = do
+  (summed, maxxed) <- foldlM f (0, 0) decls
+  return $
+    case bodyType of
+      Union {} -> maxxed
+      Struct {} -> summed
   where
-    calculateDeclSize :: Directed ObjTypeDecl Expanded F A -> M (N Bytes)
-    calculateDeclSize (undirected -> decl) =
-      case decl of
-        AssertPosStatement {} -> return 0
-        RegisterDecl {regSize = size} -> fst . bitsToBytes <$> expressionToIntM (getRight size)
-        ReservedDecl {reservedExpr = size} -> fst . bitsToBytes <$> expressionToIntM size
-        TypeSubStructure {subStructureBody = b} -> calculateTypeSize =<< resolveOrFail b
+    f :: (N Bytes, N Bytes) -> Directed ObjTypeDecl Qualified F A -> M (N Bytes, N Bytes)
+    f (pos, mx) decl = case undirected decl of
+      AssertPosStatement {} -> return (pos, mx)
+      RegisterDecl {regSize = size} -> do
+        let v = fst $ bitsToBytes $ regSzToBits $ getLeft size
+        return (pos + v, max mx v)
+      SkipToStatement _ _ expr ann -> do
+        let newLoc = getLeft (constExpression expr)
+            sz = newLoc - pos
+         in do
+              if newLoc < pos
+                then do
+                  emitDiagnosticError "Skip to location already passed." ann
+                  return (pos, mx)
+                else
+                  return (pos + sz, max mx sz)
+      BufferDecl {bufSize = expr} ->
+        let v = getLeft (constExpression expr)
+         in return (pos + v, max mx v)
+      TypeSubStructure {subStructureBody = b} -> do
+        v <- calculateTypeSize =<< resolveOrFail b
+        return (pos + v, max mx v)
+
+-- calculateDeclSize :: Directed ObjTypeDecl Qualified F A -> M (N Bytes)
+-- calculateDeclSize (undirected -> decl) =
+--   case decl of
+--     AssertPosStatement {} -> return 0
+--     RegisterDecl {regSize = size} -> fst . bitsToBytes <$> expressionToIntM (getRight size)
+--     ReservedDecl {reservedExpr = size} -> fst . bitsToBytes <$> expressionToIntM size
+--     TypeSubStructure {subStructureBody = b} -> calculateTypeSize =<< resolveOrFail b
 
 getBitTypeDeclaredSize :: BitType Expanded F A -> M (N Bits)
 getBitTypeDeclaredSize = \case