From e7f49f77492af621de30b69046a3f6b1f81650dc Mon Sep 17 00:00:00 2001
From: "benl@ouroborus.net" <unknown>
Date: Tue, 14 Sep 2010 06:29:03 +0000
Subject: [PATCH] Comments and formatting only

---
 compiler/vectorise/Vectorise/Type/PADict.hs |   26 +++++++++++++++++---------
 1 file changed, 17 insertions(+), 9 deletions(-)

diff --git a/compiler/vectorise/Vectorise/Type/PADict.hs b/compiler/vectorise/Vectorise/Type/PADict.hs
index d3d2213..5a6867d 100644
--- a/compiler/vectorise/Vectorise/Type/PADict.hs
+++ b/compiler/vectorise/Vectorise/Type/PADict.hs
@@ -20,8 +20,15 @@ import Var
 import Name
 
 
+-- | Build the PA dictionary 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.
+	-> TyCon	-- ^ tycon of the type used for the vectorised representation.
+	-> TyCon	-- 
+	-> SumRepr	-- ^ representation used for the type being vectorised.
+	-> VM Var	-- ^ name of the top-level dictionary function.
 
-buildPADict :: TyCon -> TyCon -> TyCon -> SumRepr -> VM Var
 buildPADict vect_tc prepr_tc arr_tc repr
   = polyAbstract tvs $ \args ->
     do
@@ -36,34 +43,35 @@ buildPADict vect_tc prepr_tc arr_tc repr
           dfun_ty = mkForAllTys tvs
                   $ mkFunTys (map varType args) (mkTyConApp pa_tc [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 = raw_dfun `setIdUnfolding`  mkDFunUnfolding dfun_ty (map Var method_ids)
                           `setInlinePragma` dfunInlinePragma
 
+      -- Add the new binding to the top-level environment.
       hoistBinding dfun dict
       return dfun
   where
-    tvs = tyConTyVars vect_tc
-    arg_tys = mkTyVarTys tvs
-    inst_ty = mkTyConApp vect_tc arg_tys
+    tvs       = tyConTyVars vect_tc
+    arg_tys   = mkTyVarTys tvs
+    inst_ty   = mkTyConApp vect_tc arg_tys
 
     dfun_name = mkPADFunOcc (getOccName vect_tc)
 
     method args (name, build)
       = localV
       $ do
-          expr <- build vect_tc prepr_tc arr_tc repr
+          expr     <- build vect_tc prepr_tc arr_tc repr
           let body = mkLams (tvs ++ args) expr
           raw_var <- newExportedVar (method_name name) (exprType body)
           let var = raw_var
-                      `setIdUnfolding` mkInlineUnfolding (Just (length args)) body
+                      `setIdUnfolding` mkInlineRule body (Just (length args))
                       `setInlinePragma` alwaysInlinePragma
           hoistBinding var body
           return var
 
     method_call args id = mkApps (Var id) (map Type arg_tys ++ map Var args)
-
-    method_name name = mkVarOcc $ occNameString dfun_name ++ ('$' : name)
+    method_name name    = mkVarOcc $ occNameString dfun_name ++ ('$' : name)
 
 
 paMethods :: [(String, TyCon -> TyCon -> TyCon -> SumRepr -> VM CoreExpr)]
-- 
1.7.10.4