diff options
Diffstat (limited to 'src/Language/Fiddle/Compiler/Qualification.hs')
| -rw-r--r-- | src/Language/Fiddle/Compiler/Qualification.hs | 18 |
1 files changed, 15 insertions, 3 deletions
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 |