From f03cf1b168c34d09766fda988921b8263e7e7300 Mon Sep 17 00:00:00 2001
From: Roman Leshchinskiy <rl@cse.unsw.edu.au>
Date: Tue, 7 Aug 2007 06:21:01 +0000
Subject: [PATCH] Modify PA dictionary generation to the new record-based
 scheme

---
 compiler/vectorise/VectType.hs |   16 +++++++---------
 1 file changed, 7 insertions(+), 9 deletions(-)

diff --git a/compiler/vectorise/VectType.hs b/compiler/vectorise/VectType.hs
index b2e1518..eb7ce6d 100644
--- a/compiler/vectorise/VectType.hs
+++ b/compiler/vectorise/VectType.hs
@@ -312,7 +312,9 @@ buildTyConBindings orig_tc vect_tc arr_tc dfun
                           num_dcs
                           (inits repr_tys)
                           (tails repr_tys))
-      takeHoisted
+      dict <- buildPADict shape vect_tc arr_tc dfun
+      binds <- takeHoisted
+      return $ (dfun, dict) : binds
   where
     orig_dcs = tyConDataCons orig_tc
     vect_dcs = tyConDataCons vect_tc
@@ -361,21 +363,17 @@ vectDataConWorker shape vect_tc arr_tc arr_dc (orig_dc, vect_dc, dc_num) pre (dc
                                           ++ map Var args
                                           ++ empty_post
 
-buildPADict :: PAInstance -> VM [(Var, CoreExpr)]
-buildPADict (PAInstance {
-               painstDFun      = dfun
-             , painstVectTyCon = vect_tc
-             , painstArrTyCon  = arr_tc })
-  = polyAbstract (tyConTyVars arr_tc) $ \abstract ->
+buildPADict :: Shape -> TyCon -> TyCon -> Var -> VM CoreExpr
+buildPADict shape vect_tc arr_tc dfun
+  = polyAbstract tvs $ \abstract ->
     do
-      shape <- tyConShape vect_tc
       meth_binds <- mapM (mk_method shape) paMethods
       let meth_exprs = map (Var . fst) meth_binds
 
       pa_dc <- builtin paDataCon
       let dict = mkConApp pa_dc (Type (mkTyConApp vect_tc arg_tys) : meth_exprs)
           body = Let (Rec meth_binds) dict
-      return [(dfun, mkInlineMe $ abstract body)]
+      return . mkInlineMe $ abstract body
   where
     tvs = tyConTyVars arr_tc
     arg_tys = mkTyVarTys tvs
-- 
1.7.10.4