From 4b85b09593fae1b72a6d64b09a7843f9a28dbe99 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Sun, 27 Oct 2024 22:31:38 -0600
Subject: Enforce that registers are either 8, 16, 32, or 64 bits.

Fixed the issues where the output C code did not use correct register
sizes.
---
 src/Language/Fiddle/Compiler/Qualification.hs | 18 +++++++++++++++---
 1 file changed, 15 insertions(+), 3 deletions(-)

(limited to 'src/Language/Fiddle/Compiler/Qualification.hs')

diff --git a/src/Language/Fiddle/Compiler/Qualification.hs b/src/Language/Fiddle/Compiler/Qualification.hs
index e8ab479..eae219e 100644
--- a/src/Language/Fiddle/Compiler/Qualification.hs
+++ b/src/Language/Fiddle/Compiler/Qualification.hs
@@ -177,6 +177,18 @@ instance AdvanceStage S RegisterBitsDecl where
         <$> advanceStage localState typ
         <*> pure an
 
+getProperRegSize :: (stage .< Expanded ~ False) => Expression Bits stage F A -> M RegSz
+getProperRegSize expr = do
+  v <- expressionToIntM expr
+  case v of
+    8 -> return RegSz8
+    16 -> return RegSz16
+    32 -> return RegSz32
+    64 -> return RegSz64
+    _ -> do
+      emitDiagnosticError "Exotic register size." (annot expr)
+      return RegSz32
+
 instance AdvanceStage S ObjTypeDecl where
   advanceStage localState = \case
     AssertPosStatement d e a ->
@@ -202,7 +214,7 @@ instance AdvanceStage S ObjTypeDecl where
         (Present qRegMeta)
         (guarantee (ModifierKeyword Rw ann) mod)
         ident'
-        <$> advanceStage localState'' size
+        <$> progressBackM getProperRegSize size
         <*> mapM (advanceStage localState'') bod
         <*> pure ann
     ReservedDecl _ expr ann -> do
@@ -222,7 +234,7 @@ instance AdvanceStage S ObjTypeDecl where
         (Present qRegMeta)
         (Guaranteed $ ModifierKeyword Pr ann)
         (Guaranteed ident)
-        <$> advanceStage localState expr
+        <$> fmap LeftV (getProperRegSize expr)
         <*> pure Nothing
         <*> pure ann
     TypeSubStructure bod name an -> do
@@ -482,7 +494,7 @@ calculateTypeSize (ObjTypeBody bodyType decls _) =
     calculateDeclSize (undirected -> decl) =
       case decl of
         AssertPosStatement {} -> return 0
-        RegisterDecl {regSize = size} -> fst . bitsToBytes <$> expressionToIntM size
+        RegisterDecl {regSize = size} -> fst . bitsToBytes <$> expressionToIntM (getRight size)
         ReservedDecl {reservedExpr = size} -> fst . bitsToBytes <$> expressionToIntM size
         TypeSubStructure {subStructureBody = b} -> calculateTypeSize =<< resolveOrFail b
 
-- 
cgit