Fix recursive superclasses (again). Fixes Trac #4809.

[ghc-hetmet.git] / compiler / vectorise / Vectorise / Type / PADict.hs

diff --git a/compiler/vectorise/Vectorise/Type/PADict.hs b/compiler/vectorise/Vectorise/Type/PADict.hs
index 8b6ad92..ed6264a 100644 (file)
--- a/compiler/vectorise/Vectorise/Type/PADict.hs
+++ b/compiler/vectorise/Vectorise/Type/PADict.hs
@@ -19,7 +19,6 @@ import TypeRep
 import Id
 import Var
 import Name
-import Class
 import Outputable
 
 -- debug               = False
@@ -53,25 +52,16 @@ buildPADict vect_tc prepr_tc arr_tc repr
                $ Type inst_ty : map (method_call args) method_ids
 
       -- Build the type of the dictionary function.
-      pa_tc          <- builtin paTyCon
-      let pa_opitems = [(id, NoDefMeth) | id <- method_ids]
-      let pa_cls     = mkClass 
-                       (tyConName pa_tc)
-                       tvs             -- tyvars of class
-                       []              -- fundeps
-                       []              -- superclass predicates
-                       0               -- number of equalities
-                       []              -- superclass dict selectors
-                       []              -- associated type families
-                       pa_opitems      -- class op items
-                       pa_tc           -- dictionary type constructor
-                       
-      let dfun_ty = mkForAllTys tvs
-                  $ mkFunTys (map varType args) (PredTy $ ClassP pa_cls [inst_ty])
+      pa_tc            <- builtin paTyCon
+      let Just pa_cls  = tyConClass_maybe pa_tc
+
+      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 = raw_dfun `setIdUnfolding`  mkDFunUnfolding dfun_ty (map Var method_ids)
+      let dfun_unf = mkDFunUnfolding dfun_ty (map (DFunPolyArg . Var) method_ids)
+          dfun = raw_dfun `setIdUnfolding`  dfun_unf
                           `setInlinePragma` dfunInlinePragma
 
       -- Add the new binding to the top-level environment.