Refactor cmmMakeDynamicReference

It now has its own class, and the addImport function is defined in that
class, rather than needing to be passed as an argument.

5 files changed, 27 insertions, 20 deletions

diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs
index 34c43090e8..a0a0a7130a 100644
--- a/compiler/nativeGen/AsmCodeGen.lhs
+++ b/compiler/nativeGen/AsmCodeGen.lhs
@@ -875,6 +875,9 @@ instance Monad CmmOptM where
                     case g x of
                       CmmOptM g' -> g' (imports', dflags)
 
+instance CmmMakeDynamicReferenceM CmmOptM where
+    addImport = addImportCmmOpt
+
 addImportCmmOpt :: CLabel -> CmmOptM ()
 addImportCmmOpt lbl = CmmOptM $ \(imports, _dflags) -> (# (), lbl:imports #)
 
@@ -986,10 +989,10 @@ cmmExprNative referenceKind expr = do
 
         CmmLit (CmmLabel lbl)
            -> do
-                cmmMakeDynamicReference dflags addImportCmmOpt referenceKind lbl
+                cmmMakeDynamicReference dflags referenceKind lbl
         CmmLit (CmmLabelOff lbl off)
            -> do
-                 dynRef <- cmmMakeDynamicReference dflags addImportCmmOpt referenceKind lbl
+                 dynRef <- cmmMakeDynamicReference dflags referenceKind lbl
                  -- need to optimize here, since it's late
                  return $ cmmMachOpFold dflags (MO_Add (wordWidth dflags)) [
                      dynRef,
diff --git a/compiler/nativeGen/PIC.hs b/compiler/nativeGen/PIC.hs
index 0187c4c410..6bf843affe 100644
--- a/compiler/nativeGen/PIC.hs
+++ b/compiler/nativeGen/PIC.hs
@@ -35,6 +35,7 @@
 
 module PIC (
         cmmMakeDynamicReference,
+        CmmMakeDynamicReferenceM(..),
         ReferenceKind(..),
         needImportedSymbols,
         pprImportedSymbol,
@@ -96,16 +97,20 @@ data ReferenceKind
         | JumpReference
         deriving(Eq)
 
+class Monad m => CmmMakeDynamicReferenceM m where
+    addImport :: CLabel -> m ()
+
+instance CmmMakeDynamicReferenceM NatM where
+    addImport = addImportNat
 
 cmmMakeDynamicReference
-  :: Monad m => DynFlags
-             -> (CLabel -> m ())  -- a monad & a function
-                                  -- used for recording imported symbols
-             -> ReferenceKind     -- whether this is the target of a jump
-             -> CLabel            -- the label
-             -> m CmmExpr
-
-cmmMakeDynamicReference dflags addImport referenceKind lbl
+  :: CmmMakeDynamicReferenceM m
+  => DynFlags
+  -> ReferenceKind     -- whether this is the target of a jump
+  -> CLabel            -- the label
+  -> m CmmExpr
+
+cmmMakeDynamicReference dflags referenceKind lbl
   | Just _ <- dynamicLinkerLabelInfo lbl
   = return $ CmmLit $ CmmLabel lbl   -- already processed it, pass through
 
diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs
index 92eff362f8..b3f5a48a5d 100644
--- a/compiler/nativeGen/PPC/CodeGen.hs
+++ b/compiler/nativeGen/PPC/CodeGen.hs
@@ -561,7 +561,7 @@ getRegister' _ (CmmLit (CmmInt i rep))
 getRegister' _ (CmmLit (CmmFloat f frep)) = do
     lbl <- getNewLabelNat
     dflags <- getDynFlags
-    dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
+    dynRef <- cmmMakeDynamicReference dflags DataReference lbl
     Amode addr addr_code <- getAmode dynRef
     let size = floatSize frep
         code dst =
@@ -1107,7 +1107,7 @@ genCCall' dflags gcp target dest_regs args0
         outOfLineMachOp mop =
             do
                 dflags <- getDynFlags
-                mopExpr <- cmmMakeDynamicReference dflags addImportNat CallReference $
+                mopExpr <- cmmMakeDynamicReference dflags CallReference $
                               mkForeignLabel functionName Nothing ForeignLabelInThisPackage IsFunction
                 let mopLabelOrExpr = case mopExpr of
                         CmmLit (CmmLabel lbl) -> Left lbl
@@ -1179,7 +1179,7 @@ genSwitch dflags expr ids
         tmp <- getNewRegNat II32
         lbl <- getNewLabelNat
         dflags <- getDynFlags
-        dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
+        dynRef <- cmmMakeDynamicReference dflags DataReference lbl
         (tableReg,t_code) <- getSomeReg $ dynRef
         let code = e_code `appOL` t_code `appOL` toOL [
                             SLW tmp reg (RIImm (ImmInt 2)),
@@ -1382,7 +1382,7 @@ coerceInt2FP fromRep toRep x = do
     itmp <- getNewRegNat II32
     ftmp <- getNewRegNat FF64
     dflags <- getDynFlags
-    dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
+    dynRef <- cmmMakeDynamicReference dflags DataReference lbl
     Amode addr addr_code <- getAmode dynRef
     let
         code' dst = code `appOL` maybe_exts `appOL` toOL [
diff --git a/compiler/nativeGen/SPARC/CodeGen.hs b/compiler/nativeGen/SPARC/CodeGen.hs
index 30ffcd9d9a..9c84a38f6a 100644
--- a/compiler/nativeGen/SPARC/CodeGen.hs
+++ b/compiler/nativeGen/SPARC/CodeGen.hs
@@ -588,7 +588,7 @@ outOfLineMachOp mop
                 = outOfLineMachOp_table mop
 
         dflags  <- getDynFlags
-        mopExpr <- cmmMakeDynamicReference dflags addImportNat CallReference
+        mopExpr <- cmmMakeDynamicReference dflags CallReference
                 $  mkForeignLabel functionName Nothing ForeignLabelInExternalPackage IsFunction
 
         let mopLabelOrExpr
diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs
index 36aebea2c7..ef8a628c1f 100644
--- a/compiler/nativeGen/X86/CodeGen.hs
+++ b/compiler/nativeGen/X86/CodeGen.hs
@@ -1170,7 +1170,6 @@ memConstant align lit = do
   (addr, addr_code) <- if target32Bit (targetPlatform dflags)
                        then do dynRef <- cmmMakeDynamicReference
                                              dflags
-                                             addImportNat
                                              DataReference
                                              lbl
                                Amode addr addr_code <- getAmode dynRef
@@ -1677,7 +1676,7 @@ genCCall is32Bit (PrimTarget (MO_PopCnt width)) dest_regs@[dst]
                          unitOL (POPCNT size (OpReg src_r)
                                  (getRegisterReg platform False (CmmLocal dst))))
         else do
-            targetExpr <- cmmMakeDynamicReference dflags addImportNat
+            targetExpr <- cmmMakeDynamicReference dflags
                           CallReference lbl
             let target = ForeignTarget targetExpr (ForeignConvention CCallConv
                                                            [NoHint] [NoHint]
@@ -1689,7 +1688,7 @@ genCCall is32Bit (PrimTarget (MO_PopCnt width)) dest_regs@[dst]
 
 genCCall is32Bit (PrimTarget (MO_UF_Conv width)) dest_regs args = do
     dflags <- getDynFlags
-    targetExpr <- cmmMakeDynamicReference dflags addImportNat
+    targetExpr <- cmmMakeDynamicReference dflags
                   CallReference lbl
     let target = ForeignTarget targetExpr (ForeignConvention CCallConv
                                            [NoHint] [NoHint]
@@ -2271,7 +2270,7 @@ outOfLineCmmOp :: CallishMachOp -> Maybe CmmFormal -> [CmmActual] -> NatM InstrB
 outOfLineCmmOp mop res args
   = do
       dflags <- getDynFlags
-      targetExpr <- cmmMakeDynamicReference dflags addImportNat CallReference lbl
+      targetExpr <- cmmMakeDynamicReference dflags CallReference lbl
       let target = ForeignTarget targetExpr
                            (ForeignConvention CCallConv [] [] CmmMayReturn)
 
@@ -2351,7 +2350,7 @@ genSwitch dflags expr ids
         (reg,e_code) <- getSomeReg expr
         lbl <- getNewLabelNat
         dflags <- getDynFlags
-        dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
+        dynRef <- cmmMakeDynamicReference dflags DataReference lbl
         (tableReg,t_code) <- getSomeReg $ dynRef
         let op = OpAddr (AddrBaseIndex (EABaseReg tableReg)
                                        (EAIndex reg (wORD_SIZE dflags)) (ImmInt 0))