compiler/ByteCode: Make LocalLabel a newtype

3 files changed, 17 insertions, 12 deletions

diff --git a/compiler/GHC/ByteCode/Asm.hs b/compiler/GHC/ByteCode/Asm.hs
index 72d29e3260..b59748bc92 100644
--- a/compiler/GHC/ByteCode/Asm.hs
+++ b/compiler/GHC/ByteCode/Asm.hs
@@ -182,7 +182,7 @@ assembleBCO platform (ProtoBCO { protoBCOName       = nm
         | isLarge n_insns0 = (inspectAsm platform True initial_offset asm, True)
         | otherwise = ((n_insns0, lbl_map0), False)
 
-      env :: Word16 -> Word
+      env :: LocalLabel -> Word
       env lbl = fromMaybe
         (pprPanic "assembleBCO.findLabel" (ppr lbl))
         (Map.lookup lbl lbl_map)
@@ -222,13 +222,13 @@ type AsmState = (SizedSeq Word16,
 data Operand
   = Op Word
   | SmallOp Word16
-  | LabelOp Word16
+  | LabelOp LocalLabel
 -- (unused)  | LargeOp Word
 
 data Assembler a
   = AllocPtr (IO BCOPtr) (Word -> Assembler a)
   | AllocLit [BCONPtr] (Word -> Assembler a)
-  | AllocLabel Word16 (Assembler a)
+  | AllocLabel LocalLabel (Assembler a)
   | Emit Word16 [Operand] (Assembler a)
   | NullAsm a
   deriving (Functor)
@@ -253,13 +253,13 @@ ptr = ioptr . return
 lit :: [BCONPtr] -> Assembler Word
 lit l = AllocLit l return
 
-label :: Word16 -> Assembler ()
+label :: LocalLabel -> Assembler ()
 label w = AllocLabel w (return ())
 
 emit :: Word16 -> [Operand] -> Assembler ()
 emit w ops = Emit w ops (return ())
 
-type LabelEnv = Word16 -> Word
+type LabelEnv = LocalLabel -> Word
 
 largeOp :: Bool -> Operand -> Bool
 largeOp long_jumps op = case op of
@@ -299,7 +299,7 @@ runAsm platform long_jumps e = go
         in ((), (st_i1,st_l0,st_p0))
       go k
 
-type LabelEnvMap = Map Word16 Word
+type LabelEnvMap = Map LocalLabel Word
 
 data InspectState = InspectState
   { instrCount :: !Word
diff --git a/compiler/GHC/ByteCode/Instr.hs b/compiler/GHC/ByteCode/Instr.hs
index e4c3de7913..aecc7c9181 100644
--- a/compiler/GHC/ByteCode/Instr.hs
+++ b/compiler/GHC/ByteCode/Instr.hs
@@ -6,7 +6,7 @@
 
 -- | Bytecode instruction definitions
 module GHC.ByteCode.Instr (
-        BCInstr(..), ProtoBCO(..), bciStackUse,
+        BCInstr(..), ProtoBCO(..), bciStackUse, LocalLabel(..)
   ) where
 
 #include "HsVersions.h"
@@ -50,7 +50,11 @@ data ProtoBCO a
         protoBCOFFIs       :: [FFIInfo]
    }
 
-type LocalLabel = Word16
+newtype LocalLabel = LocalLabel { getLocalLabel :: Word16 }
+  deriving (Eq, Ord)
+
+instance Outputable LocalLabel where
+  ppr (LocalLabel lbl) = text "lbl:" <> ppr lbl
 
 data BCInstr
    -- Messing with the stack
diff --git a/compiler/GHC/CoreToByteCode.hs b/compiler/GHC/CoreToByteCode.hs
index 284be0ce08..25503fa7c3 100644
--- a/compiler/GHC/CoreToByteCode.hs
+++ b/compiler/GHC/CoreToByteCode.hs
@@ -74,6 +74,7 @@ import GHC.Unit.Module
 
 import Control.Exception
 import Data.Array
+import Data.Coerce (coerce)
 import Data.ByteString (ByteString)
 import Data.Map (Map)
 import Data.IntMap (IntMap)
@@ -2032,17 +2033,17 @@ recordFFIBc :: RemotePtr C_ffi_cif -> BcM ()
 recordFFIBc a
   = BcM $ \st -> return (st{ffis = FFIInfo a : ffis st}, ())
 
-getLabelBc :: BcM Word16
+getLabelBc :: BcM LocalLabel
 getLabelBc
   = BcM $ \st -> do let nl = nextlabel st
                     when (nl == maxBound) $
                         panic "getLabelBc: Ran out of labels"
-                    return (st{nextlabel = nl + 1}, nl)
+                    return (st{nextlabel = nl + 1}, LocalLabel nl)
 
-getLabelsBc :: Word16 -> BcM [Word16]
+getLabelsBc :: Word16 -> BcM [LocalLabel]
 getLabelsBc n
   = BcM $ \st -> let ctr = nextlabel st
-                 in return (st{nextlabel = ctr+n}, [ctr .. ctr+n-1])
+                 in return (st{nextlabel = ctr+n}, coerce [ctr .. ctr+n-1])
 
 getCCArray :: BcM (Array BreakIndex (RemotePtr CostCentre))
 getCCArray = BcM $ \st ->