summaryrefslogtreecommitdiff
path: root/src/Language/Fiddle/Compiler/Qualification.hs
diff options
context:
space:
mode:
authorJosh Rahm <joshuarahm@gmail.com>2024-10-11 18:45:34 -0600
committerJosh Rahm <joshuarahm@gmail.com>2024-10-11 18:45:34 -0600
commitda0d596946cf21e2f275dd03b40c0a6c0824f66b (patch)
tree517763d8d0613dc0f1b138eb2434a2a709383227 /src/Language/Fiddle/Compiler/Qualification.hs
parent6ce692d61e8486c103a8492b0ec372858b29de50 (diff)
downloadfiddle-da0d596946cf21e2f275dd03b40c0a6c0824f66b.tar.gz
fiddle-da0d596946cf21e2f275dd03b40c0a6c0824f66b.tar.bz2
fiddle-da0d596946cf21e2f275dd03b40c0a6c0824f66b.zip
Change 'Expression' to use numbers with units.
This helps to catch bugs in the compiler, specifically ones related to mixing up bits and bytes.
Diffstat (limited to 'src/Language/Fiddle/Compiler/Qualification.hs')
-rw-r--r--src/Language/Fiddle/Compiler/Qualification.hs25
1 files changed, 13 insertions, 12 deletions
diff --git a/src/Language/Fiddle/Compiler/Qualification.hs b/src/Language/Fiddle/Compiler/Qualification.hs
index 70378c3..ce6250a 100644
--- a/src/Language/Fiddle/Compiler/Qualification.hs
+++ b/src/Language/Fiddle/Compiler/Qualification.hs
@@ -24,6 +24,7 @@ import Language.Fiddle.Compiler
import Language.Fiddle.Compiler.ConsistencyCheck ()
import Language.Fiddle.Internal.Scopes
import Language.Fiddle.Internal.UnitInterface as UnitInterface
+import Language.Fiddle.Internal.UnitNumbers
import Language.Fiddle.Types
import Text.Printf (printf)
@@ -113,7 +114,7 @@ deriving instance AdvanceStage S RegisterBitsDecl
deriving instance AdvanceStage S ObjTypeDecl
-deriving instance AdvanceStage S Expression
+deriving instance AdvanceStage S (Expression u)
instance AdvanceStage S RegisterBitsTypeRef where
advanceStage localState = \case
@@ -332,7 +333,7 @@ objTypeToExport ls = \case
(full, _ :: ExportedTypeDecl) <- resolveOrFail =<< resolveName n ls
return $ ReferencedObjectType (intercalate "." full)
-calculateTypeSize :: ObjTypeBody Expanded F A -> M Word32
+calculateTypeSize :: ObjTypeBody Expanded F A -> M (N Bytes)
calculateTypeSize (ObjTypeBody bodyType decls _) =
( case bodyType of
Union {} -> maximum
@@ -340,33 +341,33 @@ calculateTypeSize (ObjTypeBody bodyType decls _) =
)
<$> mapM calculateDeclSize decls
where
- calculateDeclSize :: Directed ObjTypeDecl Expanded F A -> M Word32
+ calculateDeclSize :: Directed ObjTypeDecl Expanded F A -> M (N Bytes)
calculateDeclSize (undirected -> decl) =
case decl of
AssertPosStatement {} -> return 0
- RegisterDecl {regSize = size} -> expressionToIntM size
- ReservedDecl {reservedExpr = size} -> expressionToIntM size
+ RegisterDecl {regSize = size} -> fst . bitsToBytes <$> expressionToIntM size
+ ReservedDecl {reservedExpr = size} -> fst . bitsToBytes <$> expressionToIntM size
TypeSubStructure {subStructureBody = b} -> calculateTypeSize =<< resolveOrFail b
-getBitTypeDeclaredSize :: BitType Expanded F A -> M Word32
+getBitTypeDeclaredSize :: BitType Expanded F A -> M (N Bits)
getBitTypeDeclaredSize = \case
(EnumBitType declaredSize _ _) -> expressionToIntM declaredSize
(RawBits declaredSize _) -> expressionToIntM declaredSize
resolveLocationExpression ::
- (Integral i, Integral (NumberType stage)) =>
+ (stage .< Expanded ~ False) =>
LocalState ->
- Expression stage F A ->
- M i
+ Expression u stage F A ->
+ M (N u)
resolveLocationExpression ls (Var var _) = do
(_, ExportedLocationDecl _ v) <- resolveOrFail =<< resolveName var ls
return (fromIntegral v)
resolveLocationExpression _ e = expressionToIntM e
expressionToIntM ::
- (Integral i, Integral (NumberType stage)) =>
- Expression stage f A ->
- M i
+ (stage .< Expanded ~ False) =>
+ Expression u stage f A ->
+ M (N u)
expressionToIntM expr =
resolveOrFail $
either