Implement new syntactic-sugar for skip_to(). Allows specifying the offset directly on a register

1 files changed, 44 insertions, 1 deletions

diff --git a/src/Language/Fiddle/Compiler/Expansion.hs b/src/Language/Fiddle/Compiler/Expansion.hs
index 94042a2..71e7fd2 100644
--- a/src/Language/Fiddle/Compiler/Expansion.hs
+++ b/src/Language/Fiddle/Compiler/Expansion.hs
@@ -50,7 +50,42 @@ instance CompilationStage CurrentStage where
   type StageFunctor CurrentStage = Identity
   type StageAnnotation CurrentStage = Annot
 
-deriving instance AdvanceStage CurrentStage ObjTypeBody
+instance AdvanceStage CurrentStage ObjTypeBody where
+  advanceStage path (ObjTypeBody typ decls ann) =
+    ObjTypeBody typ
+      <$> fmap
+        concat
+        ( mapM
+            ( \case
+                decl@( undirected ->
+                         RegisterDecl
+                           { regPos = Present (RegisterPosition (Just pos)),
+                             regAnnot = ann
+                           }
+                       ) -> do
+                    sequence
+                      [ do
+                          nu <- parseNum (unCommented ann) pos
+                          return
+                            ( asDirected $
+                                SkipToStatement
+                                  Witness
+                                  Vacant
+                                  ( ConstExpression
+                                      ( RightV
+                                          (LitNum (RightV nu) ann)
+                                      )
+                                      ann
+                                  )
+                                  ann
+                            ),
+                        advanceStage path decl
+                      ]
+                decl -> sequence [advanceStage path decl]
+            )
+            decls
+        )
+      <*> pure ann
 
 deriving instance AdvanceStage CurrentStage DeferredRegisterBody
 
@@ -81,6 +116,14 @@ instance AdvanceStage CurrentStage PackageBody where
   advanceStage p (PackageBody decls a) =
     PackageBody <$> reconfigureFiddleDecls p decls <*> pure a
 
+instance
+  StageConvertible
+    ImportsResolved
+    (When True RegisterPosition)
+    (When False RegisterPosition)
+  where
+  convertInStage _ _ _ _ = return Vacant
+
 instance AdvanceStage CurrentStage ObjTypeDecl where
   modifyState t =
     return