[project @ 2001-05-25 16:14:02 by dsyme]

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

diff --git a/ghc/compiler/basicTypes/Id.lhs b/ghc/compiler/basicTypes/Id.lhs
index c59fefe..ee5ddf6 100644 (file)
--- a/ghc/compiler/basicTypes/Id.lhs
+++ b/ghc/compiler/basicTypes/Id.lhs
@@ -28,6 +28,7 @@ module Id (
        isSpecPragmaId, isExportedId, isLocalId, isGlobalId,
        isRecordSelector,
        isPrimOpId, isPrimOpId_maybe, 
+       isFCallId, isFCallId_maybe,
        isDataConId, isDataConId_maybe, 
        isDataConWrapId, isDataConWrapId_maybe,
        isBottomingId,
@@ -98,8 +99,7 @@ import TysPrim                ( statePrimTyCon )
 import FieldLabel      ( FieldLabel )
 import SrcLoc          ( SrcLoc )
 import Outputable
-import Unique          ( Unique, mkBuiltinUnique, getBuiltinUniques, 
-                         getNumBuiltinUniques )
+import Unique          ( Unique, mkBuiltinUnique )
 
 infixl         1 `setIdUnfolding`,
          `setIdArityInfo`,
@@ -173,15 +173,11 @@ mkWorkerId uniq unwrkr ty
 
 -- "Template locals" typically used in unfoldings
 mkTemplateLocals :: [Type] -> [Id]
-mkTemplateLocals tys = zipWith (mkSysLocal SLIT("tpl"))
-                              (getBuiltinUniques (length tys))
-                              tys
+mkTemplateLocals tys = zipWith mkTemplateLocal [1..] tys
 
 mkTemplateLocalsNum :: Int -> [Type] -> [Id]
 -- The Int gives the starting point for unique allocation
-mkTemplateLocalsNum n tys = zipWith (mkSysLocal SLIT("tpl"))
-                                   (getNumBuiltinUniques n (length tys))
-                                   tys
+mkTemplateLocalsNum n tys = zipWith mkTemplateLocal [n..] tys
 
 mkTemplateLocal :: Int -> Type -> Id
 mkTemplateLocal i ty = mkSysLocal SLIT("tpl") (mkBuiltinUnique i) ty
@@ -238,6 +234,14 @@ isPrimOpId_maybe id = case globalIdDetails id of
                            PrimOpId op -> Just op
                            other       -> Nothing
 
+isFCallId id = case globalIdDetails id of
+                   FCallId call -> True
+                   other        -> False
+
+isFCallId_maybe id = case globalIdDetails id of
+                           FCallId call -> Just call
+                           other        -> Nothing
+
 isDataConId id = case globalIdDetails id of
                        DataConId _ -> True
                        other       -> False
@@ -260,6 +264,7 @@ isDataConWrapId id = case globalIdDetails id of
 hasNoBinding id = case globalIdDetails id of
                        DataConId _ -> True
                        PrimOpId _  -> True
+                       FCallId _   -> True
                        other       -> False
 
 isImplicitId :: Id -> Bool
@@ -269,6 +274,7 @@ isImplicitId :: Id -> Bool
 isImplicitId id
   = case globalIdDetails id of
        RecordSelId _   -> True -- Includes dictionary selectors
+        FCallId _       -> True
         PrimOpId _      -> True
         DataConId _     -> True
        DataConWrapId _ -> True