Get rid of the DFunArg type and all its works

This type was mainly there to support silent superclass
parameters for dfuns, and they have gone away.  So this
patch is another minor simplification.

(Interface format change; you need to make clean.)

14 files changed, 17 insertions, 51 deletions

diff --git a/compiler/coreSyn/CoreFVs.lhs b/compiler/coreSyn/CoreFVs.lhs
index 33017227b4..f88cb0be68 100644
--- a/compiler/coreSyn/CoreFVs.lhs
+++ b/compiler/coreSyn/CoreFVs.lhs
@@ -450,7 +450,7 @@ idUnfoldingVars id = stableUnfoldingVars (realIdUnfolding id)
 stableUnfoldingVars :: Unfolding -> VarSet
 stableUnfoldingVars (CoreUnfolding { uf_tmpl = rhs, uf_src = src })
   | isStableSource src                       = exprFreeVars rhs
-stableUnfoldingVars (DFunUnfolding _ _ args) = exprsFreeVars (dfunArgExprs args)
+stableUnfoldingVars (DFunUnfolding _ _ args) = exprsFreeVars args
 stableUnfoldingVars _                        = emptyVarSet
 \end{code}
 
diff --git a/compiler/coreSyn/CoreSubst.lhs b/compiler/coreSyn/CoreSubst.lhs
index 0c954a8927..3ba8afaad3 100644
--- a/compiler/coreSyn/CoreSubst.lhs
+++ b/compiler/coreSyn/CoreSubst.lhs
@@ -623,7 +623,7 @@ substUnfoldingSC subst unf 	 -- Short-cut version
 substUnfolding subst (DFunUnfolding ar con args)
   = DFunUnfolding ar con (map subst_arg args)
   where
-    subst_arg = fmap (substExpr (text "dfun-unf") subst)
+    subst_arg = substExpr (text "dfun-unf") subst
 
 substUnfolding subst unf@(CoreUnfolding { uf_tmpl = tmpl, uf_src = src })
 	-- Retain an InlineRule!
diff --git a/compiler/coreSyn/CoreSyn.lhs b/compiler/coreSyn/CoreSyn.lhs
index 7582481091..872e732a61 100644
--- a/compiler/coreSyn/CoreSyn.lhs
+++ b/compiler/coreSyn/CoreSyn.lhs
@@ -39,7 +39,6 @@ module CoreSyn (
 
 	-- * Unfolding data types
         Unfolding(..),  UnfoldingGuidance(..), UnfoldingSource(..),
-        DFunArg(..), dfunArgExprs,
 
 	-- ** Constructing 'Unfolding's
 	noUnfolding, evaldUnfolding, mkOtherCon,
@@ -459,7 +458,7 @@ data Unfolding
 
         DataCon 	-- The dictionary data constructor (possibly a newtype datacon)
 
-        [DFunArg CoreExpr]  -- Specification of superclasses and methods, in positional order
+        [CoreExpr]      -- Specification of superclasses and methods, in positional order
 
   | CoreUnfolding {		-- An unfolding for an Id with no pragma, 
                                 -- or perhaps a NOINLINE pragma
@@ -497,21 +496,6 @@ data Unfolding
   --  uf_guidance:  Tells us about the /size/ of the unfolding template
 
 ------------------------------------------------
-data DFunArg e   -- Given (df a b d1 d2 d3)
-  = DFunPolyArg  e      -- Arg is (e a b d1 d2 d3)
-  | DFunConstArg e      -- Arg is e, which is constant
-  deriving( Functor )
-
-  -- 'e' is often CoreExpr, which are usually variables, but can
-  -- be trivial expressions instead (e.g. a type application).
-
-dfunArgExprs :: [DFunArg e] -> [e]
-dfunArgExprs [] = []
-dfunArgExprs (DFunPolyArg  e : as) = e : dfunArgExprs as
-dfunArgExprs (DFunConstArg e : as) = e : dfunArgExprs as
-
-
-------------------------------------------------
 data UnfoldingSource
   = InlineRhs          -- The current rhs of the function
     		       -- Replace uf_tmpl each time around
diff --git a/compiler/coreSyn/CoreTidy.lhs b/compiler/coreSyn/CoreTidy.lhs
index 377bfd8c84..110fd72701 100644
--- a/compiler/coreSyn/CoreTidy.lhs
+++ b/compiler/coreSyn/CoreTidy.lhs
@@ -198,7 +198,7 @@ tidyIdBndr env@(tidy_env, var_env) id
 ------------ Unfolding  --------------
 tidyUnfolding :: TidyEnv -> Unfolding -> Unfolding -> Unfolding
 tidyUnfolding tidy_env (DFunUnfolding ar con ids) _
-  = DFunUnfolding ar con (map (fmap (tidyExpr tidy_env)) ids)
+  = DFunUnfolding ar con (map (tidyExpr tidy_env) ids)
 tidyUnfolding tidy_env 
               unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src })
               unf_from_rhs
