X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FFieldLabel.lhs;h=50a668736fa548c556360dda65fce030516cf20b;hb=6eca2acf184d4911123193757bdd38e53caa3467;hp=d8f61d33933b6e6eb95147f37f73e9627200d214;hpb=f9120c200bcf613b58d742802172fb4c08171f0d;p=ghc-hetmet.git

diff --git a/ghc/compiler/basicTypes/FieldLabel.lhs b/ghc/compiler/basicTypes/FieldLabel.lhs
index d8f61d3..50a6687 100644
--- a/ghc/compiler/basicTypes/FieldLabel.lhs
+++ b/ghc/compiler/basicTypes/FieldLabel.lhs
@@ -1,24 +1,47 @@
 %
-% (c) The AQUA Project, Glasgow University, 1996
+% (c) The AQUA Project, Glasgow University, 1996-1998
 %
 \section[FieldLabel]{The @FieldLabel@ type}
 
 \begin{code}
-#include "HsVersions.h"
+module FieldLabel(
+	FieldLabel,	-- Abstract
+
+	mkFieldLabel, 
+	fieldLabelName,	fieldLabelTyCon, fieldLabelType, fieldLabelTag,
 
-module FieldLabel where
+	FieldLabelTag,
+	firstFieldLabelTag, allFieldLabelTags
+  ) where
+
+#include "HsVersions.h"
 
-import Ubiq{-uitous-}
+import {-# SOURCE #-}	TypeRep( Type )	-- FieldLabel is compiled very early
+import {-# SOURCE #-}	TyCon( TyCon )	-- FieldLabel is compiled very early
 
-import Name		( Name{-instance Eq/Outputable-} )
-import Type		( Type(..) )
+import Name		( Name{-instance Eq/Outputable-}, NamedThing(..), nameUnique )
+import Outputable
+import Unique           ( Uniquable(..) )
 \end{code}
 
 \begin{code}
 data FieldLabel
-  = FieldLabel	Name
-		Type
-		FieldLabelTag
+  = FieldLabel	Name	        -- Also used as the Name of the field selector Id
+
+		TyCon		-- Parent type constructor
+
+		Type		-- Type of the field; may have free type variables that
+				-- are the tyvars of its parent *data* constructor, and
+				-- those will be the same as the tyvars of its parent *type* constructor
+				-- e.g.  data T a = MkT { op1 :: a -> a, op2 :: a -> Int }
+				-- The type in the FieldLabel for op1 will be simply (a->a).
+
+		FieldLabelTag	-- Indicates position within constructor
+				-- (starting with firstFieldLabelTag)
+				--
+				-- If the same field occurs in more than one constructor
+				-- then it'll have a separate FieldLabel on each occasion,
+				-- but with a single name (and presumably the same type!)
 
 type FieldLabelTag = Int
 
@@ -28,18 +51,22 @@ firstFieldLabelTag :: FieldLabelTag
 firstFieldLabelTag = 1
 
 allFieldLabelTags :: [FieldLabelTag]
-allFieldLabelTags = [1..]
+allFieldLabelTags = [firstFieldLabelTag..]
 
-fieldLabelName (FieldLabel n _  _)   = n
-fieldLabelType (FieldLabel _ ty _)   = ty
-fieldLabelTag  (FieldLabel _ _  tag) = tag
+fieldLabelName  (FieldLabel n _ _  _)   = n
+fieldLabelTyCon (FieldLabel _ tc _ _)   = tc
+fieldLabelType  (FieldLabel _ _ ty _)   = ty
+fieldLabelTag   (FieldLabel _ _ _  tag) = tag
 
 instance Eq FieldLabel where
-    (FieldLabel n1 _ _) == (FieldLabel n2 _ _) = n1 == n2
+    fl1 == fl2 = fieldLabelName fl1 == fieldLabelName fl2
 
 instance Outputable FieldLabel where
-    ppr sty (FieldLabel n _ _) = ppr sty n
+    ppr fl = ppr (fieldLabelName fl)
 
 instance NamedThing FieldLabel where
-    getName (FieldLabel n _ _) = n
+    getName = fieldLabelName
+
+instance Uniquable FieldLabel where
+    getUnique fl = nameUnique (fieldLabelName fl)
 \end{code}