X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FId.lhs;h=f53e85d906694310710efa2b8f031dfc14222276;hb=51a571c0f5b0201ea53bec60fcaafb78c01c017e;hp=61c2086052f8113ebcf70e7833068b8cf23eb0f1;hpb=18976e614fd90a8d81ced2c3e9cd8e38d72a1f40;p=ghc-hetmet.git

diff --git a/ghc/compiler/basicTypes/Id.lhs b/ghc/compiler/basicTypes/Id.lhs
index 61c2086..f53e85d 100644
--- a/ghc/compiler/basicTypes/Id.lhs
+++ b/ghc/compiler/basicTypes/Id.lhs
@@ -8,85 +8,108 @@ module Id (
 	Id, DictId,
 
 	-- Simple construction
-	mkVanillaId, mkImportedId, mkSysLocal, mkUserLocal,
-	mkTemplateLocals, mkWildId, mkUserId,
+	mkGlobalId, mkLocalId, mkSpecPragmaId, mkLocalIdWithInfo,
+	mkSysLocal, mkUserLocal, mkVanillaGlobal,
+	mkTemplateLocals, mkTemplateLocalsNum, mkWildId, mkTemplateLocal,
+	mkWorkerId,
 
 	-- Taking an Id apart
-	idName, idType, idUnique, idInfo, idDetails,
-	idPrimRep, isId,
+	idName, idType, idUnique, idInfo,
+	idPrimRep, isId, globalIdDetails,
 	recordSelectorFieldLabel,
 
 	-- Modifying an Id
-	setIdName, setIdUnique, setIdType, setIdInfo,
+	setIdName, setIdUnique, setIdType, setIdNoDiscard, setGlobalIdDetails,
+	setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,
+	zapLamIdInfo, zapDemandIdInfo, 
 
 	-- Predicates
-	omitIfaceSigForId,
-	externallyVisibleId,
-	idFreeTyVars, 
+	isImplicitId, isDeadBinder,
+	isSpecPragmaId,	isExportedId, isLocalId, isGlobalId,
+	isRecordSelector,
+	isPrimOpId, isPrimOpId_maybe, 
+	isDataConId, isDataConId_maybe, 
+	isDataConWrapId, isDataConWrapId_maybe,
+	isBottomingId,
+	hasNoBinding,
 
 	-- Inline pragma stuff
-	getInlinePragma, setInlinePragma, modifyInlinePragma, 
-	idWantsToBeINLINEd, idMustBeINLINEd, idMustNotBeINLINEd,
-	isSpecPragmaId,
-	
+	idInlinePragma, setInlinePragma, modifyInlinePragma, 
 
-	isRecordSelector,
-	isPrimitiveId_maybe, isDataConId_maybe,
-	isConstantId,
-	isBottomingId, idAppIsBottom,
+
+	-- One shot lambda stuff
+	isOneShotLambda, setOneShotLambda, clearOneShotLambda,
 
 	-- IdInfo stuff
 	setIdUnfolding,
-	setIdArity,
+	setIdArityInfo,
 	setIdDemandInfo,
 	setIdStrictness,
+        setIdTyGenInfo,
+	setIdWorkerInfo,
 	setIdSpecialisation,
-	setIdUpdateInfo,
 	setIdCafInfo,
-
-	getIdArity,
-	getIdDemandInfo,
-	getIdStrictness,
-	getIdUnfolding,
-	getIdSpecialisation,
-	getIdUpdateInfo,
-	getIdCafInfo
+	setIdCprInfo,
+	setIdOccInfo,
+
+	idArity, idArityInfo, 
+	idDemandInfo,
+	idStrictness,
+        idTyGenInfo,
+	idWorkerInfo,
+	idUnfolding,
+	idSpecialisation,
+	idCafInfo,
+	idCprInfo,
+	idLBVarInfo,
+	idOccInfo,
 
     ) where
 
 #include "HsVersions.h"
 
