Skip to content

GitLab

Commit 506fa77d authored by simonpj's avatar simonpj
Browse files

[project @ 1999-05-18 15:03:33 by simonpj] 

RULES-NOTES
parent c415cd35
Hide whitespace changes
Inline Side-by-side
ghc/compiler/DEPEND-NOTES
View file @ 506fa77d
add types/InstEnv, InstEnv.hi-boot
add coreSyn/CoreRules.*
add coreSyn/CoreTidy.lhs
add coreSyn/CoreFVs.lhs
remove coreSyn/FreeVars.lhs
add coreSyn/Subst.*
remove simplCore/MagicUFs.*
remove specialise/SpecEnv.*
ToDo
~~~~
* Test effect of eta-expanding past (case x of ..)
......@@ -62,45 +74,43 @@ ToDo
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The Name/Var/Type group is a bit complicated. Here's the deal
Things in brackets are what the module *uses*.
A 'loop' indicates a use from a module compiled later
Name, PrimRep, FieldLabel (uses Type.Type)
Name, PrimRep, FieldLabel (loop Type.Type)
then
Var (uses Const.Con, IdInfo.IdInfo, Type.GenType, Type.Kind)
Var (loop Const.Con, loop IdInfo.IdInfo,
loop Type.GenType, loop Type.Kind)
then
VarEnv, VarSet
VarEnv, VarSet, ThinAir
then
Class (uses TyCon.TyCon, Type.Type, SpecEnv.SpecEnv)
Class (loop TyCon.TyCon, loop Type.Type, loop InstEnv.InstEnv)
then
TyCon (uses Type.Type, Type.Kind, DataCon.DataCon)
TyCon (loop Type.Type, loop Type.Kind, loop DataCon.DataCon)
then
Type (uses [DataCon.DataCon])
Type (loop DataCon.DataCon, loop Subst.substTy)
then
DataCon, TysPrim, Unify, SpecEnv, PprType
DataCon, TysPrim, Unify, PprType
then
IdInfo, TysWiredIn (uses DataCon.mkDataCon, [MkId.mkDataConId])
InstEnv (Unify)
then
PrimOp (uses PprType, TysWiredIn)
IdInfo (loop CoreRules.CoreRules)
TysWiredIn (DataCon.mkDataCon, loop MkId.mkDataConId)
then
Const (needs PrimOp, [TysWiredIn.stringTy])
PrimOp (PprType, TysWiredIn, IdInfo.StrictnessInfo)
then
Id (needs Const.Con(..)), CoreSyn
Const (PrimOp.PrimOp, TysWiredIn.stringTy)
then
CoreUtils, OccurAnal
Id (Const.Con(..)), CoreSyn
then
CoreUnfold (uses OccurAnal)
CoreUtils (loop PprCore.pprCoreExpr), CoreFVs
then
OccurAnal (ThinAir.noRepStrs -- an awkward dependency)
then
MkId (uses CoreUnfold)
PrimOp uses TysWiredIn
CoreUnfold (loop OccurAnal.globalOccurAnalyse)
then
Rules (Unfolding), Subst (Unfolding, CoreFVs), CoreTidy (noUnfolding)
then
MkId (CoreUnfold.mkUnfolding, Subst)
Add
~~~
basicTypes/DataCon.lhs
basicTypes/DataCon.hi-boot
Remove
~~~~~~
specialise/SpecUtils.lhs
basicTypes/IdUtils.lhs
ghc/compiler/Makefile
View file @ 506fa77d
# -----------------------------------------------------------------------------
# $Id: Makefile,v 1.57 1999/05/14 11:23:47 simonm Exp $
# $Id: Makefile,v 1.58 1999/05/18 15:03:34 simonpj Exp $
TOP = ..
include $(TOP)/mk/boilerplate.mk
......@@ -182,6 +182,7 @@ parser/U_literal_HC_OPTS = -fvia-C '-\#include"hspincl.h"'
parser/U_match_HC_OPTS = -fvia-C '-\#include"hspincl.h"'
parser/U_maybe_HC_OPTS = -fvia-C '-\#include"hspincl.h"'
parser/U_qid_HC_OPTS = -fvia-C '-\#include"hspincl.h"'
parser/U_rulevar_HC_OPTS = -fvia-C '-\#include"hspincl.h"'
parser/U_tree_HC_OPTS = -H12m -fvia-C '-\#include"hspincl.h"'
parser/U_ttype_HC_OPTS = -fvia-C '-\#include"hspincl.h"'
......
ghc/compiler/basicTypes/BasicTypes.lhs
View file @ 506fa77d
......@@ -16,14 +16,14 @@ types that
module BasicTypes(
Version, Arity,
Unused, unused,
Fixity(..), FixityDirection(..), StrictnessMark(..),
NewOrData(..), TopLevelFlag(..), RecFlag(..)
Fixity(..), FixityDirection(..), defaultFixity,
NewOrData(..),
RecFlag(..), isRec, isNonRec,
TopLevelFlag(..), isTopLevel, isNotTopLevel
) where
#include "HsVersions.h"
import {-# SOURCE #-} DataCon ( DataCon )
import {-# SOURCE #-} Type ( Type )
import Outputable
\end{code}
......@@ -86,6 +86,9 @@ instance Outputable FixityDirection where
instance Eq Fixity where -- Used to determine if two fixities conflict
(Fixity p1 dir1) == (Fixity p2 dir2) = p1==p2 && dir1 == dir2
defaultFixity = Fixity 9 InfixL
\end{code}
......@@ -113,6 +116,14 @@ data NewOrData
data TopLevelFlag
= TopLevel
| NotTopLevel
isTopLevel, isNotTopLevel :: TopLevelFlag -> Bool
isNotTopLevel NotTopLevel = True
isNotTopLevel TopLevel = False
isTopLevel TopLevel = True
isTopLevel NotTopLevel = False
\end{code}
%************************************************************************
......@@ -124,16 +135,12 @@ data TopLevelFlag
\begin{code}
data RecFlag = Recursive
| NonRecursive
\end{code}
%************************************************************************
%* *
\subsection{Strictness indication}
%* *
%************************************************************************
isRec :: RecFlag -> Bool
isRec Recursive = True
isRec NonRecursive = False
\begin{code}
data StrictnessMark = MarkedStrict
| MarkedUnboxed DataCon [Type]
| NotMarkedStrict
isNonRec :: RecFlag -> Bool
isNonRec Recursive = False
isNonRec NonRecursive = True
\end{code}
ghc/compiler/basicTypes/Const.lhs
View file @ 506fa77d
......@@ -8,7 +8,8 @@ module Const (
Con(..),
conType, conPrimRep,
conOkForApp, conOkForAlt, isWHNFCon, isDataCon,
conIsTrivial, conIsCheap,
conIsTrivial, conIsCheap, conIsDupable, conStrictness,
conOkForSpeculation,
DataCon, PrimOp, -- For completeness
......@@ -26,12 +27,14 @@ module Const (
import TysPrim ( charPrimTy, addrPrimTy, floatPrimTy, doublePrimTy,
intPrimTy, wordPrimTy, int64PrimTy, word64PrimTy
)
import PrimOp ( PrimOp, primOpType, primOpIsCheap )
import PrimOp ( PrimOp, primOpType, primOpIsDupable,
primOpIsCheap, primOpStrictness, primOpOkForSpeculation )
import PrimRep ( PrimRep(..) )
import DataCon ( DataCon, dataConType, dataConTyCon, isNullaryDataCon )
import DataCon ( DataCon, dataConType, dataConTyCon, isNullaryDataCon, dataConRepStrictness )
import TyCon ( isNewTyCon )
import Type ( Type, typePrimRep )
import PprType ( pprParendType )
import Demand ( Demand )
import CStrings ( stringToC, charToC, charToEasyHaskell )
import Outputable
......@@ -74,6 +77,11 @@ conType (DataCon dc) = dataConType dc
conType (Literal lit) = literalType lit
conType (PrimOp op) = primOpType op
conStrictness :: Con -> ([Demand], Bool)
conStrictness (DataCon dc) = (dataConRepStrictness dc, False)
conStrictness (PrimOp op) = primOpStrictness op
conStrictness (Literal lit) = ([], False)
conPrimRep :: Con -> PrimRep -- Only data valued constants
conPrimRep (DataCon dc) = ASSERT( isNullaryDataCon dc) PtrRep
conPrimRep (Literal lit) = literalPrimRep lit
......@@ -113,6 +121,18 @@ conIsTrivial con = True
conIsCheap (Literal lit) = not (isNoRepLit lit)
conIsCheap (DataCon con) = True
conIsCheap (PrimOp op) = primOpIsCheap op
-- conIsDupable is true for constants whose applications we are willing
-- to duplicate in different case branches; i.e no issue about loss of
-- work, just space
conIsDupable (Literal lit) = not (isNoRepLit lit)
conIsDupable (DataCon con) = True
conIsDupable (PrimOp op) = primOpIsDupable op
-- Similarly conOkForSpeculation
conOkForSpeculation (Literal lit) = True
conOkForSpeculation (DataCon con) = True
conOkForSpeculation (PrimOp op) = primOpOkForSpeculation op
\end{code}
......
ghc/compiler/basicTypes/DataCon.hi-boot
View file @ 506fa77d
_interface_ DataCon 1
_exports_
DataCon DataCon ;
DataCon DataCon dataConType ;
_declarations_
1 data DataCon ;
1 dataConType _:_ DataCon -> Type.Type ;;
ghc/compiler/basicTypes/DataCon.lhs
View file @ 506fa77d
......@@ -11,18 +11,23 @@ module DataCon (
dataConType, dataConSig, dataConName, dataConTag,
dataConOrigArgTys, dataConArgTys, dataConRawArgTys, dataConTyCon,
dataConFieldLabels, dataConStrictMarks, dataConSourceArity,
dataConNumFields, dataConNumInstArgs, dataConId,
dataConNumFields, dataConNumInstArgs, dataConId, dataConRepStrictness,
isNullaryDataCon, isTupleCon, isUnboxedTupleCon,
isExistentialDataCon
isExistentialDataCon,
StrictnessMark(..), -- Representation visible to MkId only
markedStrict, notMarkedStrict, markedUnboxed, maybeMarkedUnboxed
) where
#include "HsVersions.h"
import {-# SOURCE #-} Subst( substTy, mkTyVarSubst )
import CmdLineOpts ( opt_DictsStrict )
import TysPrim
import Type ( Type, ThetaType, TauType,
mkSigmaTy, mkFunTys, mkTyConApp,
mkTyVarTys, mkDictTy, substTy,
mkTyVarTys, mkDictTy,
splitAlgTyConApp_maybe
)
import PprType
......@@ -31,9 +36,9 @@ import TyCon ( TyCon, tyConDataCons, isDataTyCon,
import Class ( classTyCon )
import Name ( Name, NamedThing(..), nameUnique, isLocallyDefinedName )
import Var ( TyVar, Id )
import VarEnv
import FieldLabel ( FieldLabel )
import BasicTypes ( StrictnessMark(..), Arity )
import BasicTypes ( Arity )
import Demand ( Demand, wwStrict, wwLazy )
import Outputable
import Unique ( Unique, Uniquable(..) )
import CmdLineOpts ( opt_UnboxStrictFields )
......@@ -136,6 +141,32 @@ but the rep type is
Actually, the unboxed part isn't implemented yet!
%************************************************************************
%* *
\subsection{Strictness indication}
%* *
%************************************************************************
\begin{code}
data StrictnessMark = MarkedStrict
| MarkedUnboxed DataCon [Type]
| NotMarkedStrict
markedStrict = MarkedStrict
notMarkedStrict = NotMarkedStrict
markedUnboxed = MarkedUnboxed (panic "markedUnboxed1") (panic "markedUnboxed2")
maybeMarkedUnboxed (MarkedUnboxed dc tys) = Just (dc,tys)
maybeMarkedUnboxed other = Nothing
\end{code}
%************************************************************************
%* *
\subsection{Instances}
%* *
%************************************************************************
\begin{code}
instance Eq DataCon where
a == b = getUnique a == getUnique b
......@@ -161,6 +192,13 @@ instance Show DataCon where
showsPrec p con = showsPrecSDoc p (ppr con)
\end{code}
%************************************************************************
%* *
\subsection{Consruction}
%* *
%************************************************************************
\begin{code}
mkDataCon :: Name
-> [StrictnessMark] -> [FieldLabel]
......@@ -307,6 +345,17 @@ dataConSourceArity :: DataCon -> Arity
-- Source-level arity of the data constructor
dataConSourceArity dc = length (dcOrigArgTys dc)
dataConRepStrictness :: DataCon -> [Demand]
-- Give the demands on the arguments of a
-- Core constructor application (Con dc args)
dataConRepStrictness dc
= go (dcRealStricts dc)
where
go [] = []
go (MarkedStrict : ss) = wwStrict : go ss
go (NotMarkedStrict : ss) = wwLazy : go ss
go (MarkedUnboxed con _ : ss) = go (dcRealStricts con ++ ss)
dataConSig :: DataCon -> ([TyVar], ThetaType,
[TyVar], ThetaType,
[TauType], TyCon)
......@@ -325,12 +374,12 @@ dataConArgTys, dataConOrigArgTys :: DataCon
dataConArgTys (MkData {dcRepArgTys = arg_tys, dcTyVars = tyvars,
dcExTyVars = ex_tyvars, dcExTheta = ex_theta}) inst_tys
= map (substTy (zipVarEnv (tyvars ++ ex_tyvars) inst_tys))
= map (substTy (mkTyVarSubst (tyvars ++ ex_tyvars) inst_tys))
([mkDictTy cls tys | (cls,tys) <- ex_theta] ++ arg_tys)
dataConOrigArgTys (MkData {dcOrigArgTys = arg_tys, dcTyVars = tyvars,
dcExTyVars = ex_tyvars, dcExTheta = ex_theta}) inst_tys
= map (substTy (zipVarEnv (tyvars ++ ex_tyvars) inst_tys))
= map (substTy (mkTyVarSubst (tyvars ++ ex_tyvars) inst_tys))
([mkDictTy cls tys | (cls,tys) <- ex_theta] ++ arg_tys)
\end{code}
......
ghc/compiler/basicTypes/Demand.lhs
View file @ 506fa77d
......@@ -8,7 +8,7 @@ module Demand(
Demand(..),
wwLazy, wwStrict, wwUnpackData, wwUnpackNew, wwPrim, wwEnum,
isStrict, isLazy,
isStrict, isLazy, isPrim,
pprDemands
) where
......@@ -80,6 +80,10 @@ isStrict WwStrict = True
isStrict WwEnum = True
isStrict WwPrim = True
isStrict _ = False
isPrim :: Demand -> Bool
isPrim WwPrim = True
isPrim other = False
\end{code}
\begin{code}
......
ghc/compiler/basicTypes/Id.lhs
View file @ 506fa77d
......@@ -8,16 +8,17 @@ module Id (
Id, DictId,
-- Simple construction
mkVanillaId, mkImportedId, mkSysLocal, mkUserLocal,
mkTemplateLocals, mkTemplateLocal, mkWildId, mkUserId,
mkId, mkVanillaId, mkSysLocal, mkUserLocal,
mkTemplateLocals, mkWildId, mkTemplateLocal,
-- Taking an Id apart
idName, idType, idUnique, idInfo, idDetails,
idName, idType, idUnique, idInfo,
idPrimRep, isId,
recordSelectorFieldLabel,
-- Modifying an Id
setIdName, setIdUnique, setIdType, setIdInfo,
setIdName, setIdUnique, setIdType, setIdNoDiscard,
setIdInfo, modifyIdInfo, maybeModifyIdInfo,
-- Predicates
omitIfaceSigForId,
......@@ -26,14 +27,12 @@ module Id (
-- Inline pragma stuff
getInlinePragma, setInlinePragma, modifyInlinePragma,
idWantsToBeINLINEd, idMustBeINLINEd, idMustNotBeINLINEd,
isSpecPragmaId,
idMustBeINLINEd, idMustNotBeINLINEd,
isRecordSelector,
isSpecPragmaId, isRecordSelector,
isPrimitiveId_maybe, isDataConId_maybe,
isConstantId,
isBottomingId, idAppIsBottom,
isConstantId, isBottomingId, idAppIsBottom,
isExportedId, isUserExportedId,
-- IdInfo stuff
setIdUnfolding,
......@@ -61,20 +60,22 @@ module Id (
#include "HsVersions.h"
import {-# SOURCE #-} CoreUnfold ( Unfolding )
import {-# SOURCE #-} CoreSyn ( CoreRules )
import Var ( Id, DictId, VarDetails(..),
isId, mkId,
idName, idType, idUnique, idInfo, idDetails,
setIdName, setVarType, setIdUnique, setIdInfo, modifyIdInfo,
import Var ( Id, DictId,
isId, mkIdVar,
idName, idType, idUnique, idInfo,
setIdName, setVarType, setIdUnique,
setIdInfo, modifyIdInfo, maybeModifyIdInfo,
externallyVisibleId
)
import VarSet
import Type ( Type, tyVarsOfType, typePrimRep, addFreeTyVars )
import IdInfo
import Demand ( Demand )
import Demand ( Demand, isStrict, wwLazy )
import Name ( Name, OccName,
mkSysLocalName, mkLocalName,
isWiredInName
isWiredInName, isUserExportedName
)
import Const ( Con(..) )
import PrimRep ( PrimRep )
......@@ -106,15 +107,22 @@ infixl 1 `setIdUnfolding`,
%* *
%************************************************************************
\begin{code}
mkVanillaId :: Name -> Type -> Id
mkVanillaId name ty = mkId name (addFreeTyVars ty) VanillaId noIdInfo
Absolutely all Ids are made by mkId. It
a) Pins free-tyvar-info onto the Id's type,
where it can easily be found.
b) Ensures that exported Ids are
mkImportedId :: Name -> Type -> IdInfo -> Id
mkImportedId name ty info = mkId name (addFreeTyVars ty) VanillaId info
\begin{code}
mkId :: Name -> Type -> IdInfo -> Id
mkId name ty info = mkIdVar name (addFreeTyVars ty) info'
where
info' | isUserExportedName name = setNoDiscardInfo info
| otherwise = info
\end{code}
mkUserId :: Name -> Type -> Id
mkUserId name ty = mkVanillaId name ty
\begin{code}
mkVanillaId :: Name -> Type -> Id
mkVanillaId name ty = mkId name ty vanillaIdInfo
-- SysLocal: for an Id being created by the compiler out of thin air...
-- UserLocal: an Id with a name the user might recognize...
......@@ -163,27 +171,6 @@ 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}
%************************************************************************
%* *
......@@ -192,28 +179,75 @@ omitIfaceSigForId id
%************************************************************************
\begin{code}
idFlavour :: Id -> IdFlavour
idFlavour id = flavourInfo (idInfo id)
setIdNoDiscard :: Id -> Id
setIdNoDiscard id -- Make an Id into a NoDiscardId, unless it is already
= modifyIdInfo setNoDiscardInfo id
recordSelectorFieldLabel :: Id -> FieldLabel
recordSelectorFieldLabel id = case idDetails id of
recordSelectorFieldLabel id = case idFlavour id of
RecordSelId lbl -> lbl
isRecordSelector id = case idDetails id of
isRecordSelector id = case idFlavour id of
RecordSelId lbl -> True
other -> False
isPrimitiveId_maybe id = case idDetails id of
isPrimitiveId_maybe id = case idFlavour id of
ConstantId (PrimOp op) -> Just op
other -> Nothing
isDataConId_maybe id = case idDetails id of
isDataConId_maybe id = case idFlavour id of
ConstantId (DataCon con) -> Just con
other -> Nothing
isConstantId id = case idDetails id of
isConstantId id = case idFlavour id of
ConstantId _ -> True
other -> False
isSpecPragmaId id = case idFlavour id of
SpecPragmaId -> True
other -> False
-- Don't drop a binding for an exported Id,
-- if it otherwise looks dead.
isExportedId :: Id -> Bool
isExportedId id = case idFlavour id of
VanillaId -> False
other -> True -- All the others are no-discard
-- Say if an Id was exported by the user
-- Implies isExportedId (see mkId above)
isUserExportedId :: Id -> Bool
isUserExportedId id = isUserExportedName (idName 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 idFlavour 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}
%************************************************************************
%* *
\subsection{IdInfo stuff}
......@@ -227,7 +261,7 @@ getIdArity :: Id -> ArityInfo
getIdArity id = arityInfo (idInfo id)
setIdArity :: Id -> ArityInfo -> Id
setIdArity id arity = modifyIdInfo id (arity `setArityInfo`)
setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
---------------------------------
-- STRICTNESS
......@@ -235,7 +269,7 @@ getIdStrictness :: Id -> StrictnessInfo
getIdStrictness 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
......@@ -250,7 +284,7 @@ getIdWorkerInfo :: Id -> WorkerInfo
getIdWorkerInfo id = workerInfo (idInfo id)
setIdWorkerInfo :: Id -> WorkerInfo -> Id
setIdWorkerInfo id work_info = modifyIdInfo id (work_info `setWorkerInfo`)
setIdWorkerInfo id work_info = modifyIdInfo (`setWorkerInfo` work_info) id
---------------------------------
-- UNFOLDING
......@@ -258,7 +292,7 @@ getIdUnfolding :: Id -> Unfolding
getIdUnfolding id = unfoldingInfo (idInfo id)
setIdUnfolding :: Id -> Unfolding -> Id
setIdUnfolding id unfolding = modifyIdInfo id (unfolding `setUnfoldingInfo`)
setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
---------------------------------
-- DEMAND
......@@ -266,7 +300,7 @@ getIdDemandInfo :: Id -> Demand
getIdDemandInfo id = demandInfo (idInfo id)
setIdDemandInfo :: Id -> Demand -> Id
setIdDemandInfo id demand_info = modifyIdInfo id (demand_info `setDemandInfo`)
setIdDemandInfo id demand_info = modifyIdInfo (`setDemandInfo` demand_info) id
---------------------------------
-- UPDATE INFO
......@@ -274,15 +308,15 @@ getIdUpdateInfo :: Id -> UpdateInfo
getIdUpdateInfo id = updateInfo (idInfo id)
setIdUpdateInfo :: Id -> UpdateInfo -> Id
setIdUpdateInfo id upd_info = modifyIdInfo id (upd_info `setUpdateInfo`)
setIdUpdateInfo id upd_info = modifyIdInfo (`setUpdateInfo` upd_info) id
---------------------------------
-- SPECIALISATION
getIdSpecialisation :: Id -> IdSpecEnv
getIdSpecialisation :: Id -> CoreRules
getIdSpecialisation 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
......@@ -290,7 +324,7 @@ getIdCafInfo :: Id -> CafInfo
getIdCafInfo 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
......@@ -298,8 +332,7 @@ getIdCprInfo :: Id -> CprInfo
getIdCprInfo id = cprInfo (idInfo id)
setIdCprInfo :: Id -> CprInfo -> Id