X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FFieldLabel.lhs;h=b388d378d7369bf332da509028ddca859e72eaf0;hb=28a464a75e14cece5db40f2765a29348273ff2d2;hp=47725c49a0e59be742fa3f382f4b56a8a5342dc8;hpb=2773693e5f92c285ef17aa8720d89ce8689add6e;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/FieldLabel.lhs b/ghc/compiler/basicTypes/FieldLabel.lhs index 47725c4..b388d37 100644 --- a/ghc/compiler/basicTypes/FieldLabel.lhs +++ b/ghc/compiler/basicTypes/FieldLabel.lhs @@ -1,31 +1,43 @@ % -% (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 -module FieldLabel where + mkFieldLabel, + fieldLabelName, fieldLabelTyCon, fieldLabelType, fieldLabelTag, -IMP_Ubiq(){-uitous-} + FieldLabelTag, + firstFieldLabelTag, allFieldLabelTags + ) where -import Name --( Name{-instance Eq/Outputable-}, nameUnique ) -import Type ( SYN_IE(Type) ) +#include "HsVersions.h" +import Type( Type ) +import TyCon( TyCon ) +import Name ( Name{-instance Eq/Outputable-}, NamedThing(..), nameUnique ) import Outputable -import UniqFM ( Uniquable(..) ) +import Unique ( Uniquable(..) ) \end{code} \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). 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!) @@ -38,21 +50,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 - uniqueOf (FieldLabel n _ _) = nameUnique n + getUnique fl = nameUnique (fieldLabelName fl) \end{code}