X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FFieldLabel.lhs;h=b388d378d7369bf332da509028ddca859e72eaf0;hb=423d477bfecd490de1449c59325c8776f91d7aac;hp=017383303ac7798fca903f2d06bc69b311e3d6c8;hpb=dcef38bab91d45b56f7cf3ceeec96303d93728bb;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/FieldLabel.lhs b/ghc/compiler/basicTypes/FieldLabel.lhs index 0173833..b388d37 100644 --- a/ghc/compiler/basicTypes/FieldLabel.lhs +++ b/ghc/compiler/basicTypes/FieldLabel.lhs @@ -1,27 +1,46 @@ % -% (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 ( SYN_IE(Uniquable) ) +import Unique ( Uniquable(..) ) \end{code} \begin{code} data FieldLabel - = FieldLabel Name -- Also used as the Name of the field selector Id - 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 @@ -31,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}