-import {-# SOURCE #-} CoreUnfold ( Unfolding )
 
-import Var		( Id, DictId, VarDetails(..), 
-			  isId, mkId, 
-			  idName, idType, idUnique, idInfo, idDetails,
-			  setIdName, setVarType, setIdUnique, setIdInfo, modifyIdInfo,
-			  externallyVisibleId
+import CoreSyn		( Unfolding, CoreRules )
+import BasicTypes	( Arity )
+import Var		( Id, DictId,
+			  isId, isExportedId, isSpecPragmaId, isLocalId,
+			  idName, idType, idUnique, idInfo, isGlobalId,
+			  setIdName, setVarType, setIdUnique, setIdNoDiscard,
+			  setIdInfo, lazySetIdInfo, modifyIdInfo, 
+			  maybeModifyIdInfo,
+			  globalIdDetails, setGlobalIdDetails
 			)
-import VarSet
-import Type		( Type, tyVarsOfType, typePrimRep, addFreeTyVars )
-import IdInfo
+import qualified Var	( mkLocalId, mkGlobalId, mkSpecPragmaId )
+import Type		( Type, typePrimRep, addFreeTyVars, 
+                          usOnce, seqType, splitTyConApp_maybe )
+
+import IdInfo 
+
 import Demand		( Demand )
-import Name	 	( Name, OccName, Module,
+import Name	 	( Name, OccName,
 			  mkSysLocalName, mkLocalName,
-			  isWiredInName
+			  getOccName, getSrcLoc
 			) 
-import Const		( Con(..) )
+import OccName		( UserFS, mkWorkerOcc )
 import PrimRep		( PrimRep )
-import PrimOp		( PrimOp )
-import FieldLabel	( FieldLabel(..) )
+import TysPrim		( statePrimTyCon )
+import FieldLabel	( FieldLabel )
 import SrcLoc		( SrcLoc )
-import Unique		( Unique, mkBuiltinUnique, getBuiltinUniques )
+import Unique		( Unique, mkBuiltinUnique, getBuiltinUniques, 
+			  getNumBuiltinUniques )
 import Outputable
 
 infixl 	1 `setIdUnfolding`,
-	  `setIdArity`,
+	  `setIdArityInfo`,
 	  `setIdDemandInfo`,
 	  `setIdStrictness`,
+	  `setIdTyGenInfo`,
+	  `setIdWorkerInfo`,
 	  `setIdSpecialisation`,
-	  `setIdUpdateInfo`,
-	  `setInlinePragma`
+	  `setInlinePragma`,
+	  `idCafInfo`,
+	  `idCprInfo`
+
 	-- infixl so you can say (id `set` a `set` b)
 \end{code}
 
@@ -98,39 +121,68 @@ infixl 	1 `setIdUnfolding`,
 %*									*
 %************************************************************************
 
+Absolutely all Ids are made by mkId.  It is just like Var.mkId,
+but in addition it pins free-tyvar-info onto the Id's type, 
+where it can easily be found.
+
 \begin{code}
-mkVanillaId :: Name -> Type -> Id
-mkVanillaId name ty = mkId name (addFreeTyVars ty) VanillaId noIdInfo
+mkLocalIdWithInfo :: Name -> Type -> IdInfo -> Id
+mkLocalIdWithInfo name ty info = Var.mkLocalId name (addFreeTyVars ty) info
+
+mkSpecPragmaId :: OccName -> Unique -> Type -> SrcLoc -> Id
+mkSpecPragmaId occ uniq ty loc = Var.mkSpecPragmaId (mkLocalName uniq occ loc)
+						    (addFreeTyVars ty)
+						    noCafIdInfo
 
-mkImportedId :: Name -> Type -> IdInfo -> Id
-mkImportedId name ty info = mkId name (addFreeTyVars ty) VanillaId info
+mkGlobalId :: GlobalIdDetails -> Name -> Type -> IdInfo -> Id
+mkGlobalId details name ty info = Var.mkGlobalId details name (addFreeTyVars ty) info
+\end{code}
 
-mkUserId :: Name -> Type -> Id
-mkUserId name ty = mkVanillaId name ty
+\begin{code}
+mkLocalId :: Name -> Type -> Id
+mkLocalId name ty = mkLocalIdWithInfo name ty noCafIdInfo
 
 -- SysLocal: for an Id being created by the compiler out of thin air...
 -- UserLocal: an Id with a name the user might recognize...
-mkUserLocal :: OccName     -> Unique -> Type -> SrcLoc -> Id
-mkSysLocal  :: FAST_STRING -> Unique -> Type -> Id
+mkUserLocal :: OccName -> Unique -> Type -> SrcLoc -> Id
+mkSysLocal  :: UserFS  -> Unique -> Type -> Id
+mkVanillaGlobal :: Name -> Type -> IdInfo -> Id
 
-mkSysLocal  fs uniq ty      = mkVanillaId (mkSysLocalName uniq fs)      ty
-mkUserLocal occ uniq ty loc = mkVanillaId (mkLocalName    uniq occ loc) ty
+mkSysLocal  fs uniq ty      = mkLocalId (mkSysLocalName uniq fs)      ty
+mkUserLocal occ uniq ty loc = mkLocalId (mkLocalName    uniq occ loc) ty
+mkVanillaGlobal 	    = mkGlobalId VanillaGlobal
 \end{code}
 
 Make some local @Ids@ for a template @CoreExpr@.  These have bogus
 @Uniques@, but that's OK because the templates are supposed to be
 instantiated before use.
-
+ 
 \begin{code}
 -- "Wild Id" typically used when you need a binder that you don't expect to use
 mkWildId :: Type -> Id
 mkWildId ty = mkSysLocal SLIT("wild") (mkBuiltinUnique 1) ty
 
+mkWorkerId :: Unique -> Id -> Type -> Id
+-- A worker gets a local name.  CoreTidy will globalise it if necessary.
+mkWorkerId uniq unwrkr ty
+  = mkLocalId wkr_name ty
+  where
+    wkr_name = mkLocalName uniq (mkWorkerOcc (getOccName unwrkr)) (getSrcLoc unwrkr)
+
 -- "Template locals" typically used in unfoldings
 mkTemplateLocals :: [Type] -> [Id]
 mkTemplateLocals tys = zipWith (mkSysLocal SLIT("tpl"))
 			       (getBuiltinUniques (length tys))
 			       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
+
+mkTemplateLocal :: Int -> Type -> Id
+mkTemplateLocal i ty = mkSysLocal SLIT("tpl") (mkBuiltinUnique i) ty
 \end{code}
 
 
@@ -141,38 +193,14 @@ mkTemplateLocals tys = zipWith (mkSysLocal SLIT("tpl"))
 %************************************************************************
 
 \begin{code}
-idFreeTyVars :: Id -> TyVarSet
-idFreeTyVars id = tyVarsOfType (idType id)
-
 setIdType :: Id -> Type -> Id
 	-- Add free tyvar info to the type
-setIdType id ty = setVarType id (addFreeTyVars ty)
+setIdType id ty = seqType ty `seq` setVarType id (addFreeTyVars ty)
 
 idPrimRep :: Id -> PrimRep
 idPrimRep id = typePrimRep (idType id)
 \end{code}
 
-omitIfaceSigForId tells whether an Id's info is implied by other declarations,
-so we don't need to put its signature in an interface file, even if it's mentioned
-in some other interface unfolding.
-
-\begin{code}
-omitIfaceSigForId :: Id -> Bool
-omitIfaceSigForId id
-  | isWiredInName (idName id)
-  = True
-
-  | otherwise
-  = case idDetails id of
-	RecordSelId _  -> True	-- Includes dictionary selectors
-        ConstantId _   -> True
-		-- ConstantIds are implied by their type or class decl;
-		-- remember that all type and class decls appear in the interface file.
-		-- The dfun id must *not* be omitted, because it carries version info for
-		-- the instance decl
-
-	other	       -> False	-- Don't omit!
-\end{code}
 
 %************************************************************************
 %*									*
@@ -180,26 +208,79 @@ omitIfaceSigForId id
 %*									*
 %************************************************************************
 
+The @SpecPragmaId@ exists only to make Ids that are
+on the *LHS* of bindings created by SPECIALISE pragmas; 
+eg:		s = f Int d
+The SpecPragmaId is never itself mentioned; it
+exists solely so that the specialiser will find
+the call to f, and make specialised version of it.
+The SpecPragmaId binding is discarded by the specialiser
+when it gathers up overloaded calls.
+Meanwhile, it is not discarded as dead code.
+
+
 \begin{code}
 recordSelectorFieldLabel :: Id -> FieldLabel
-recordSelectorFieldLabel id = case idDetails id of
-				RecordSelId lbl -> lbl
+recordSelectorFieldLabel id = case globalIdDetails id of
+				 RecordSelId lbl -> lbl
 
-isRecordSelector id = case idDetails id of
+isRecordSelector id = case globalIdDetails id of
 			RecordSelId lbl -> True
 			other	  	-> False
 
-isPrimitiveId_maybe id = case idDetails id of
-			    ConstantId (PrimOp op) -> Just op
-			    other		   -> Nothing
-
-isDataConId_maybe id = case idDetails id of
-			  ConstantId (DataCon con) -> Just con
-			  other		           -> Nothing
+isPrimOpId id = case globalIdDetails id of
+		    PrimOpId op -> True
+		    other	-> False
+
+isPrimOpId_maybe id = case globalIdDetails id of
+			    PrimOpId op -> Just op
+			    other	-> Nothing
+
+isDataConId id = case globalIdDetails id of
+			DataConId _ -> True
+			other	    -> False
+
+isDataConId_maybe id = case globalIdDetails id of
+			  DataConId con -> Just con
+			  other	        -> Nothing
+
+isDataConWrapId_maybe id = case globalIdDetails id of
+				  DataConWrapId con -> Just con
+				  other	            -> Nothing
+
+isDataConWrapId id = case globalIdDetails id of
+			DataConWrapId con -> True
+			other	          -> False
+
+	-- hasNoBinding returns True of an Id which may not have a
+	-- binding, even though it is defined in this module.  Notably,
+	-- the constructors of a dictionary are in this situation.
+hasNoBinding id = case globalIdDetails id of
+			DataConId _ -> True
+			PrimOpId _  -> True
+			other	    -> False
+
+isImplicitId :: Id -> Bool
+	-- isImplicitId tells whether an Id's info is implied by other
+	-- declarations, so we don't need to put its signature in an interface
+	-- file, even if it's mentioned in some other interface unfolding.
+isImplicitId id
+  = case globalIdDetails id of
+	RecordSelId _   -> True	-- Includes dictionary selectors
+        PrimOpId _      -> True
+        DataConId _     -> True
+	DataConWrapId _ -> True
+		-- These are are implied by their type or class decl;
+		-- remember that all type and class decls appear in the interface file.
+		-- The dfun id must *not* be omitted, because it carries version info for
+		-- the instance decl
+	other		-> False
+\end{code}
 
-isConstantId id = case idDetails id of
-		    ConstantId _ -> True
-		    other	 -> False
+\begin{code}
+isDeadBinder :: Id -> Bool
+isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)
+		  | otherwise = False	-- TyVars count as not dead
 \end{code}
 
 
@@ -212,66 +293,90 @@ isConstantId id = case idDetails id of
 \begin{code}
 	---------------------------------
 	-- ARITY
-getIdArity :: Id -> ArityInfo
-getIdArity id = arityInfo (idInfo id)
+idArityInfo :: Id -> ArityInfo
+idArityInfo id = arityInfo (idInfo id)
+
+idArity :: Id -> Arity
+idArity id = arityLowerBound (idArityInfo id)
 
-setIdArity :: Id -> ArityInfo -> Id
-setIdArity id arity = modifyIdInfo id (arity `setArityInfo`)
+setIdArityInfo :: Id -> ArityInfo -> Id
+setIdArityInfo id arity = modifyIdInfo (`setArityInfo` arity) id
 
 	---------------------------------
 	-- STRICTNESS
-getIdStrictness :: Id -> StrictnessInfo
-getIdStrictness id = strictnessInfo (idInfo id)
+idStrictness :: Id -> StrictnessInfo
+idStrictness id = strictnessInfo (idInfo id)
 
 setIdStrictness :: Id -> StrictnessInfo -> Id
-setIdStrictness id strict_info = modifyIdInfo id (strict_info `setStrictnessInfo`)
+setIdStrictness id strict_info = modifyIdInfo (`setStrictnessInfo` strict_info) id
 
 -- isBottomingId returns true if an application to n args would diverge
 isBottomingId :: Id -> Bool
-isBottomingId id = isBottomingStrictness (strictnessInfo (idInfo id))
+isBottomingId id = isBottomingStrictness (idStrictness id)
+
+	---------------------------------
+	-- TYPE GENERALISATION
+idTyGenInfo :: Id -> TyGenInfo
+idTyGenInfo id = tyGenInfo (idInfo id)
+
+setIdTyGenInfo :: Id -> TyGenInfo -> Id
+setIdTyGenInfo id tygen_info = modifyIdInfo (`setTyGenInfo` tygen_info) id
 
-idAppIsBottom :: Id -> Int -> Bool
-idAppIsBottom id n = appIsBottom (strictnessInfo (idInfo id)) n
+	---------------------------------
+	-- WORKER ID
+idWorkerInfo :: Id -> WorkerInfo
+idWorkerInfo id = workerInfo (idInfo id)
+
+setIdWorkerInfo :: Id -> WorkerInfo -> Id
+setIdWorkerInfo id work_info = modifyIdInfo (`setWorkerInfo` work_info) id
 
 	---------------------------------
 	-- UNFOLDING
-getIdUnfolding :: Id -> Unfolding
-getIdUnfolding id = unfoldingInfo (idInfo id)
+idUnfolding :: Id -> Unfolding
+idUnfolding id = unfoldingInfo (idInfo id)
 
 setIdUnfolding :: Id -> Unfolding -> Id
-setIdUnfolding id unfolding = modifyIdInfo id (unfolding `setUnfoldingInfo`)
+setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
 
 	---------------------------------
 	-- DEMAND
-getIdDemandInfo :: Id -> Demand
-getIdDemandInfo id = demandInfo (idInfo id)
+idDemandInfo :: Id -> Demand
+idDemandInfo id = demandInfo (idInfo id)
 
 setIdDemandInfo :: Id -> Demand -> Id
-setIdDemandInfo id demand_info = modifyIdInfo id (demand_info `setDemandInfo`)
-
-	---------------------------------
-	-- UPDATE INFO
-getIdUpdateInfo :: Id -> UpdateInfo
-getIdUpdateInfo id = updateInfo (idInfo id)
-
-setIdUpdateInfo :: Id -> UpdateInfo -> Id
-setIdUpdateInfo id upd_info = modifyIdInfo id (upd_info `setUpdateInfo`)
+setIdDemandInfo id demand_info = modifyIdInfo (`setDemandInfo` demand_info) id
 
 	---------------------------------
 	-- SPECIALISATION
-getIdSpecialisation :: Id -> IdSpecEnv
-getIdSpecialisation id = specInfo (idInfo id)
+idSpecialisation :: Id -> CoreRules
+idSpecialisation id = specInfo (idInfo id)
 
-setIdSpecialisation :: Id -> IdSpecEnv -> Id
-setIdSpecialisation id spec_info = modifyIdInfo id (spec_info `setSpecInfo`)
+setIdSpecialisation :: Id -> CoreRules -> Id
+setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
 
 	---------------------------------
 	-- CAF INFO
-getIdCafInfo :: Id -> CafInfo
-getIdCafInfo id = cafInfo (idInfo id)
+idCafInfo :: Id -> CafInfo
+idCafInfo id = cafInfo (idInfo id)
 
 setIdCafInfo :: Id -> CafInfo -> Id
-setIdCafInfo id caf_info = modifyIdInfo id (caf_info `setCafInfo`)
+setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id
+
+	---------------------------------
+	-- CPR INFO
+idCprInfo :: Id -> CprInfo
+idCprInfo id = cprInfo (idInfo id)
+
+setIdCprInfo :: Id -> CprInfo -> Id
+setIdCprInfo id cpr_info = modifyIdInfo (`setCprInfo` cpr_info) id
+
+	---------------------------------
+	-- Occcurrence INFO
+idOccInfo :: Id -> OccInfo
+idOccInfo id = occInfo (idInfo id)
+
+setIdOccInfo :: Id -> OccInfo -> Id
+setIdOccInfo id occ_info = modifyIdInfo (`setOccInfo` occ_info) id
 \end{code}
 
 
@@ -281,32 +386,66 @@ The inline pragma tells us to be very keen to inline this Id, but it's still
 OK not to if optimisation is switched off.
 
 \begin{code}
-getInlinePragma :: Id -> InlinePragInfo
-getInlinePragma id = inlinePragInfo (idInfo id)
+idInlinePragma :: Id -> InlinePragInfo
+idInlinePragma id = inlinePragInfo (idInfo id)
 
 setInlinePragma :: Id -> InlinePragInfo -> Id
-setInlinePragma id prag = modifyIdInfo id (setInlinePragInfo prag)
+setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
 
 modifyInlinePragma :: Id -> (InlinePragInfo -> InlinePragInfo) -> Id
-modifyInlinePragma id fn = modifyIdInfo id (\info -> setInlinePragInfo (fn (inlinePragInfo info)) info)
-
-idWantsToBeINLINEd :: Id -> Bool
-idWantsToBeINLINEd id = case getInlinePragma id of
-			  IWantToBeINLINEd -> True
-			  IMustBeINLINEd   -> True
-			  other		   -> False
-
-idMustNotBeINLINEd id = case getInlinePragma id of
-			  IMustNotBeINLINEd -> True
-			  IAmASpecPragmaId  -> True
-			  IAmALoopBreaker   -> True
-			  other		    -> False
-
-idMustBeINLINEd id =  case getInlinePragma id of
-			IMustBeINLINEd -> True
-			other	       -> False
-
-isSpecPragmaId id = case getInlinePragma id of
-			IAmASpecPragmaId -> True
-			other		 -> False
+modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id
+\end{code}
+
+
+	---------------------------------
+	-- ONE-SHOT LAMBDAS
+\begin{code}
+idLBVarInfo :: Id -> LBVarInfo
+idLBVarInfo id = lbvarInfo (idInfo id)
+
+isOneShotLambda :: Id -> Bool
+isOneShotLambda id = analysis || hack
+  where analysis = case idLBVarInfo id of
+                     LBVarInfo u    | u == usOnce             -> True
+                     other                                    -> False
+        hack     = case splitTyConApp_maybe (idType id) of
+                     Just (tycon,_) | tycon == statePrimTyCon -> True
+                     other                                    -> False
+
+	-- The last clause is a gross hack.  It claims that 
+	-- every function over realWorldStatePrimTy is a one-shot
+	-- function.  This is pretty true in practice, and makes a big
+	-- difference.  For example, consider
+	--	a `thenST` \ r -> ...E...
+	-- The early full laziness pass, if it doesn't know that r is one-shot
+	-- will pull out E (let's say it doesn't mention r) to give
+	--	let lvl = E in a `thenST` \ r -> ...lvl...
+	-- When `thenST` gets inlined, we end up with
+	--	let lvl = E in \s -> case a s of (r, s') -> ...lvl...
+	-- and we don't re-inline E.
+	--
+	-- It would be better to spot that r was one-shot to start with, but
+	-- I don't want to rely on that.
+	--
+	-- Another good example is in fill_in in PrelPack.lhs.  We should be able to
+	-- spot that fill_in has arity 2 (and when Keith is done, we will) but we can't yet.
+
+setOneShotLambda :: Id -> Id
+setOneShotLambda id = modifyIdInfo (`setLBVarInfo` LBVarInfo usOnce) id
+
+clearOneShotLambda :: Id -> Id
+clearOneShotLambda id 
+  | isOneShotLambda id = modifyIdInfo (`setLBVarInfo` NoLBVarInfo) id
+  | otherwise	       = id			
+
+-- But watch out: this may change the type of something else
+--	f = \x -> e
+-- If we change the one-shot-ness of x, f's type changes
+\end{code}
+
+\begin{code}
+zapLamIdInfo :: Id -> Id
+zapLamIdInfo id = maybeModifyIdInfo zapLamInfo id
+
+zapDemandIdInfo id = maybeModifyIdInfo zapDemandInfo id
 \end{code}