diff --git a/compiler/coreSyn/CoreUnfold.lhs b/compiler/coreSyn/CoreUnfold.lhs
index fe3772c2a8..f849dfa58d 100644
--- a/compiler/coreSyn/CoreUnfold.lhs
+++ b/compiler/coreSyn/CoreUnfold.lhs
@@ -93,7 +93,7 @@ mkImplicitUnfolding expr = mkTopUnfolding False (simpleOptExpr expr)
 mkSimpleUnfolding :: CoreExpr -> Unfolding
 mkSimpleUnfolding = mkUnfolding InlineRhs False False
 
-mkDFunUnfolding :: Type -> [DFunArg CoreExpr] -> Unfolding
+mkDFunUnfolding :: Type -> [CoreExpr] -> Unfolding
 mkDFunUnfolding dfun_ty ops 
   = DFunUnfolding dfun_nargs data_con ops
   where
@@ -1299,8 +1299,7 @@ exprIsConApp_maybe id_unf expr
              pprTrace "Unsaturated dfun" (ppr fun <+> int dfun_nargs $$ ppr args) False   
         , let (dfun_tvs, _n_theta, _cls, dfun_res_tys) = tcSplitDFunTy (idType fun)
               subst    = zipOpenTvSubst dfun_tvs (stripTypeArgs (takeList dfun_tvs args))
-              mk_arg (DFunConstArg e) = e
-              mk_arg (DFunPolyArg e)  = mkApps e args
+              mk_arg e = mkApps e args
         = Just (con, substTys subst dfun_res_tys, map mk_arg ops)
 
 	-- Look through unfoldings, but only cheap ones, because
diff --git a/compiler/coreSyn/PprCore.lhs b/compiler/coreSyn/PprCore.lhs
index 8d0239d8e4..bd6cdf4c7f 100644
--- a/compiler/coreSyn/PprCore.lhs
+++ b/compiler/coreSyn/PprCore.lhs
@@ -438,10 +438,6 @@ instance Outputable Unfolding where
              | otherwise          = empty
             -- Don't print the RHS or we get a quadratic 
 	    -- blowup in the size of the printout!
-
-instance Outputable e => Outputable (DFunArg e) where
-  ppr (DFunPolyArg e)  = braces (ppr e)
-  ppr (DFunConstArg e) = ppr e
 \end{code}
 
 -----------------------------------------------------
diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
index 1e24f34dd3..48a94c74e2 100644
--- a/compiler/iface/BinIface.hs
+++ b/compiler/iface/BinIface.hs
@@ -18,7 +18,6 @@ import HscTypes
 import BasicTypes
 import Demand
 import Annotations
-import CoreSyn
 import IfaceSyn
 import Module
 import Name
@@ -1273,14 +1272,6 @@ instance Binary IfaceUnfolding where
 	  _ -> do e <- get bh
 		  return (IfCompulsory e)
 
-instance Binary (DFunArg IfaceExpr) where
-    put_ bh (DFunPolyArg  e) = putByte bh 0 >> put_ bh e
-    put_ bh (DFunConstArg e) = putByte bh 1 >> put_ bh e
-    get bh = do { h <- getByte bh
-                ; case h of
-                    0 -> do { a <- get bh; return (DFunPolyArg a) }
-                    _ -> do { a <- get bh; return (DFunConstArg a) } }
-
 instance Binary IfaceNote where
     put_ bh (IfaceSCC aa) = do
 	    putByte bh 0
diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs
index 41732a9215..e03bc29326 100644
--- a/compiler/iface/IfaceSyn.lhs
+++ b/compiler/iface/IfaceSyn.lhs
@@ -27,8 +27,6 @@ module IfaceSyn (
 #include "HsVersions.h"
 
 import IfaceType
-import CoreSyn( DFunArg, dfunArgExprs )
-import PprCore()     -- Printing DFunArgs
 import Demand
 import Annotations
 import Class
@@ -220,7 +218,7 @@ data IfaceUnfolding
   | IfLclWrapper Arity IfLclName  --     because the worker can simplify to a function in
                                   --     another module.
 
-  | IfDFunUnfold [DFunArg IfaceExpr]
+  | IfDFunUnfold [IfaceExpr]
 
 --------------------------------
 data IfaceExpr
@@ -826,7 +824,7 @@ freeNamesIfUnfold (IfCompulsory e)       = freeNamesIfExpr e
 freeNamesIfUnfold (IfInlineRule _ _ _ e) = freeNamesIfExpr e
 freeNamesIfUnfold (IfExtWrapper _ v)     = unitNameSet v
 freeNamesIfUnfold (IfLclWrapper {})      = emptyNameSet
-freeNamesIfUnfold (IfDFunUnfold vs)      = fnList freeNamesIfExpr (dfunArgExprs vs)
+freeNamesIfUnfold (IfDFunUnfold vs)      = fnList freeNamesIfExpr vs
 
 freeNamesIfExpr :: IfaceExpr -> NameSet
 freeNamesIfExpr (IfaceExt v)      = unitNameSet v
diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index 42a4278b4f..3612372f8a 100644
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -1563,7 +1563,7 @@ toIfUnfolding lb (CoreUnfolding { uf_tmpl = rhs, uf_arity = arity
     if_rhs = toIfaceExpr rhs
 
 toIfUnfolding lb (DFunUnfolding _ar _con ops)
-  = Just (HsUnfold lb (IfDFunUnfold (map (fmap toIfaceExpr) ops)))
+  = Just (HsUnfold lb (IfDFunUnfold (map toIfaceExpr ops)))
       -- No need to serialise the data constructor; 
       -- we can recover it from the type of the dfun
 
diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs
index 2187f03c61..32c0b2c801 100644
--- a/compiler/iface/TcIface.lhs
+++ b/compiler/iface/TcIface.lhs
@@ -1091,14 +1091,12 @@ tcUnfolding name _ _ (IfInlineRule arity unsat_ok boring_ok if_expr)
     }
 
 tcUnfolding name dfun_ty _ (IfDFunUnfold ops)
-  = do { mb_ops1 <- forkM_maybe doc $ mapM tc_arg ops
+  = do { mb_ops1 <- forkM_maybe doc $ mapM tcIfaceExpr ops
        ; return (case mb_ops1 of
        	 	    Nothing   -> noUnfolding
                     Just ops1 -> mkDFunUnfolding dfun_ty ops1) }
   where
     doc = text "Class ops for dfun" <+> ppr name
-    tc_arg (DFunPolyArg  e) = do { e' <- tcIfaceExpr e; return (DFunPolyArg e') }
-    tc_arg (DFunConstArg e) = do { e' <- tcIfaceExpr e; return (DFunConstArg e') }
 
 tcUnfolding name ty info (IfExtWrapper arity wkr)
   = tcIfaceWrapper name ty info arity (tcIfaceExtId wkr)
diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs
index c3be64b60a..71f7baf054 100644
--- a/compiler/main/TidyPgm.lhs
+++ b/compiler/main/TidyPgm.lhs
@@ -726,7 +726,7 @@ addExternal expose_all id = (new_needed_ids, show_unfold)
 		      CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src, uf_guidance = guide } 
 					    | show_unfolding src guide
 					    -> Just (unf_ext_ids src unf_rhs)
-                      DFunUnfolding _ _ ops -> Just (exprsFvsInOrder (dfunArgExprs ops))
+                      DFunUnfolding _ _ ops -> Just (exprsFvsInOrder ops)
 		      _                     -> Nothing
                   where
                     unf_ext_ids (InlineWrapper v) _ = (unitVarSet v, [v])
diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index b187897f89..a1cae1c5dd 100644
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -707,7 +707,7 @@ simplUnfolding :: SimplEnv-> TopLevelFlag
 simplUnfolding env _ _ _ (DFunUnfolding ar con ops)
   = return (DFunUnfolding ar con ops')
   where
-    ops' = map (fmap (substExpr (text "simplUnfolding") env)) ops
+    ops' = map (substExpr (text "simplUnfolding") env) ops
 
 simplUnfolding env top_lvl id _
     (CoreUnfolding { uf_tmpl = expr, uf_arity = arity
diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs
index 33ad0f0f87..528bb0e4ec 100644
--- a/compiler/typecheck/TcInstDcls.lhs
+++ b/compiler/typecheck/TcInstDcls.lhs
@@ -37,7 +37,7 @@ import Pair
 --import VarSet
 import CoreUtils  ( mkPiTypes )
 import CoreUnfold ( mkDFunUnfolding )
-import CoreSyn    ( Expr(Var), DFunArg(..), CoreExpr, varToCoreExpr )
+import CoreSyn    ( Expr(Var), CoreExpr, varToCoreExpr )
 import Id
 import MkId
 import Name
@@ -863,9 +863,9 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = ibinds })
                 = dfun_id `setIdUnfolding`  mkDFunUnfolding dfun_ty dfun_args
                           `setInlinePragma` dfunInlinePragma
 
-             dfun_args :: [DFunArg CoreExpr]
-             dfun_args = map (DFunPolyArg . varToCoreExpr) sc_args ++
-                         map (DFunPolyArg . Var) meth_ids
+             dfun_args :: [CoreExpr]
+             dfun_args = map varToCoreExpr sc_args ++
+                         map Var           meth_ids
 
              main_bind = AbsBinds { abs_tvs = inst_tyvars
                                   , abs_ev_vars = dfun_ev_vars
diff --git a/compiler/vectorise/Vectorise/Type/PADict.hs b/compiler/vectorise/Vectorise/Type/PADict.hs
index 3fc2d0aea3..ba2b3950a8 100644
--- a/compiler/vectorise/Vectorise/Type/PADict.hs
+++ b/compiler/vectorise/Vectorise/Type/PADict.hs
@@ -73,7 +73,7 @@ buildPADict vect_tc prepr_tc arr_tc repr
       -- Set the unfolding for the inliner.
       raw_dfun <- newExportedVar dfun_name dfun_ty
       let dfun_unf = mkDFunUnfolding dfun_ty $
-                     map (DFunPolyArg . Var) method_ids
+                     map Var method_ids
           dfun = raw_dfun `setIdUnfolding`  dfun_unf
                           `setInlinePragma` dfunInlinePragma