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

10 files changed, 190 insertions, 52 deletions

diff --git a/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs b/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs
index b597a25..2774507 100644
--- a/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs
+++ b/src/Language/Fiddle/Ast/Internal/SyntaxTree.hs
@@ -18,7 +18,7 @@ module Language.Fiddle.Ast.Internal.SyntaxTree
     FieldSpan (..),
     QRegMetadata (..),
     QBitsMetadata (..),
-    RegSz(..),
+    RegSz (..),
     -- Witness Types
     Witness (..),
     -- AST Types
@@ -107,7 +107,7 @@ deriving instance
   (FromJSON (When s (FieldSpan Bytes))) =>
   FromJSON (QRegMetadata s)
 
-data RegSz = RegSz8 | RegSz16 | RegSz32  | RegSz64
+data RegSz = RegSz8 | RegSz16 | RegSz32 | RegSz64
   deriving (Eq, Ord, Show, Enum, Generic, ToJSON, FromJSON)
 
 regSzToBits :: RegSz -> N Bits
@@ -519,6 +519,30 @@ data ObjTypeDecl stage f a where
       assertAnnot :: a
     } ->
     ObjTypeDecl stage f a
+  -- | A character buffer
+  BufferDecl ::
+    { -- | Metadata about this declaration.
+      qRegMeta :: When (stage .>= Qualified) (QRegMetadata (stage .>= Checked)),
+      -- | Identifier for this buffer
+      bufIdent :: Guaranteed (stage .>= Qualified) (Identifier f a),
+      -- | Size of this buffer
+      bufSize :: ConstExpression Bytes stage f a,
+      -- | Annotation for this buf statement.
+      bufAnnot :: a
+    } ->
+    ObjTypeDecl stage f a
+  SkipToStatement ::
+    { -- | Witness that we are in the proper stage. These statements will turn
+      -- into buffer statements during the consistency check.
+      disableSkipToStatementsAfterConsistencyCheck :: Witness (stage .< Checked),
+      -- | Metadata
+      qRegMeta :: When (stage .>= Qualified) (QRegMetadata (stage .>= Checked)),
+      -- | The address to skip to.
+      skipToExpression :: ConstExpression Bytes stage f a,
+      -- | The annotation of the skipToStatement
+      skipToAnnot :: a
+    } ->
+    ObjTypeDecl stage f a
   -- | A register declaration.
   RegisterDecl ::
     { -- | Offset within the register. Calculated during the consistency check.
diff --git a/src/Language/Fiddle/Compiler/Backend/C.hs b/src/Language/Fiddle/Compiler/Backend/C.hs
index e9989a0..4b4b3ea 100644
--- a/src/Language/Fiddle/Compiler/Backend/C.hs
+++ b/src/Language/Fiddle/Compiler/Backend/C.hs
@@ -42,8 +42,8 @@ newtype CBackendFlags = CBackendFlags
 
 data SIntfF
   = SIntfF
-  { sIntfFValue :: Text,
-    sIntfFComemnts :: FormattedWriter ()
+  { _sIntfFValue :: Text,
+    _sIntfFComemnts :: FormattedWriter ()
   }
 
 newtype SIntf
@@ -220,15 +220,6 @@ transpile
             Text.replace "/" "_" $
               Text.pack headerFile
 
-class IsText t where
-  toText :: t -> Text
-
-instance IsText String where
-  toText = Text.pack
-
-instance IsText Text where
-  toText = id
-
 qualifiedPathToIdentifier :: QualifiedPath String -> Text
 qualifiedPathToIdentifier = Text.pack . qualifiedPathToString "__" "_"
 
@@ -400,8 +391,9 @@ writeBitsGet structName regmeta fullPath offset typeRef docComms = do
   unless (null shiftArguments) $
     text ", "
 
-  text $ Text.intercalate ", " $
-    zipWith (\f _ -> "int " <> f) (tail setterArgumentNames) shiftArguments
+  text $
+    Text.intercalate ", " $
+      zipWith (\f _ -> "int " <> f) (tail setterArgumentNames) shiftArguments
 
   text ") {\n"
 
@@ -715,6 +707,20 @@ structBody structName (ObjTypeBody _ decls _) = do
           checkout iF $
             (if regIsUnnamed regMetadata then id else sIntfSingleton i)
               <$> writeImplementation structName regMetadata mod bod ann
+      BufferDecl
+        { bufIdent = Guaranteed (identToString -> i),
+          bufSize = (trueValue -> size),
+          bufAnnot = ann
+        } -> do
+          textM $ do
+            emitDocComments ann
+            tell "uint8_t "
+            tell (Text.pack i)
+            tell "["
+            tell $ Text.pack (show size)
+            tell "];\n"
+
+          return mempty
       TypeSubStructure
         { subStructureBody = Identity bod,
           subStructureName = mname
@@ -864,7 +870,7 @@ emitEnum (qualifiedPathToIdentifier -> ident) consts = do
 transpileWalk ::
   FilePath ->
   (forall t. (Walk t, Typeable t) => t I A -> () -> M (WalkContinuation ()))
-transpileWalk headerFile t _ = case () of
+transpileWalk _headerFile t _ = case () of
   ()
     | Just
         ( ObjTypeDecl
diff --git a/src/Language/Fiddle/Compiler/ConsistencyCheck.hs b/src/Language/Fiddle/Compiler/ConsistencyCheck.hs
index 00a53dc..c34007f 100644
--- a/src/Language/Fiddle/Compiler/ConsistencyCheck.hs
+++ b/src/Language/Fiddle/Compiler/ConsistencyCheck.hs
@@ -15,6 +15,7 @@ import Data.Functor.Identity
 import qualified Data.IntMap as IntMap
 import Data.List (intercalate)
 import qualified Data.List.NonEmpty as NonEmpty
+import qualified Data.Text as Text
 import Data.Typeable
 import GHC.TypeError as TypeError
 import Language.Fiddle.Ast
@@ -155,6 +156,44 @@ advanceObjTypeBody (ObjTypeBody us decls a) startOffset = do
                     assertedPos <- expressionToIntM expr
                     checkPositionAssertion (annot e) assertedPos offset
                     return (ret, offset)
+                  (SkipToStatement _ qmeta expr ann) -> do
+                    let pos = trueValue expr
+                        sz = if pos < offset then 0 else pos - offset
+                        span = Present (FieldSpan offset sz)
+                        qmeta' = fmap (\q -> q {regSpan = span}) qmeta
+
+                        szExpr = ConstExpression (LeftV sz) (annot expr)
+                     in do
+                          if pos < offset
+                            then do
+                              emitDiagnosticError "Skip to backwards" ann
+                              return (ret, offset)
+                            else
+                              if sz == 0
+                                then
+                                  return (ret, offset)
+                                else do
+                                  doReturn
+                                    ( BufferDecl
+                                        qmeta'
+                                        ( Guaranteed
+                                            ( Identifier
+                                                ( Text.pack $
+                                                    basenamePart (regFullPath (unwrap qmeta'))
+                                                )
+                                                a
+                                            )
+                                        )
+                                        szExpr
+                                        ann
+                                    )
+                                    sz
+                  (BufferDecl qmeta (Guaranteed ident) sz a) -> do
+                    sz' <- advanceStage () sz
+                    let size = trueValue sz'
+                        span = Present (FieldSpan offset size)
+                        qmeta' = fmap (\q -> q {regSpan = span}) qmeta
+                    doReturn (BufferDecl qmeta' (Guaranteed ident) sz' a) size
                   (RegisterDecl qmeta mod ident size Nothing a) -> do
                     let declaredSize = regSzToBits (getLeft size)
                     reifiedSizeBytes <- checkBitsSizeMod8 a declaredSize
diff --git a/src/Language/Fiddle/Compiler/Expansion.hs b/src/Language/Fiddle/Compiler/Expansion.hs
index 5e7063e..94042a2 100644
--- a/src/Language/Fiddle/Compiler/Expansion.hs
+++ b/src/Language/Fiddle/Compiler/Expansion.hs
@@ -6,11 +6,8 @@
 
 module Language.Fiddle.Compiler.Expansion (expandAst, expansionPhase) where
 
-import Control.Monad.Identity (Identity (..))
 import Control.Monad.State (get, modify, put)
 import qualified Data.Char as Char
-import Data.List (intercalate)
-import Data.List.NonEmpty (NonEmpty, (<|))
 import qualified Data.List.NonEmpty as NonEmpty
 import Data.Text (Text)
 import qualified Data.Text as Text
@@ -209,8 +206,8 @@ reconfigureFiddleDecls p decls = do
         (EnumBitType expr body a)
         a
 
-identToName :: Identifier I a -> Name I a
-identToName ident = Name (NonEmpty.singleton ident) (annot ident)
+-- identToName :: Identifier I a -> Name I a
+-- identToName ident = Name (NonEmpty.singleton ident) (annot ident)
 
 internObjType :: Path -> ObjTypeBody Expanded I Annot -> M (Name I Annot)
 internObjType [] _ = compilationFailure
diff --git a/src/Language/Fiddle/Compiler/ImportResolution.hs b/src/Language/Fiddle/Compiler/ImportResolution.hs
index a9c4c8e..d4d6a05 100644
--- a/src/Language/Fiddle/Compiler/ImportResolution.hs
+++ b/src/Language/Fiddle/Compiler/ImportResolution.hs
@@ -11,7 +11,6 @@ where
 import qualified Codec.Compression.GZip as GZip
 import Control.Arrow (Arrow (second))
 import Control.Monad (filterM, when)
-import Control.Monad.Identity (Identity)
 import Control.Monad.State (put)
 import Control.Monad.Trans.Maybe (MaybeT (MaybeT, runMaybeT))
 import Control.Monad.Writer.Lazy (MonadTrans (lift), MonadWriter (tell), WriterT (..), execWriterT)
@@ -303,11 +302,11 @@ runCompl c = (\(x, (y, z)) -> (y, z, x)) <$> runWriterT (runMaybeT c)
 
 type Compl a = MaybeT (WriterT ([Diagnostic], [Artifact]) IO) a
 
-allM :: (Monad m) => (a -> m Bool) -> [a] -> m Bool
-allM _ [] = return True
-allM fn (a : as) = do
-  b <- fn a
-  if b then allM fn as else return False
+-- allM :: (Monad m) => (a -> m Bool) -> [a] -> m Bool
+-- allM _ [] = return True
+-- allM fn (a : as) = do
+--   b <- fn a
+--   if b then allM fn as else return False
 
 anyM :: (Monad m) => (a -> m Bool) -> [a] -> m Bool
 anyM _ [] = return True
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
diff --git a/src/Language/Fiddle/GenericTree.hs b/src/Language/Fiddle/GenericTree.hs
index 7e8d79b..a713e71 100644
--- a/src/Language/Fiddle/GenericTree.hs
+++ b/src/Language/Fiddle/GenericTree.hs
@@ -278,4 +278,6 @@ deriving instance (Context stage) => (ToGenericSyntaxTree (ConstExpression Addre
 
 deriving instance (Context stage) => (ToGenericSyntaxTree (ConstExpression Bits stage))
 
+deriving instance (Context stage) => (ToGenericSyntaxTree (ConstExpression Bytes stage))
+
 deriving instance (Context stage) => (ToGenericSyntaxTree (Expression u stage))
diff --git a/src/Language/Fiddle/Parser.hs b/src/Language/Fiddle/Parser.hs
index 415852c..c3056bd 100644
--- a/src/Language/Fiddle/Parser.hs
+++ b/src/Language/Fiddle/Parser.hs
@@ -199,6 +199,9 @@ asConstP fn = withMeta $ ConstExpression . RightV <$> fn
 exprInParenP :: Pa (Expression u)
 exprInParenP = tok TokLParen *> expressionP <* tok TokRParen
 
+inParenP :: Pa a -> Pa a
+inParenP p = tok TokLParen *> p <* tok TokRParen
+
 objTypeBodyP :: BodyType F (Commented SourceSpan) -> Pa ObjTypeBody
 objTypeBodyP bt =
   withMeta $
@@ -212,6 +215,16 @@ objTypeDeclP =
         AssertPosStatement Witness <$> exprInParenP
     )
       <|> ( do
+              tok_ KWSkipTo
+              SkipToStatement Witness Vacant <$> inParenP constExpressionP
+          )
+      <|> ( do
+              tok_ KWBuffer
+              BufferDecl Vacant . Perhaps
+                <$> optionMaybe ident
+                <*> inParenP constExpressionP
+          )
+      <|> ( do
               tok_ KWReserved
               ReservedDecl Witness <$> exprInParenP
           )
diff --git a/src/Language/Fiddle/Tokenizer.hs b/src/Language/Fiddle/Tokenizer.hs
index d2e5cf8..4590ed0 100644
--- a/src/Language/Fiddle/Tokenizer.hs
+++ b/src/Language/Fiddle/Tokenizer.hs
@@ -28,6 +28,8 @@ data T
   | KWWo
   | KWImport
   | KWUsing
+  | KWSkipTo
+  | KWBuffer
   | TokColon
   | TokComma
   | TokDot
@@ -69,6 +71,8 @@ textOf t = do
     KWWo -> Just "wo"
     KWImport -> Just "import"
     KWUsing -> Just "using"
+    KWBuffer -> Just "buffer"
+    KWSkipTo -> Just "skip_to"
     TokIdent i -> Just i
     TokLitNum n -> Just n
     _ -> Nothing
@@ -106,6 +110,8 @@ parseToken = spaces *> tok parseToken' <* spaces
         "using" -> KWUsing
         "struct" -> KWStruct
         "assert_pos" -> KWAssertPos
+        "skip_to" -> KWSkipTo
+        "buffer" -> KWBuffer
         (Data.Text.head -> h) | isDigit h -> TokLitNum str
         ident -> TokIdent ident
 
diff --git a/vim/syntax/fiddle.vim b/vim/syntax/fiddle.vim
index 416b4a7..c778445 100644
--- a/vim/syntax/fiddle.vim
+++ b/vim/syntax/fiddle.vim
@@ -1,8 +1,8 @@
 syn keyword FiddlePackage option package nextgroup=FiddleName skipwhite
-syn keyword FiddleDecl reg instance at location reserved nextgroup=FiddleIdent skipwhite
+syn keyword FiddleDecl reg buffer instance at location reserved nextgroup=FiddleIdent skipwhite
 syn keyword FiddleTypeDecl type regtype bits nextgroup=FiddleIdent skipwhite
 syn keyword FiddleEnum enum
-syn keyword FiddleBuiltin assert_pos
+syn keyword FiddleBuiltin assert_pos skip_to
 syn keyword FiddleModifier wo ro rw
 syn keyword FiddleStorageClass struct union bitstruct bitunion