-instance NamedThing Id where
- getExportFlag (Id _ _ _ details)
- = get details
- where
- get (DataConId _ _ _ _ _ tc)= getExportFlag tc -- NB: don't use the FullName
- get (TupleConId _) = NotExported
- get (ImportedId n) = getExportFlag n
- get (PreludeId n) = getExportFlag n
- get (TopLevId n) = getExportFlag n
- get (SuperDictSelId c _) = getExportFlag c
- get (ClassOpId c _) = getExportFlag c
- get (DefaultMethodId c _ _) = getExportFlag c
- get (DictFunId c ty from_here) = instance_export_flag c ty from_here
- get (ConstMethodId c ty _ from_here) = instance_export_flag c ty from_here
- get (SpecId unspec _ _) = getExportFlag unspec
- get (WorkerId unwrkr) = getExportFlag unwrkr
- get (InstId _) = NotExported
- get (LocalId _ _) = NotExported
- get (SysLocalId _ _) = NotExported
- get (SpecPragmaId _ _ _) = NotExported
-#ifdef DPH
- get (ProcessorCon _ _) = NotExported
- get (PodId _ _ i) = getExportFlag i
-#endif {- Data Parallel Haskell -}
-
- isLocallyDefined this_id@(Id _ _ _ details)
- = get details
- where
- get (DataConId _ _ _ _ _ tc)= isLocallyDefined tc -- NB: don't use the FullName
- get (TupleConId _) = False
- get (ImportedId _) = False
- get (PreludeId _) = False
- get (TopLevId n) = isLocallyDefined n
- get (SuperDictSelId c _) = isLocallyDefined c
- get (ClassOpId c _) = isLocallyDefined c
- get (DefaultMethodId c _ _) = isLocallyDefined c
- get (DictFunId c tyc from_here) = from_here
- -- For DictFunId and ConstMethodId things, you really have to
- -- know whether it came from an imported instance or one
- -- really here; no matter where the tycon and class came from.
-
- get (ConstMethodId c tyc _ from_here) = from_here
- get (SpecId unspec _ _) = isLocallyDefined unspec
- get (WorkerId unwrkr) = isLocallyDefined unwrkr
- get (InstId _) = True
- get (LocalId _ _) = True
- get (SysLocalId _ _) = True
- get (SpecPragmaId _ _ _) = True
-#ifdef DPH
- get (ProcessorCon _ _) = False
- get (PodId _ _ i) = isLocallyDefined i
-#endif {- Data Parallel Haskell -}
-
- getOrigName this_id@(Id u _ _ details)
- = get details
- where
- get (DataConId n _ _ _ _ _) = getOrigName n
- get (TupleConId a) = (pRELUDE_BUILTIN, SLIT("Tup") _APPEND_ _PK_ (show a))
- get (ImportedId n) = getOrigName n
- get (PreludeId n) = getOrigName n
- get (TopLevId n) = getOrigName n
-
- get (ClassOpId c op) = case (getOrigName c) of -- ToDo; better ???
- (mod, _) -> (mod, getClassOpString op)
-
- get (SpecId unspec ty_maybes _)
- = BIND getOrigName unspec _TO_ (mod, unspec_nm) ->
- BIND specMaybeTysSuffix ty_maybes _TO_ tys_suffix ->
- (mod,
- unspec_nm _APPEND_
- (if not (toplevelishId unspec)
- then showUnique u
- else tys_suffix)
- )
- BEND BEND
-
- get (WorkerId unwrkr)
- = BIND getOrigName unwrkr _TO_ (mod, unwrkr_nm) ->
- (mod,
- unwrkr_nm _APPEND_
- (if not (toplevelishId unwrkr)
- then showUnique u
- else SLIT(".wrk"))
- )
- BEND
-
- get (InstId inst)
- = (panic "NamedThing.Id.getOrigName (InstId)",
- BIND (getInstNamePieces True inst) _TO_ (piece1:pieces) ->
- BIND [ _CONS_ '.' p | p <- pieces ] _TO_ dotted_pieces ->
- _CONCAT_ (piece1 : dotted_pieces)
- BEND BEND )
-
- get (LocalId n _) = (panic "NamedThing.Id.getOrigName (LocalId)",
- getLocalName n)
- get (SysLocalId n _) = (panic "NamedThing.Id.getOrigName (SysLocal)",
- getLocalName n)
- get (SpecPragmaId n _ _)=(panic "NamedThing.Id.getOrigName (SpecPragmaId)",
- getLocalName n)
-#ifdef DPH
- get (ProcessorCon a _) = ("PreludeBuiltin",
- "MkProcessor" ++ (show a))
- get (PodId d ity id)
- = BIND (getOrigName id) _TO_ (m,n) ->
- (m,n ++ ".mapped.POD"++ show d ++ "." ++ show ity)
- BEND
- -- ToDo(hilly): should the above be using getIdNamePieces???
-#endif {- Data Parallel Haskell -}
-
- get other_details
- -- the remaining internally-generated flavours of
- -- Ids really do not have meaningful "original name" stuff,
- -- but we need to make up something (usually for debugging output)
-
- = BIND (getIdNamePieces True this_id) _TO_ (piece1:pieces) ->
- BIND [ _CONS_ '.' p | p <- pieces ] _TO_ dotted_pieces ->
- (_NIL_, _CONCAT_ (piece1 : dotted_pieces))
- BEND BEND
-
- getOccurrenceName this_id@(Id _ _ _ details)
- = get details
- where
- get (DataConId n _ _ _ _ _) = getOccurrenceName n
- get (TupleConId a) = SLIT("Tup") _APPEND_ (_PK_ (show a))
- get (ImportedId n) = getOccurrenceName n
- get (PreludeId n) = getOccurrenceName n
- get (TopLevId n) = getOccurrenceName n
- get (ClassOpId _ op) = getClassOpString op
-#ifdef DPH
- get (ProcessorCon a _) = "MkProcessor" ++ (show a)
- get (PodId _ _ id) = getOccurrenceName id
-#endif {- Data Parallel Haskell -}
- get _ = snd (getOrigName this_id)
-
- getInformingModules id = panic "getInformingModule:Id"
-
- getSrcLoc (Id _ _ id_info details)
- = get details
- where
- get (DataConId n _ _ _ _ _) = getSrcLoc n
- get (TupleConId _) = mkBuiltinSrcLoc
- get (ImportedId n) = getSrcLoc n
- get (PreludeId n) = getSrcLoc n
- get (TopLevId n) = getSrcLoc n
- get (SuperDictSelId c _)= getSrcLoc c
- get (ClassOpId c _) = getSrcLoc c
- get (SpecId unspec _ _) = getSrcLoc unspec
- get (WorkerId unwrkr) = getSrcLoc unwrkr
- get (InstId i) = let (loc,_) = getInstOrigin i
- in loc
- get (LocalId n _) = getSrcLoc n
- get (SysLocalId n _) = getSrcLoc n
- get (SpecPragmaId n _ _)= getSrcLoc n
-#ifdef DPH
- get (ProcessorCon _ _) = mkBuiltinSrcLoc
- get (PodId _ _ n) = getSrcLoc n
-#endif {- Data Parallel Haskell -}
- -- well, try the IdInfo
- get something_else = getSrcLocIdInfo id_info
-
- getTheUnique (Id u _ _ _) = u
-
- fromPreludeCore (Id _ _ _ details)
- = get details
- where
- get (DataConId _ _ _ _ _ tc)= fromPreludeCore tc -- NB: not from the FullName
- get (TupleConId _) = True
- get (ImportedId n) = fromPreludeCore n
- get (PreludeId n) = fromPreludeCore n
- get (TopLevId n) = fromPreludeCore n
- get (SuperDictSelId c _) = fromPreludeCore c
- get (ClassOpId c _) = fromPreludeCore c
- get (DefaultMethodId c _ _) = fromPreludeCore c
- get (DictFunId c t _) = fromPreludeCore c && is_prelude_core_ty t
- get (ConstMethodId c t _ _) = fromPreludeCore c && is_prelude_core_ty t
- get (SpecId unspec _ _) = fromPreludeCore unspec
- get (WorkerId unwrkr) = fromPreludeCore unwrkr
- get (InstId _) = False
- get (LocalId _ _) = False
- get (SysLocalId _ _) = False
- get (SpecPragmaId _ _ _) = False
-#ifdef DPH
- get (ProcessorCon _ _) = True
- get (PodId _ _ id) = fromPreludeCore id
-#endif {- Data Parallel Haskell -}
-
- hasType id = True
- getType id = getIdUniType id