diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Language/Fiddle/Compiler/ConsistencyCheck.hs | 15 |
1 files changed, 8 insertions, 7 deletions
diff --git a/src/Language/Fiddle/Compiler/ConsistencyCheck.hs b/src/Language/Fiddle/Compiler/ConsistencyCheck.hs index 3e81153..6a3b5d9 100644 --- a/src/Language/Fiddle/Compiler/ConsistencyCheck.hs +++ b/src/Language/Fiddle/Compiler/ConsistencyCheck.hs @@ -165,7 +165,7 @@ advanceObjTypeBody (ObjTypeBody us decls a) startOffset = do =<< checkBitsSizeMod8 a reifiedSize (RegisterDecl qmeta mod ident size (Just body) a) -> do declaredSize <- expressionToIntM size - (actualSize, body') <- advanceRegisterBody body + (actualSize, body') <- advanceRegisterBody 0 body checkSizeMismatch a declaredSize actualSize @@ -190,9 +190,10 @@ pattern RegisterBodyPattern u decls a b = RegisterBody u (Identity (DeferredRegi -- registerBodyPattern u decls a b = RegisterBody u (Identity (DeferredRegisterBody decls a)) a -advanceRegisterBody :: RegisterBody S F A -> M (N Bits, RegisterBody S' F A) +advanceRegisterBody :: N Bits -> RegisterBody S F A -> M (N Bits, RegisterBody S' F A) -- Handle the case where it's a union. advanceRegisterBody + startOffset (RegisterBodyPattern us (NonEmpty.nonEmpty -> Just decls) a b) = do (structSize, reverse -> decls') <- foldlM @@ -204,7 +205,7 @@ advanceRegisterBody Struct {} -> off + sz return (advanceOffset offset sz, (sz, mapDirected (const t) d) : ret) ) - (0, []) + (startOffset, []) decls calcSize <- case us of Union {} -> do @@ -215,9 +216,9 @@ advanceRegisterBody return (calcSize, RegisterBodyPattern us (map snd $ toList decls') a b) -- Handle the case where there's no decls. -advanceRegisterBody (RegisterBodyPattern u _ a b) = +advanceRegisterBody _ (RegisterBodyPattern u _ a b) = return (0, RegisterBodyPattern u [] a b) -advanceRegisterBody RegisterBody {} = error "GHC not smart enuf" +advanceRegisterBody _ RegisterBody {} = error "GHC not smart enuf" checkJagged :: (Annotated t) => [(N u, t f A)] -> Compile s () checkJagged decls = do @@ -248,11 +249,11 @@ advanceDecl offset = \case size <- bitsTypeSize typ let span = Present (FieldSpan offset size) qmeta' = fmap (\q -> q {bitsSpan = span}) qmeta - + (size,) <$> (DefinedBits qmeta' mod ident <$> advanceStage () typ <*> pure annot) BitsSubStructure subBody subName ann -> do - (sz, body') <- advanceRegisterBody subBody + (sz, body') <- advanceRegisterBody offset subBody return (sz, BitsSubStructure body' subName ann) bitsTypeSize :: RegisterBitsTypeRef S F A -> M (N Bits) |