Change register identifiers to Guarantee a value in qualification.

This remove the burden of generating names from the backend.

2 files changed, 25 insertions, 5 deletions

diff --git a/src/Language/Fiddle/Compiler/Expansion.hs b/src/Language/Fiddle/Compiler/Expansion.hs
index ca97fc4..11a68be 100644
--- a/src/Language/Fiddle/Compiler/Expansion.hs
+++ b/src/Language/Fiddle/Compiler/Expansion.hs
@@ -91,7 +91,7 @@ instance AdvanceStage CurrentStage ObjTypeDecl where
     return
       . case t of
         TypeSubStructure {subStructureName = (Just n)} -> pushId n
-        RegisterDecl {regIdent = (Just n)} -> pushId n
+        RegisterDecl {regIdent = (Perhaps (Just n))} -> pushId n
         _ -> id
 
 instance AdvanceStage CurrentStage FiddleDecl where
diff --git a/src/Language/Fiddle/Compiler/Qualification.hs b/src/Language/Fiddle/Compiler/Qualification.hs
index 0f7158d..e09725e 100644
--- a/src/Language/Fiddle/Compiler/Qualification.hs
+++ b/src/Language/Fiddle/Compiler/Qualification.hs
@@ -17,6 +17,7 @@ import Data.List (intercalate)
 import Data.List.NonEmpty (NonEmpty (..), toList)
 import qualified Data.List.NonEmpty as NonEmpty
 import Data.Maybe (mapMaybe)
+import qualified Data.Text
 import Data.Word
 import Language.Fiddle.Ast
 import Language.Fiddle.Compiler
@@ -28,8 +29,9 @@ import Text.Printf (printf)
 
 type S = Expanded
 
-newtype GlobalState = GlobalState
-  { unitInterface :: UnitInterface
+data GlobalState = GlobalState
+  { unitInterface :: UnitInterface,
+    uniqueCounter :: Int
   }
 
 data LocalState = LocalState
@@ -43,6 +45,15 @@ type A = Commented SourceSpan
 
 type M = Compile GlobalState
 
+uniqueString :: M String
+uniqueString = do
+  cnt <- gets uniqueCounter
+  modify $ \g -> g {uniqueCounter = cnt + 1}
+  return $ "__anon" ++ show cnt
+
+uniqueIdentifier :: a -> M (Identifier F a)
+uniqueIdentifier a = (\s -> Identifier (Data.Text.pack s) a) <$> uniqueString
+
 instance CompilationStage Expanded where
   type StageAfter Expanded = Qualified
   type StageMonad Expanded = M
@@ -55,13 +66,22 @@ qualificationPhase =
   pureCompilationPhase $ \t -> do
     raw <-
       fmap snd $
-        subCompile (GlobalState mempty) $
+        subCompile (GlobalState mempty 0) $
           advanceStage
             (LocalState mempty mempty)
             (soakA t)
 
     squeezeDiagnostics raw
 
+-- Any non-guaranteed identifiers are given generated identifiers here.
+instance
+  StageConvertible
+    Expanded
+    (Guaranteed False (Identifier F A))
+    (Guaranteed True (Identifier F A))
+  where
+  convertInStage _ ann _ = guaranteeM (uniqueIdentifier ann)
+
 deriving instance AdvanceStage S ObjTypeBody
 
 deriving instance AdvanceStage S DeferredRegisterBody
@@ -289,7 +309,7 @@ advanceFiddleDecls localState decls = fmap (reverse . fst) $ do
 
 insertDecl :: (ExportableDecl d) => d -> M ()
 insertDecl decl =
-  modify $ \(GlobalState ui) -> GlobalState (UnitInterface.insert decl ui)
+  modify $ \(GlobalState ui c) -> GlobalState (UnitInterface.insert decl ui) c
 
 objTypeToExport :: LocalState -> ObjType Expanded F A -> M ReferencedObjectType
 objTypeToExport ls = \case