diff options
| -rw-r--r-- | src/Language/Fiddle/Compiler/ConsistencyCheck.hs | 87 |
1 files changed, 42 insertions, 45 deletions
diff --git a/src/Language/Fiddle/Compiler/ConsistencyCheck.hs b/src/Language/Fiddle/Compiler/ConsistencyCheck.hs index abcf214..2172694 100644 --- a/src/Language/Fiddle/Compiler/ConsistencyCheck.hs +++ b/src/Language/Fiddle/Compiler/ConsistencyCheck.hs @@ -7,11 +7,13 @@ module Language.Fiddle.Compiler.ConsistencyCheck (consistencyCheckPhase) where -import Control.Monad (forM_, when) +import Control.Monad (forM_, unless, when) import Control.Monad.RWS (MonadWriter (tell)) import Control.Monad.Trans.Writer (Writer, execWriter) import Data.Foldable (foldlM, toList) import Data.Functor.Identity +import qualified Data.IntMap as IntMap +import Data.List (intercalate) import qualified Data.List.NonEmpty as NonEmpty import Data.Typeable import Data.Word (Word32) @@ -64,7 +66,7 @@ deriving instance AdvanceStage S ImportStatement instance AdvanceStage S BitType where customAdvanceStage t _ = do case t of - (EnumBitType sz body _) -> do + (EnumBitType sz (Identity body) _) -> do checkEnumConsistency sz body _ -> return () return Nothing @@ -289,46 +291,41 @@ checkBitsSizeMod8 a w = do a return ((w `div` 8) + 1) --- getTypeSize (EnumBitType expr (Identity (EnumBody constants _)) ann) = do --- declaredSize <- fromIntegral <$> exprToSize expr --- --- -- If the declared size is less than or equal to 4, we'll enforce that the --- -- enum is packed. This is to make sure the user has covered all bases. --- when (declaredSize <= 4) $ do --- imap <- --- foldlM --- ( \imap (undirected -> enumConst) -> do --- number <- case enumConst of --- EnumConstantDecl _ expr _ -> exprToSize expr --- EnumConstantReserved expr _ -> exprToSize expr --- --- when (number >= 2 ^ declaredSize) $ --- tell --- [ Diagnostic --- Error --- ( printf --- "Enum constant too large. Max allowed %d\n" --- ((2 :: Int) ^ declaredSize) --- ) --- (unCommented (annot enumConst)) --- ] --- --- return $ IntMap.insert (fromIntegral number) True imap --- ) --- IntMap.empty --- constants --- let missing = --- filter (not . (`IntMap.member` imap)) [0 .. 2 ^ declaredSize - 1] --- unless (null missing) $ --- tell --- [ Diagnostic --- Warning --- ( printf --- "Missing enum constants %s. Small enums should be fully \ --- \ populated. Use 'reserved' if needed." --- (intercalate ", " (map show missing)) --- ) --- (unCommented ann) --- ] --- --- return declaredSize +checkEnumConsistency :: Expression S F A -> EnumBody S F A -> M () +checkEnumConsistency expr enumBody@(EnumBody {enumConsts = constants}) = do + declaredSize <- expressionToIntM expr + + -- If the declared size is less than or equal to 4, we'll enforce that the + -- enum is packed. This is to make sure the user has covered all bases. + when (declaredSize <= (4 :: Word32)) $ do + imap <- + foldlM + ( \imap (undirected -> enumConst) -> do + number <- case enumConst of + EnumConstantDecl _ expr _ -> expressionToIntM expr + EnumConstantReserved expr _ -> expressionToIntM expr + + when (number >= (2 :: Word32) ^ declaredSize) $ + emitDiagnosticError + ( printf + "Enum constant too large. Max allowed %d\n" + ((2 :: Int) ^ declaredSize) + ) + (annot enumConst) + + return $ IntMap.insert (fromIntegral number) True imap + ) + IntMap.empty + constants + + let missing = + filter (not . (`IntMap.member` imap)) [0 .. 2 ^ declaredSize - 1] + + unless (null missing) $ + emitDiagnosticWarning + ( printf + "Missing enum constants %s. Small enums should be fully \ + \ populated. Use 'reserved' if needed." + (intercalate ", " (map show missing)) + ) + (annot enumBody) |