Remove "silent superclass parameters"

We introduced silent superclass parameters as a way to avoid
superclass loops, but we now solve that problem a different
way ("derived" superclass constraints carry no evidence). So
they aren't needed any more.

Apart from being a needless complication, they broke DoCon.
Admittedly in a very obscure way, but still the result is
hard to explain. To see the details see Trac #5051, with
test case typecheck/should_compile/T5051.  (The test is
nice and small!)

3 files changed, 56 insertions, 61 deletions

diff --git a/compiler/vectorise/Vectorise/Type/PADict.hs b/compiler/vectorise/Vectorise/Type/PADict.hs
index 4c786cf618..3fc2d0aea3 100644
--- a/compiler/vectorise/Vectorise/Type/PADict.hs
+++ b/compiler/vectorise/Vectorise/Type/PADict.hs
@@ -5,7 +5,7 @@ where
 import Vectorise.Monad
 import Vectorise.Builtins
 import Vectorise.Type.Repr
-import Vectorise.Type.PRepr
+import Vectorise.Type.PRepr( buildPAScAndMethods )
 import Vectorise.Utils
 
 import BasicTypes
@@ -18,13 +18,13 @@ import TypeRep
 import Id
 import Var
 import Name
-import FastString
+-- import FastString
 -- import Outputable
 
 -- debug		= False
 -- dtrace s x	= if debug then pprTrace "Vectoris.Type.PADict" s x else x
 
--- | Build the PA dictionary for some type and hoist it to top level.
+-- | Build the PA dictionary function for some type and hoist it to top level.
 --   The PA dictionary holds fns that convert values to and from their vectorised representations.
 buildPADict
 	:: TyCon	-- ^ tycon of the type being vectorised.
@@ -33,48 +33,47 @@ buildPADict
 	-> SumRepr	-- ^ representation used for the type being vectorised.
 	-> VM Var	-- ^ name of the top-level dictionary function.
 
-buildPADict vect_tc prepr_tc arr_tc repr
- = polyAbstract tvs $ \args ->
-   do
-      -- The superclass dictionary is an argument if the tycon is polymorphic
-      let mk_super_ty = do
-                          r <- mkPReprType inst_ty
-                          pr_cls <- builtin prClass
-                          return $ PredTy $ ClassP pr_cls [r]
-      super_tys <- sequence [mk_super_ty | not (null tvs)]
-      super_args <- mapM (newLocalVar (fsLit "pr")) super_tys
-      let args' = super_args ++ args
-
-      -- it is constant otherwise
-      super_consts <- sequence [prDictOfPReprInstTyCon inst_ty prepr_tc []
-                                                | null tvs]
+-- Recall the definition:
+--    class class PR (PRepr a) => PA a where
+--      toPRepr      :: a -> PRepr a
+--      fromPRepr    :: PRepr a -> a
+--      toArrPRepr   :: PData a -> PData (PRepr a)
+--      fromArrPRepr :: PData (PRepr a) -> PData a
+--
+-- Example:
+--    df :: forall a. PA a -> PA (T a)
+--    df = /\a. \(d:PA a). MkPA ($PR_df a d) ($toPRepr a d) ... 
+--    $dPR_df :: forall a. PA a -> PR (PRepr (T a))
+--    $dPR_df = ....   
+--    $toRepr :: forall a. PA a -> T a -> PRepr (T a)
+--    $toPRepr = ...
+-- The "..." stuff is filled in by buildPAScAndMethods
 
