GHC 9.4 compatibility

src/Z80/Assembler.hs

@@ -1,5 +1,8 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE CPP #-}
+
 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
 
 module Z80.Assembler
@@ -10,6 +13,7 @@ module Z80.Assembler
   , code
   , Bytes (..)
   , db
+  , resb
   , equ
   , label
   , labelled
@@ -25,15 +29,18 @@ import Data.ByteString (ByteString)
 import Control.Monad.RWS
 import Data.Maybe
 
+#if !MIN_VERSION_base(4,8,0)
 import Control.Applicative
 import Data.Traversable (traverse)
+#endif
 import Prelude
 
 import Z80.Operands
 
 data ASMState
   = ASMState
   { loc   :: Location
+  , lastLoc :: Location
   , entry :: Maybe Location
   }
 
@@ -48,29 +55,49 @@ data ASMBlock
   , asmData  :: ByteString
   } deriving (Eq, Show)
 
-incrementLoc :: Location -> ASMState -> ASMState
-incrementLoc x st = st { loc = loc st + x }
+fillToLoc :: Z80ASM
+fillToLoc = Z80 $ do
+    padding <- gets $ \st -> loc st - lastLoc st
+    tell $ BS.replicate (fromIntegral padding) 0x00
+
+incrementLoc :: Location -> Z80ASM
+incrementLoc x = do
+    fillToLoc
+    Z80 $ modify $ \st -> let loc' = loc st + x in st{ loc = loc', lastLoc = loc' }
+
+reserveLoc :: Location -> ASMState -> ASMState
+reserveLoc x st = st{ loc = loc st + x }
+
+tellBytes :: [Word8] -> Z80ASM
+tellBytes bytes = do
+    Z80 $ tell $ BS.pack bytes
+    incrementLoc . fromIntegral $ length bytes
+      -- The new location has to be computed lazily in the actual
+      -- content of the bytes, so that we can emit byte values
+      -- referring to later labels.
 
 code :: [Word8] -> Z80ASM
-code bytes = Z80 $ do
-  tell $ BS.pack bytes
-  modify (incrementLoc . fromIntegral $ length bytes)
+code = tellBytes
 
 class Bytes a where
   defb :: a -> Z80ASM
 
 instance Bytes ByteString where
   defb = defByteString
 instance (b ~ Word8) => Bytes [b] where
-  defb = defByteString . BS.pack
+  defb = tellBytes
 
 db :: Bytes a => a -> Z80ASM
 db = defb
 
+resb :: Word16 -> Z80ASM
+resb n = Z80 $ do
+    modify $ reserveLoc n
+
 defByteString :: ByteString -> Z80ASM
-defByteString bs = Z80 $ do
-  tell bs
-  modify (incrementLoc . fromIntegral $ BS.length bs)
+defByteString bs = do
+  Z80 $ tell bs
+  incrementLoc . fromIntegral $ BS.length bs
 
 label :: Z80 Location
 label = loc <$> Z80 get
@@ -92,16 +119,18 @@ beginExecution :: Z80ASM
 beginExecution = do
   l <- label
   Z80 . modify $ setEntry l
-  where setEntry l st@(ASMState _ Nothing)  = st { entry = Just l }
-        setEntry l st@(ASMState _ (Just e)) =
-          error $ "Cannot set execution start point twice.  First start point: " ++ show e ++
-                  " This start point: " ++ show l
+  where setEntry l st = case entry st of
+            Nothing -> st{ entry = Just l }
+            Just e ->
+              error $ "Cannot set execution start point twice.  First start point: " ++ show e ++
+                        " This start point: " ++ show l
 
 org :: Location -> Z80ASM -> ASMBlock
 org addr (Z80 mc) = ASMBlock { asmOrg = addr,
                                asmEntry = fromMaybe addr $ entry finalState,
-                               asmData = asm }
- where ((), finalState, asm) = runRWS mc () (ASMState addr Nothing)
+                               asmData = truncate asm }
+ where ((), finalState, asm) = runRWS mc () (ASMState addr addr Nothing)
+       truncate = BS.take (fromIntegral $ lastLoc finalState - addr)
 
 equ :: a -> Z80 a
 equ = return

src/Z80/Operations.hs

@@ -1,8 +1,10 @@
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE IncoherentInstances #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE CPP #-}
 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
 
 module Z80.Operations
@@ -107,7 +109,9 @@ import Data.Word
 import Z80.Assembler
 import Z80.Operands
 
+#if !MIN_VERSION_base(4,8,0)
 import Control.Applicative ((<$>))
+#endif
 import Control.Monad       ((>=>))
 import Prelude hiding      (and, or)
 

z80.cabal

@@ -19,7 +19,7 @@ library
                        Z80.Operands,
                        Z80.Operands.LowerCase,
                        Z80.Macros
-  build-depends:       base >=4.7 && <4.9,
+  build-depends:       base >=4.7,
                        bytestring,
                        mtl
   hs-source-dirs:      src