StrongtalkSource/DeltaSideUpdate.dlt

   1 Delta define: #DeltaSideUpdate as: (\r
   2 (Class subclassOf: 'DeltaSideUpdateBehavior' instanceVariables: 'superclassType supportedProtocol classDecl klass mirror messages methods selfTV selfPublicTV typeOfInstances relevantTVs scope invocationCache loopMarker ')) !\r
   3 \r
   4 (Delta mirrorFor: #DeltaSideUpdate) revision: '$Revision: 1.3 $'!\r
   5 \r
   6 (Delta mirrorFor: #DeltaSideUpdate) group: 'ast'!\r
   7 \r
   8 (Delta mirrorFor: #DeltaSideUpdate)\r
   9 comment: \r
  10 'Concrete class representing a side.\r
  11  (c) 1995-1997 Sun Microsystems, Inc. ALL RIGHTS RESERVED. \r
  12 Use and distribution of this software is subject to the terms of the attached source license.'!\r
  13 \r
  14 ! (Delta mirrorFor: #DeltaSideUpdate) methodsFor: 'Unclassified' !\r
  15 \r
  16 \r
  17 addRelevantTypeVar: tv <TypeVar>\r
  18 \r
  19 self relevantTypeVars add: tv.\r
  20 self supportedProtocol isNil\r
  21   ifFalse:[self supportedProtocol addRelevantTypeVar: tv].!\r
  22 \r
  23 asMixinSide ^ <MixinSide>\r
  24 \r
  25 ^self!\r
  26 \r
  27 basicLocator\r
  28         self isMetaSide\r
  29                 ifTrue: [^self classDecl instanceSide basicLocator isMetaSide: true]\r
  30                 ifFalse: [^DeltaBasicMixinLocator new id: self name; isMetaSide: false]!\r
  31 \r
  32 classDecl ^ <DeltaClassUpdate>\r
  33     ^classDecl!\r
  34 \r
  35 classDecl: cd <DeltaClassUpdate > ^ <Self>\r
  36     classDecl := cd!\r
  37 \r
  38 clearCaches\r
  39 \r
  40 self relevantTVs:  nil.!\r
  41 \r
  42 hasMethodsLoaded ^ <Boolean>\r
  43 \r
  44 ^methods isNil not\r
  45 !\r
  46 \r
  47 heirScope ^ <Scope>\r
  48     ^self scope delta!\r
  49 \r
  50 initialize\r
  51 \r
  52 loopMarker := false.\r
  53 super initialize.\r
  54 self invocationCache: (IdentityDictionary[ObjectType, ObjectType] new).!\r
  55 \r
  56 initializeWithin: lexicalScope <Scope>\r
  57 \r
  58 loopMarker := false.\r
  59 super initializeWith: lexicalScope.\r
  60 self invocationCache: (IdentityDictionary[ObjectType, ObjectType] new).!\r
  61 \r
  62 invocationCache ^ <Dict[ObjectType, ObjectType]>\r
  63 \r
  64 ^invocationCache!\r
  65 \r
  66 invocationCache: c <VarDict[ObjectType, ObjectType]>\r
  67 \r
  68 invocationCache := c!\r
  69 \r
  70 klass\r
  71 \r
  72 ^klass!\r
  73 \r
  74 klass: k\r
  75 "Transcript show: 'SideUpdate>>klass'; cr."\r
  76 klass := k.\r
  77 self isMetaSide ifFalse:[self scope at: #Instance put: self selfTV]\r
  78                          ifTrue:[\r
  79                                    self selfTV isMeta: true.\r
  80                                    self selfPublicTV isMeta: true.\r
  81                                    self scope at: #Instance put: self selfClassTV.\r
  82                                    self scope at: #PublicInstance put: self selfPublicClassTV.\r
  83                                    self selfTV dual: self selfClassTV.\r
  84                                    self selfClassTV dual: self selfTV.\r
  85                                    self selfPublicTV dual: self selfPublicClassTV.\r
  86                                    self selfPublicClassTV dual: self selfPublicTV.\r
  87                                    ].\r
  88 "Whatever class is linked to me, must have my type var in its scope"!\r
  89 \r
  90 localScope ^ <Scope>\r
  91     ^self heirScope delta!\r
  92 \r
  93 lookupTypeOfInstances ^ <ObjectType>\r
  94 \r
  95 | key <ObjectType> result   <ObjectType> |\r
  96 \r
  97 ^loopMarker \r
  98    ifFalse:[\r
  99                  loopMarker := true.\r
 100                  key := self superclassType asProtocol canonicalRep.\r
 101                  result := self invocationCache at: key \r
 102                         ifAbsent:[self invocationCache at: key\r
 103                                                                   put: self typeOfInstances].\r
 104                  loopMarker := false.\r
 105                  result.\r
 106                  ]\r
 107   ifTrue:[typeOfInstances := super typeOfInstances].!\r
 108 \r
 109 messages ^ <Dict[Symbol,Message]>\r
 110 \r
 111 messages isNil ifTrue:[self mirror createMethodTypeStructure].\r
 112     ^messages!\r
 113 \r
 114 messages: ms<Dict[Symbol,Message]>\r
 115     messages := ms!\r
 116 \r
 117 methods ^ <Dict[Symbol,Method]>\r
 118 \r
 119 methods isNil ifTrue:[self mirror createMethodTypeStructure].\r
 120     ^methods!\r
 121 \r
 122 methods: ms<Dict[Symbol,Method]>\r
 123     methods := ms!\r
 124 \r
 125 mirror ^ <Mirror>\r
 126 \r
 127 mirror isNil ifTrue:[mirror :=super mirror].\r
 128 ^mirror!\r
 129 \r
 130 relevantTVs ^ <Set[TypeVar]>\r
 131 \r
 132 ^relevantTVs!\r
 133 \r
 134 relevantTVs: rtvs <Set[TypeVar]>\r
 135 \r
 136 relevantTVs := rtvs!\r
 137 \r
 138 relevantTypeVars ^ <Set[TypeVar]>\r
 139 \r
 140 self relevantTVs isNil\r
 141    ifTrue:[self relevantTVs: super relevantTypeVars].\r
 142 ^self relevantTVs.!\r
 143 \r
 144 scope ^<Scope>\r
 145     ^scope!\r
 146 \r
 147 scope: s <Scope>\r
 148     scope := s!\r
 149 \r
 150 selfPublicTV ^ <TypeVar>\r
 151     ^selfPublicTV!\r
 152 \r
 153 selfPublicTV: stv <TypeVar>\r
 154     selfPublicTV := stv.\r
 155     self localScope at: #PublicSelf put:  stv.!\r
 156 \r
 157 selfTV ^ <TypeVar>\r
 158     ^selfTV!\r
 159 \r
 160 selfTV: stv <TypeVar>\r
 161     selfTV := stv.\r
 162     self localScope at: #Self put:  stv.!\r
 163 \r
 164 superclassType ^ <ClassNode>\r
 165     ^superclassType!\r
 166 \r
 167 superclassType: st <ClassNode > ^ <Self>\r
 168     \r
 169 superclassType := st.\r
 170 self heirScope  base: st heirScope.\r
 171 "  (DeltaScopeReference for: st accessBlk: [:x | x heirScope])."\r
 172 "self scope at: #super put: (DeltaSuperVar new name: #super type: nil)."!\r
 173 \r
 174 supportedProtocol ^ <Protocol>\r
 175     ^supportedProtocol!\r
 176 \r
 177 supportedProtocol: p <Protocol > ^ <Self>\r
 178     supportedProtocol := p.!\r
 179 \r
 180 typeOfInstances ^ <ObjectType>\r
 181 "This method returns and caches the public protocol of the side. The actual \r
 182 construction of the value is handled by super's version of the\r
 183 method. "\r
 184 \r
 185     ^typeOfInstances isNil\r
 186    ifTrue:[\r
 187               typeOfInstances := self lookupTypeOfInstances.\r
 188               ]\r
 189    ifFalse:[typeOfInstances].! !\r
 190 \r