summaryrefslogtreecommitdiff
path: root/src/Language/Fiddle/Compiler
diff options
context:
space:
mode:
Diffstat (limited to 'src/Language/Fiddle/Compiler')
-rw-r--r--src/Language/Fiddle/Compiler/Stage2.hs22
1 files changed, 16 insertions, 6 deletions
diff --git a/src/Language/Fiddle/Compiler/Stage2.hs b/src/Language/Fiddle/Compiler/Stage2.hs
index 7306b3f..adf5450 100644
--- a/src/Language/Fiddle/Compiler/Stage2.hs
+++ b/src/Language/Fiddle/Compiler/Stage2.hs
@@ -9,7 +9,7 @@ module Language.Fiddle.Compiler.Stage2 (toStage3) where
import Control.Monad (forM, forM_, unless, when)
import Control.Monad.Identity (Identity (Identity))
-import Control.Monad.RWS (MonadState (get), MonadWriter (tell), gets, modify')
+import Control.Monad.RWS (MonadState (get, put), MonadWriter (tell), gets, modify')
import Data.Foldable (Foldable (toList), foldlM)
import Data.Functor.Identity
import qualified Data.IntMap as IntMap
@@ -492,13 +492,23 @@ getTypeSize (EnumBitType expr (Identity (EnumBody constants _)) ann) = do
return declaredSize
-insertTypeSize :: LocalState -> Identifier f a -> SizeBits -> Compile GlobalState ()
-insertTypeSize (LocalState scopePath) (Identifier s _) size = do
- modify' $
+diagnosticError :: String -> Annot -> Compile a ()
+diagnosticError str a = tell [Diagnostic Error str (unCommented a)]
+
+insertTypeSize :: LocalState -> Identifier f Annot -> SizeBits -> Compile GlobalState ()
+insertTypeSize (LocalState scopePath) (Identifier s annot) size = do
+ modifyM $
\(GlobalState globalScope) ->
let fullName =
NonEmpty.prependList
(currentScope scopePath)
(NonEmpty.singleton (Text.unpack s))
- in GlobalState $
- insertScope fullName (Right size) globalScope
+ in case upsertScope fullName (Right size) globalScope of
+ (Just _, _) -> do
+ diagnosticError (printf "Duplicate type %s" s) annot
+ compilationFailure
+ (Nothing, n) -> return $ GlobalState n
+ where
+ modifyM fn = do
+ s <- get
+ put =<< fn s