diff options
Diffstat (limited to 'src/Language/Fiddle/Compiler/ConsistencyCheck.hs')
-rw-r--r-- | src/Language/Fiddle/Compiler/ConsistencyCheck.hs | 21 |
1 files changed, 10 insertions, 11 deletions
diff --git a/src/Language/Fiddle/Compiler/ConsistencyCheck.hs b/src/Language/Fiddle/Compiler/ConsistencyCheck.hs index 4be2912..3d95ea0 100644 --- a/src/Language/Fiddle/Compiler/ConsistencyCheck.hs +++ b/src/Language/Fiddle/Compiler/ConsistencyCheck.hs @@ -153,14 +153,15 @@ advanceObjTypeBody (ObjTypeBody us decls a) startOffset = do assertedPos <- expressionToIntM expr checkPositionAssertion (annot e) assertedPos offset return (ret, offset) - (RegisterDecl _ mod ident size Nothing a) -> do + (RegisterDecl qmeta mod ident size Nothing a) -> do (sizeExpr, reifiedSize) <- advanceAndGetSize size reifiedSizeBytes <- checkBitsSizeMod8 a reifiedSize let span = Present (FieldSpan offset reifiedSizeBytes) - doReturn (RegisterDecl span mod ident sizeExpr Nothing a) + qmeta' = fmap (\q -> q {regSpan = span}) qmeta + doReturn (RegisterDecl qmeta' mod ident sizeExpr Nothing a) =<< checkBitsSizeMod8 a reifiedSize - (RegisterDecl _ mod ident size (Just body) a) -> do + (RegisterDecl qmeta mod ident size (Just body) a) -> do declaredSize <- expressionToIntM size (actualSize, body') <- advanceRegisterBody body @@ -170,12 +171,8 @@ advanceObjTypeBody (ObjTypeBody us decls a) startOffset = do reifiedSizeBytes <- checkBitsSizeMod8 a reifiedSize let span = Present (FieldSpan offset reifiedSizeBytes) - doReturn (RegisterDecl span mod ident sizeExpr (Just body') a) reifiedSizeBytes - (ReservedDecl _ i size a) -> do - (sizeExpr, reifiedSize) <- advanceAndGetSize size - reifiedSizeBytes <- checkBitsSizeMod8 a reifiedSize - let span = Present (FieldSpan offset reifiedSizeBytes) - doReturn (ReservedDecl span i sizeExpr a) reifiedSizeBytes + qmeta' = fmap (\q -> q {regSpan = span}) qmeta + doReturn (RegisterDecl qmeta' mod ident sizeExpr (Just body') a) reifiedSizeBytes (TypeSubStructure (Identity body) name a) -> do (size, body') <- advanceObjTypeBody body offset doReturn (TypeSubStructure (Identity body') name a) size @@ -245,11 +242,13 @@ advanceDecl offset = \case <$> advanceStage () expr <*> pure an ) - DefinedBits _ mod ident typ annot -> do + DefinedBits qmeta mod ident typ annot -> do size <- bitsTypeSize typ let span = Present (FieldSpan offset size) + qmeta' = fmap (\q -> q {bitsSpan = span}) qmeta + (size,) - <$> (DefinedBits span mod ident <$> advanceStage () typ <*> pure annot) + <$> (DefinedBits qmeta' mod ident <$> advanceStage () typ <*> pure annot) BitsSubStructure subBody subName ann -> do (sz, body') <- advanceRegisterBody subBody return (sz, BitsSubStructure body' subName ann) |