diff options
Diffstat (limited to 'src/Language/Fiddle/Compiler/ConsistencyCheck.hs')
| -rw-r--r-- | src/Language/Fiddle/Compiler/ConsistencyCheck.hs | 44 |
1 files changed, 21 insertions, 23 deletions
diff --git a/src/Language/Fiddle/Compiler/ConsistencyCheck.hs b/src/Language/Fiddle/Compiler/ConsistencyCheck.hs index 2172694..903e6f4 100644 --- a/src/Language/Fiddle/Compiler/ConsistencyCheck.hs +++ b/src/Language/Fiddle/Compiler/ConsistencyCheck.hs @@ -55,10 +55,6 @@ consistencyCheckPhase = pureCompilationPhase $ advanceStage () instance AdvanceStage S ObjTypeBody where advanceStage () objTypeBody = snd <$> advanceObjTypeBody objTypeBody 0 -deriving instance AdvanceStage S DeferredRegisterBody - -deriving instance AdvanceStage S RegisterBody - deriving instance AdvanceStage S AnonymousBitsType deriving instance AdvanceStage S ImportStatement @@ -75,8 +71,6 @@ deriving instance AdvanceStage S EnumBody deriving instance AdvanceStage S EnumConstantDecl -deriving instance AdvanceStage S RegisterBitsDecl - deriving instance AdvanceStage S PackageBody deriving instance AdvanceStage S FiddleDecl @@ -150,16 +144,16 @@ 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 _ mod ident size Nothing a) -> do (sizeExpr, reifiedSize) <- advanceAndGetSize size - doReturn (RegisterDecl mod ident sizeExpr Nothing a) + doReturn (RegisterDecl offset mod ident sizeExpr Nothing a) =<< checkBitsSizeMod8 a reifiedSize - (RegisterDecl mod ident size (Just body) a) -> do + (RegisterDecl _ mod ident size (Just body) a) -> do declaredSize <- expressionToIntM size (actualSize, body') <- advanceRegisterBody body checkSizeMismatch a declaredSize actualSize (sizeExpr, reifiedSize) <- advanceAndGetSize size - doReturn (RegisterDecl mod ident sizeExpr (Just body') a) + doReturn (RegisterDecl offset mod ident sizeExpr (Just body') a) =<< checkBitsSizeMod8 a reifiedSize (ReservedDecl size a) -> do (sizeExpr, reifiedSize) <- advanceAndGetSize size @@ -182,19 +176,23 @@ advanceRegisterBody :: RegisterBody S F A -> M (Word32, RegisterBody S' F A) -- Handle the case where it's a union. advanceRegisterBody (RegisterBodyPattern us (NonEmpty.nonEmpty -> Just decls) a b) = do - decls' <- - mapM - ( \d -> do - (sz, t) <- advanceDecl (undirected d) - return (sz, mapDirected (const t) d) + (structSize, reverse -> decls') <- + foldlM + ( \(offset, ret) d -> do + (sz, t) <- advanceDecl offset (undirected d) + let advanceOffset off sz = + case us of + Union {} -> off + Struct {} -> off + sz + return (advanceOffset offset sz, (sz, mapDirected (const t) d) : ret) ) + (0, []) decls calcSize <- case us of Union {} -> do - checkJagged (toList decls') - return $ maximum (map fst (toList decls')) - Struct {} -> do - return $ sum (map fst (toList decls')) + checkJagged decls' + return $ maximum (map fst decls') + Struct {} -> return structSize return (calcSize, RegisterBodyPattern us (map snd $ toList decls') a b) @@ -219,8 +217,8 @@ checkJagged decls = do ) a -advanceDecl :: RegisterBitsDecl S F A -> M (Word32, RegisterBitsDecl S' F A) -advanceDecl = \case +advanceDecl :: Word32 -> RegisterBitsDecl S F A -> M (Word32, RegisterBitsDecl S' F A) +advanceDecl offset = \case ReservedBits expr an -> do sz <- expressionToIntM expr (sz,) @@ -228,10 +226,10 @@ advanceDecl = \case <$> advanceStage () expr <*> pure an ) - DefinedBits mod ident typ annot -> do + DefinedBits _ mod ident typ annot -> do size <- bitsTypeSize typ (size,) - <$> (DefinedBits mod ident <$> advanceStage () typ <*> pure annot) + <$> (DefinedBits offset mod ident <$> advanceStage () typ <*> pure annot) BitsSubStructure subBody subName ann -> do (sz, body') <- advanceRegisterBody subBody return (sz, BitsSubStructure body' subName ann) |