remove empty dir

[ghc-hetmet.git] / ghc / compiler / basicTypes / FieldLabel.lhs

diff --git a/ghc/compiler/basicTypes/FieldLabel.lhs b/ghc/compiler/basicTypes/FieldLabel.lhs
index a0a85dd..b388d37 100644 (file)
--- a/ghc/compiler/basicTypes/FieldLabel.lhs
+++ b/ghc/compiler/basicTypes/FieldLabel.lhs
@@ -4,12 +4,20 @@
 \section[FieldLabel]{The @FieldLabel@ type}
 
 \begin{code}
-module FieldLabel where
+module FieldLabel(
+       FieldLabel,     -- Abstract
 
-#include "HsVersions.h"
+       mkFieldLabel, 
+       fieldLabelName, fieldLabelTyCon, fieldLabelType, fieldLabelTag,
+
+       FieldLabelTag,
+       firstFieldLabelTag, allFieldLabelTags
+  ) where
 
-import {-# SOURCE #-}  TypeRep( Type ) -- FieldLabel is compiled very early
+#include "HsVersions.h"
 
+import Type( Type )
+import TyCon( TyCon )
 import Name            ( Name{-instance Eq/Outputable-}, NamedThing(..), nameUnique )
 import Outputable
 import Unique           ( Uniquable(..) )
@@ -18,8 +26,12 @@ import Unique           ( Uniquable(..) )
 \begin{code}
 data FieldLabel
   = 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 tyvar of the constructor
+                               -- 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).
 
@@ -40,19 +52,20 @@ firstFieldLabelTag = 1
 allFieldLabelTags :: [FieldLabelTag]
 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 (FieldLabel n _ _) = ppr n
+    ppr fl = ppr (fieldLabelName fl)
 
 instance NamedThing FieldLabel where
-    getName (FieldLabel n _ _) = n
+    getName = fieldLabelName
 
 instance Uniquable FieldLabel where
-    getUnique (FieldLabel n _ _) = nameUnique n
+    getUnique fl = nameUnique (fieldLabelName fl)
 \end{code}