Much better handling for the generic syntax tree.

It now converts normal data into JSON rather than using "show".

1 files changed, 51 insertions, 1 deletions

diff --git a/src/Language/Fiddle/Compiler/ConsistencyCheck.hs b/src/Language/Fiddle/Compiler/ConsistencyCheck.hs
index 410f3e2..abcf214 100644
--- a/src/Language/Fiddle/Compiler/ConsistencyCheck.hs
+++ b/src/Language/Fiddle/Compiler/ConsistencyCheck.hs
@@ -61,7 +61,13 @@ deriving instance AdvanceStage S AnonymousBitsType
 
 deriving instance AdvanceStage S ImportStatement
 
-deriving instance AdvanceStage S BitType
+instance AdvanceStage S BitType where
+  customAdvanceStage t _ = do
+    case t of
+      (EnumBitType sz body _) -> do
+        checkEnumConsistency sz body
+      _ -> return ()
+    return Nothing
 
 deriving instance AdvanceStage S EnumBody
 
@@ -282,3 +288,47 @@ checkBitsSizeMod8 a w = do
     (printf "Register size %d is not a multiple of 8. Please add padding to this register." w)
     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