-      -- Get ids for each of the methods in the dictionary.
-      method_ids <- mapM (method args') paMethods
+buildPADict vect_tc prepr_tc arr_tc repr
+ = polyAbstract tvs $ \args ->    -- The args are the dictionaries we lambda
+   		      	    	  -- abstract over; and they are put in the
+				  -- envt, so when we need a (PA a) we can 
+				  -- find it in the envt
+   do -- Get ids for each of the methods in the dictionary, including superclass
+      method_ids <- mapM (method args) buildPAScAndMethods
 
       -- Expression to build the dictionary.
       pa_dc  <- builtin paDataCon
-      let dict = mkLams (tvs ++ args')
+      let dict = mkLams (tvs ++ args)
                $ mkConApp pa_dc
                $ Type inst_ty
-               : map Var super_args ++ super_consts
-                                   -- the superclass dictionary is
-                                   -- either lambda-bound or
-                                   -- constant
-                 ++ map (method_call args') method_ids
+                 : map (method_call args) method_ids
 
       -- Build the type of the dictionary function.
       pa_cls <- builtin paClass
-      let dfun_ty	= mkForAllTys tvs
-			$ mkFunTys (map varType args')
-                                   (PredTy $ ClassP pa_cls [inst_ty])
+      let dfun_ty = mkForAllTys tvs
+		  $ mkFunTys (map varType args)
+                             (PredTy $ ClassP pa_cls [inst_ty])
 
       -- Set the unfolding for the inliner.
       raw_dfun <- newExportedVar dfun_name dfun_ty
-      let dfun_unf = mkDFunUnfolding dfun_ty
-                   $ map (const $ DFunLamArg 0) super_args
-                     ++ map DFunConstArg super_consts
-                     ++ map (DFunPolyArg . Var) method_ids
+      let dfun_unf = mkDFunUnfolding dfun_ty $
+                     map (DFunPolyArg . Var) method_ids
           dfun = raw_dfun `setIdUnfolding`  dfun_unf
                           `setInlinePragma` dfunInlinePragma
 
@@ -102,11 +101,3 @@ buildPADict vect_tc prepr_tc arr_tc repr
 
     method_call args id = mkApps (Var id) (map Type arg_tys ++ map Var args)
     method_name name    = mkVarOcc $ occNameString dfun_name ++ ('$' : name)
-
-
-paMethods :: [(String, TyCon -> TyCon -> TyCon -> SumRepr -> VM CoreExpr)]
-paMethods = [("toPRepr",      buildToPRepr),
-             ("fromPRepr",    buildFromPRepr),
-             ("toArrPRepr",   buildToArrPRepr),
-             ("fromArrPRepr", buildFromArrPRepr)]
-
diff --git a/compiler/vectorise/Vectorise/Type/PRepr.hs b/compiler/vectorise/Vectorise/Type/PRepr.hs
index c30bfed6ed..a7c0a9116e 100644
--- a/compiler/vectorise/Vectorise/Type/PRepr.hs
+++ b/compiler/vectorise/Vectorise/Type/PRepr.hs
@@ -1,10 +1,6 @@
 
 module Vectorise.Type.PRepr
-	( buildPReprTyCon
-	, buildToPRepr
-	, buildFromPRepr
-	, buildToArrPRepr
-	, buildFromArrPRepr)
+	( buildPReprTyCon, buildPAScAndMethods )
 where
 import Vectorise.Utils
 import Vectorise.Monad
@@ -48,6 +44,28 @@ buildPReprTyCon orig_tc vect_tc repr
     tyvars = tyConTyVars vect_tc
 
 
+-----------------------------------------------------
+buildPAScAndMethods :: [(String, TyCon -> TyCon -> TyCon -> SumRepr -> VM CoreExpr)]
+-- buildPAScandmethods says how to build the PR superclass and methods of PA
+--    class class PR (PRepr a) => PA a where
+--      toPRepr      :: a -> PRepr a
+--      fromPRepr    :: PRepr a -> a
+--      toArrPRepr   :: PData a -> PData (PRepr a)
+--      fromArrPRepr :: PData (PRepr a) -> PData a
+
+buildPAScAndMethods = [("PR",           buildPRDict),
+             	       ("toPRepr",      buildToPRepr),
+             	       ("fromPRepr",    buildFromPRepr),
+             	       ("toArrPRepr",   buildToArrPRepr),
+             	       ("fromArrPRepr", buildFromArrPRepr)]
+
+buildPRDict :: TyCon -> TyCon -> TyCon -> SumRepr -> VM CoreExpr
+buildPRDict vect_tc prepr_tc _ _
+  = prDictOfPReprInstTyCon inst_ty prepr_tc arg_tys
+  where
+    arg_tys = mkTyVarTys (tyConTyVars vect_tc)
+    inst_ty = mkTyConApp vect_tc arg_tys
+
 buildToPRepr :: TyCon -> TyCon -> TyCon -> SumRepr -> VM CoreExpr
 buildToPRepr vect_tc repr_tc _ repr
   = do
diff --git a/compiler/vectorise/Vectorise/Utils/PADict.hs b/compiler/vectorise/Vectorise/Utils/PADict.hs
index 9c7af44ca9..03a0e3d93d 100644
--- a/compiler/vectorise/Vectorise/Utils/PADict.hs
+++ b/compiler/vectorise/Vectorise/Utils/PADict.hs
@@ -79,18 +79,11 @@ paDictOfType ty
          dfun <- maybeCantVectoriseM "No PA dictionary for type constructor"
                                       (ppr tc <+> text "in" <+> ppr ty)
                 $ lookupTyConPA tc
-         super <- super_dict tc ty_args
          dicts <- mapM paDictOfType ty_args
-         return $ Var dfun `mkTyApps` ty_args `mkApps` super `mkApps` dicts
+         return $ Var dfun `mkTyApps` ty_args `mkApps` dicts
 
     paDictOfTyApp _ _ = failure
 
-    super_dict _ [] = return []
-    super_dict tycon ty_args
-      = do
-          pr <- prDictOfPReprInst (TyConApp tycon ty_args)
-          return [pr]
-
     failure = cantVectorise "Can't construct PA dictionary for type" (ppr ty)
 
 paMethod :: (Builtins -> Var) -> String -> Type -> VM CoreExpr
@@ -106,13 +99,6 @@ paMethod method _ ty
       dict <- paDictOfType ty
       return $ mkApps (Var fn) [Type ty, dict]
 
--- | Given a type @ty@, return the PR dictionary for @PRepr ty@.
-prDictOfPReprInst :: Type -> VM CoreExpr
-prDictOfPReprInst ty
-  = do
-      (prepr_tc, prepr_args) <- preprSynTyCon ty
-      prDictOfPReprInstTyCon ty prepr_tc prepr_args
-
 -- | Given a type @ty@, its PRepr synonym tycon and its type arguments,
 -- return the PR @PRepr ty@. Suppose we have:
 --