X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fprelude%2FStdIdInfo.lhs;h=75d803befeca101a657e73c1d0b9347c5919c820;hb=d3e697b8d842bd43329d470f2bc424a6dcb88d89;hp=f9fe24846076c24351858c5ad1b4c77f5af35b1a;hpb=23af01cd04e40c12f39763f676e9c0396ac8d86a;p=ghc-hetmet.git

diff --git a/ghc/compiler/prelude/StdIdInfo.lhs b/ghc/compiler/prelude/StdIdInfo.lhs
index f9fe248..75d803b 100644
--- a/ghc/compiler/prelude/StdIdInfo.lhs
+++ b/ghc/compiler/prelude/StdIdInfo.lhs
@@ -24,18 +24,18 @@ import CoreSyn
 import Literal
 import CoreUnfold	( mkUnfolding, PragmaInfo(..) )
 import TysWiredIn	( tupleCon )
-import Id		( GenId, mkTemplateLocals, idType,
+import Id		( mkTemplateLocals, idType,
 			  dataConStrictMarks, dataConFieldLabels, dataConArgTys,
 			  recordSelectorFieldLabel, dataConSig,
 			  StrictnessMark(..),
-			  isAlgCon, isMethodSelId_maybe, isSuperDictSelId_maybe,
+			  isAlgCon, isDictSelId_maybe,
 			  isRecordSelector, isPrimitiveId_maybe, 
 			  addIdUnfolding, addIdArity,
 			  Id
 			)
 import IdInfo		( ArityInfo, exactArity )
 import Class		( classBigSig, classTyCon )
-import TyCon		( isNewTyCon, tyConDataCons )
+import TyCon		( isNewTyCon, tyConDataCons, isDataTyCon )
 import FieldLabel	( FieldLabel )
 import PrelVals		( pAT_ERROR_ID )
 import Maybes
@@ -179,20 +179,35 @@ addStandardIdInfo sel_id
 %*									*
 %************************************************************************
 
+Selecting a field for a dictionary.  If there is just one field, then
+there's nothing to do.
+
 \begin{code}
 addStandardIdInfo sel_id
-  | maybeToBool maybe_sc_sel_id
-  = sel_id `addIdUnfolding` (mk_selector_unfolding cls sel_id)
+  | maybeToBool maybe_dict_sel_id
+  = sel_id `addIdUnfolding` unfolding
   where
-    maybe_sc_sel_id    = isSuperDictSelId_maybe sel_id
-    Just (cls, _) = maybe_sc_sel_id
+    maybe_dict_sel_id = isDictSelId_maybe sel_id
+    Just clas 	    = maybe_dict_sel_id
 
-addStandardIdInfo sel_id
-  | maybeToBool maybe_meth_sel_id
-  = sel_id `addIdUnfolding` (mk_selector_unfolding cls sel_id)
-  where
-    maybe_meth_sel_id  = isMethodSelId_maybe sel_id
-    Just cls = maybe_meth_sel_id
+    unfolding = mkUnfolding IWantToBeINLINEd {- Always inline selectors -} rhs
+	-- The always-inline thing means we don't need any other IdInfo
+
+    (tyvars, _, sc_sel_ids, op_sel_ids, defms) = classBigSig clas
+
+    tycon      = classTyCon clas
+    [data_con] = tyConDataCons tycon
+    tyvar_tys  = mkTyVarTys tyvars
+    arg_tys    = dataConArgTys data_con tyvar_tys
+    the_arg_id = assoc "StdIdInfo:mk_sel" ((sc_sel_ids ++ op_sel_ids) `zip` arg_ids) sel_id
+
+    (dict_id:arg_ids) = mkTemplateLocals (mkDictTy clas tyvar_tys : arg_tys)
+
+    rhs | isNewTyCon tycon = mkLam tyvars [dict_id] $
+			     Coerce (CoerceOut data_con) (head arg_tys) (Var dict_id)
+	| otherwise	   = mkLam tyvars [dict_id] $
+			     Case (Var dict_id) $
+			     AlgAlts [(data_con, arg_ids, Var the_arg_id)] NoDefault
 \end{code}
 
 
@@ -235,34 +250,3 @@ addStandardIdInfo id
   = pprTrace "addStandardIdInfo missing:" (ppr id) id
 \end{code}
 
-
-%************************************************************************
-%*									*
-\subsection{Dictionary selector help function
-%*									*
-%************************************************************************
-
-Selecting a field for a dictionary.  If there is just one field, then
-there's nothing to do.
-
-\begin{code}
-mk_selector_unfolding clas sel_id
-  = mkUnfolding IWantToBeINLINEd {- Always inline selectors -} rhs
-	-- The always-inline thing means we don't need any other IdInfo
-  where
-    (tyvars, _, sc_sel_ids, op_sel_ids, defms) = classBigSig clas
-
-    tycon      = classTyCon clas
-    [data_con] = tyConDataCons tycon
-    tyvar_tys  = mkTyVarTys tyvars
-    arg_tys    = dataConArgTys data_con tyvar_tys
-    the_arg_id = assoc "StdIdInfo:mk_sel" ((sc_sel_ids ++ op_sel_ids) `zip` arg_ids) sel_id
-
-    (dict_id:arg_ids) = mkTemplateLocals (mkDictTy clas tyvar_tys : arg_tys)
-
-    rhs | isNewTyCon tycon = mkLam tyvars [dict_id] $
-			     Coerce (CoerceOut data_con) (head arg_tys) (Var dict_id)
-	| otherwise	   = mkLam tyvars [dict_id] $
-			     Case (Var dict_id) $
-			     AlgAlts [(data_con, arg_ids, Var the_arg_id)] NoDefault
-\end{code}