From VisualWorks®, 7.6 of 8. Februar 2008 on 28. Februar 2008 at 6:33:13 (Dialog confirm: 'You are filing-in a Parcel source file!\\While this is possible it will not have\the same effect as loading the parcel.\None of the Parcel''s prerequisites will\be loaded and none of its load actions\will be performed.\\Are you sure you want to file-in?' withCRs) ifFalse: [self error: 'Parcel file-in abandoned. Choose terminate or close.'] <name>IncrementalTypes</name> <environment>ICC</environment> <private>false</private> <imports> private Smalltalk.* </imports> <category>IC&C Incremental Types</category> <attributes> <package>ICCIncrementalTypes</package> </attributes> <class> <name>IT1TypeScheme</name> <environment>ICC.IncrementalTypes</environment> <super>Core.Object</super> <private>false</private> none masterClass <imports></imports> <category>IC&C Incremental Types</category> <attributes> <package>ICCIncrementalTypes</package> </attributes> </class> <comment> ICC.IncrementalTypes.IT1TypeScheme
This is an abstract class for type object semantics. It records the class in which an expression was created. Type schemes may be open or closed, depending on type variables they may be built upon. Instance Variables: masterClass <Class> Class in which a specific type expression was statically defined. Subclasses must implement the following messages: Instance protocol: accessing baseClass printing printNotationOn: compatibility in:satisfiedBy:in:matchContext:
</comment> <class> <name>IT1UnionType</name> <environment>ICC.IncrementalTypes</environment> <super>ICC.IncrementalTypes.IT1TypeScheme</super> <private>false</private> none union <imports></imports> <category>IC&C Incremental Types</category> <attributes> <package>ICCIncrementalTypes</package> </attributes> </class> <comment> ICC.IncrementalTypes.IT1UnionType
This class is a type which should be used with care. Type aggregated in a union type should only be used in a context where the messages they must service are implemented by all members of the union type. nil is handled as an exception to the rule: nil as part of a union type is suppressed in type checking, a warning is issued, and it is assumed that programming provisions are taken to cope with partially defined situations. Instance Variables: union <OrderedCollection of: IT1TypeScheme>
</comment> <class> <name>IT1ClassType</name> <environment>ICC.IncrementalTypes</environment> <super>ICC.IncrementalTypes.IT1TypeScheme</super> <private>false</private> none baseClass typeVariableScope meta <imports></imports> <category>IC&C Incremental Types</category> <attributes> <package>ICCIncrementalTypes</package> </attributes> </class> <comment> ICC.IncrementalTypes.IT1ClassType
This class is the basic means to define type structures. Instance variables: baseClass <Class> typeVariableScope <IT1TypeVariableScope> meta <Boolean>
</comment> <class> <name>IT1TypeVariable</name> <environment>ICC.IncrementalTypes</environment> <super>ICC.IncrementalTypes.IT1TypeScheme</super> <private>false</private> none typeVarName meta <imports></imports> <category>IC&C Incremental Types</category> <attributes> <package>ICCIncrementalTypes</package> </attributes> </class> <comment> ICC.IncrementalTypes.IT1TypeVariable
This class serves several purposes: 1. Generic types are used for type abstraction. Type variables instantiated with 'free' are unconstrained abstractions. Type variables instantiated with any other value are constrained abstractions. 2. Type inheritance solves part of the problem of the type/subtype vs. code inheritance discussion. It allows to explicitly define refinements of a type in a subclass. This is achieved using type variables with appropriate conformance rules. 3. Type polymorphism of e.g. methods is introduced via type variables and conformance. Instance variables: typeVarName <String> meta <Boolean> indicates whether the type variable represents current class
</comment> <class> <name>IT1TypeEnvironment</name> <environment>ICC.IncrementalTypes</environment> <super>Core.Object</super> <private>false</private> none typeVariableBindings masterClass meta <imports></imports> <category>IC&C Incremental Types</category> <attributes> <package>ICCIncrementalTypes</package> </attributes> </class> <comment> ICC.IncrementalTypes.IT1TypeEnvironment
ITTypeEnvironment represents a closure on type variable declarations in such a way that every free type variable in a type scheme that defines a type variable has a definition in the type environment. Instance Variables: typeVariableBindings <IT1TypeVariableScope> type declarations closed by the environment masterClass <Class> information necessary for interpreting 'current' references meta <Boolean> indicating whether the type environment context is instance or class level
</comment> <class> <name>IT1TypeReport</name> <environment>ICC.IncrementalTypes</environment> <super>UI.Model</super> <private>false</private> none errors <imports></imports> <category>IC&C Incremental Types</category> <attributes> <package>ICCIncrementalTypes</package> </attributes> </class> <comment> ICC.IncrementalTypes.IT1TypeReport
Instances of this class collect errors or warnings produced during type declaration analysis or type checking in general. Reports are produced as a side effect of type checking. Instance Variables: errors <OrderedCollection of: String> a description of errors encountered
</comment> <class> <name>IT1Context</name> <environment>ICC.IncrementalTypes</environment> <super>Core.Object</super> <private>false</private> none typeRep <imports></imports> <category>IC&C Incremental Types</category> <attributes> <package>ICCIncrementalTypes</package> </attributes> </class> <comment> ICC.IncrementalTypes.IT1Context
ITContext is an abstract superclass for all classes establishing a context in type elaboration and type checking. Instance Variables: typeRep <IT1TypeReport>
</comment> <class> <name>IT1FullType</name> <environment>ICC.IncrementalTypes</environment> <super>Core.Object</super> <private>false</private> none classType clientRelationDeclarations typeDescriptor baseClass <imports></imports> <category>IC&C Incremental Types</category> <attributes> <package>ICCIncrementalTypes</package> </attributes> </class> <comment> ICC.IncrementalTypes.IT1FullType
This class represents types based on classes. Full types allow partial decriptions of the type's object space, taking into account only those specifications which are semantically meaningful. A type's state space is strictly valid if its superclasses are strictly valid, and if no types referred to are incomplete in a certain sense. Otherwise, a type is only partially defined. There are situations where it is sufficient to have partial type definitions. Full type is fully elaborated on demand. Note that a type is not elaborated iff its classType is nil. Delaying full elaboration contributes to the incremental flavor of IncrementalTypes. Instance Variables: baseClass <Class> class on which this full type is based classType <IT1ClassType> type scheme specification for base class clientRelationDeclarations <IT1ClientRelationScope> defining all client relations typeDescriptor <IT1TypeDescriptor | nil> attributes defined for the full type Class Variables: CompatibilityErrorSignal <Signal>
</comment> <class> <name>IT1TypeElaboration</name> <environment>ICC.IncrementalTypes</environment> <super>Core.Object</super> <private>false</private> none fullType elaborationHistory typeVarDeclarations clientRelationDeclarations typeEnvironment strictValidityReport localValidityReport <imports></imports> <category>IC&C Incremental Types</category> <attributes> <package>ICCIncrementalTypes</package> </attributes> </class> <comment> ICC.IncrementalTypes.IT1TypeElaboration
This class controls elaboration of declarations for a dedicated master class. A successful elaboration leads to creation of full type variable declarations and their linking to an appropriate outer scope. Semantic objects are assigned according to context. Instance Variables: fullType <IT1FullType> elaborationHistory <OrderedCollection of: Class> typeVarDeclarations <IT1TypeVariableScope> scoping type variables currently elaborated clientRelationDeclarations <IT1ClientRelationScope> scoping client relations currently elaborated typeEnvironment <IT1TypeEnvironment> strictValidityReport <IT1TypeReport> localValidityReport <IT1TypeReport>
</comment> <class> <name>IT1VariableDeclarations</name> <environment>ICC.IncrementalTypes</environment> <super>Core.Object</super> <private>false</private> none class instVars classVars classInstVars typeVars inheritedInstVars inheritedClassInstVars <imports></imports> <category>IC&C Incremental Types</category> <attributes> <package>ICCIncrementalTypes</package> </attributes> </class> <comment> ICC.IncrementalTypes.IT1VariableDeclarations
This class provides an interface for checking class comments for declarations of variables. Declaration strings are evaluated and transformed into parse trees of proper type expressions following the syntax given by the Smalltalk Parser class. There are instance, class instance and class variables in standard VisualWorks. IncrementalTypes add type variable definitions. Furthermore, it is possible to redefine variables obeying compatibility rules. Instance Variables: class <Class> instVars <Array of: (Association key: String value: ProgramNode)> classVars <Array of: (Association key: String value: ProgramNode)> classInstVars <Array of: (Association key: String value: ProgramNode)> typeVars <Array of: (Association key: String value: ProgramNode)> inheritedInstVars <Array of: (Association key: String value: ProgramNode)> inheritedClassInstVars <Array of: (Association key: String value: ProgramNode)>
</comment> <class> <name>IT1ClientRelation</name> <environment>ICC.IncrementalTypes</environment> <super>UI.UISpecification</super> <private>false</private> none roleContext roleName role implementation explanation <imports></imports> <category>IC&C Incremental Types</category> <attributes> <package>ICCIncrementalTypes</package> </attributes> </class> <comment> ICC.IncrementalTypes.IT1ClientRelation
ITClientRelation Instance Variables: roleContext <LiteralBindingReference | Class> Coming from literal encoding, the roleContext temporary is aBindingReference. roleName <String> role <IT1TypeScheme> implementation <Symbol | nil> See class IT1TypeSpecifications for implementation types. explanation <String>
</comment> <class> <name>IT1NameScope</name> <environment>ICC.IncrementalTypes</environment> <super>Core.Object</super> <private>false</private> none outerScope <imports></imports> <category>IC&C Incremental Types</category> <attributes> <package>ICCIncrementalTypes</package> </attributes> </class> <comment> ICC.IncrementalTypes.IT1NameScope
ITNameScope is an abstract class for all variable scopes. Instance Variables: outerScope <IT1NameScope | nil>
</comment> <class> <name>IT1ClientRelationScope</name> <environment>ICC.IncrementalTypes</environment> <super>ICC.IncrementalTypes.IT1NameScope</super> <private>false</private> none clientRelations localScope <imports></imports> <category>IC&C Incremental Types</category> <attributes> <package>ICCIncrementalTypes</package> </attributes> </class> <comment> ICC.IncrementalTypes.IT1ClientRelationScope
ITClientRelationDeclarations Instance Variables: localScope <Class> clientRelations <OrderedCollection of: IT1ClientRelation>
</comment> <class> <name>IT1TypeSpecificationsStub</name> <environment>ICC.IncrementalTypes</environment> <super>Core.Object</super> <private>false</private> none <imports></imports> <category>IC&C Incremental Types</category> <attributes> <package>ICCIncrementalTypes</package> </attributes> </class> <comment> ICC.IncrementalTypes.IT1TypeSpecificationsStub
The purpose of this class is to avoid malfunctions of system modifications after reinstalling ADvance. Its sole service does nothing and answer false to indicate the nop."
</comment> <class> <name>IT1LiteralType</name> <environment>ICC.IncrementalTypes</environment> <super>ICC.IncrementalTypes.IT1ClassType</super> <private>false</private> none literal <imports></imports> <category>IC&C Incremental Types</category> <attributes> <package>ICCIncrementalTypes</package> </attributes> </class> <comment> ICC.IncrementalTypes.IT1LiteralType
Instances of this class record values which might be used for further type evaluation purposes. Instance Variables: literal <Object>
</comment> <class> <name>IT1Inferencing</name> <environment>ICC.IncrementalTypes</environment> <super>ICC.IncrementalTypes.IT1Context</super> <private>false</private> none inferenceConstraints <imports></imports> <category>IC&C Incremental Types</category> <attributes> <package>ICCIncrementalTypes</package> </attributes> </class> <comment> ICC.IncrementalTypes.IT1Inferencing
This class is used for type inference as part of compatibility checks. It collects constraints on type constructors imposed through a compatibility check. Instance Variables: inferenceConstraints <OrderedCollection of: (Association key: String value: IT1TypeScheme)>
</comment> <class> <name>IT1TypeVariableScope</name> <environment>ICC.IncrementalTypes</environment> <super>ICC.IncrementalTypes.IT1NameScope</super> <private>false</private> none typeVars <imports></imports> <category>IC&C Incremental Types</category> <attributes> <package>ICCIncrementalTypes</package> </attributes> </class> <comment> ICC.IncrementalTypes.IT1TypeVariableScope
This class describes a scope associated with type variables. Instance Variables: typeVars <Dictionary key: String value: IT1TypeScheme>
</comment> <class> <name>IT1FreeType</name> <environment>ICC.IncrementalTypes</environment> <super>ICC.IncrementalTypes.IT1TypeScheme</super> <private>false</private> none <imports></imports> <category>IC&C Incremental Types</category> <attributes> <package>ICCIncrementalTypes</package> </attributes> </class> <comment> ICC.IncrementalTypes.IT1FreeType
Instances of this class represent any type which encompasses all the worlds object identities and does understand nothing.
</comment> <class> <name>IT1TypeClosure</name> <environment>ICC.IncrementalTypes</environment> <super>ICC.IncrementalTypes.IT1TypeScheme</super> <private>false</private> none typeScheme typeEnvironment <imports></imports> <category>IC&C Incremental Types</category> <attributes> <package>ICCIncrementalTypes</package> </attributes> </class> <comment> ICC.IncrementalTypes.IT1TypeClosure
This class defines the bindings of free type variables in a type scheme through a type environment. Instance Variables: typeScheme <IT1TypeScheme> typeEnvironment <IT1TypeEnvironment>
</comment> <class> <name>IT1TypeDescriptor</name> <environment>ICC.IncrementalTypes</environment> <super>Core.Object</super> <private>false</private> none fullType strictValidityReport localValidityReport <imports></imports> <category>IC&C Incremental Types</category> <attributes> <package>ICCIncrementalTypes</package> </attributes> </class> <comment> ICC.IncrementalTypes.IT1TypeDescriptor
ITTypeDescriptor keeps track of information associated with full types, viz. status of declaration, or mappings defined for the type. StrictValidity always refers not to local validity but to conditions violating strict validity beyond local concerns. Instance Variables: fullType <IT1FullType> associated full type strictValidityReport <IT1TypeReport | nil> localValidityReport <IT1TypeReport | nil>
</comment> <class> <name>IT1TypeSpecifications</name> <environment>ICC.IncrementalTypes</environment> <super>ICC.IncrementalTypes.IT1TypeSpecificationsStub</super> <private>false</private> none fullTypes <imports></imports> <category>IC&C Incremental Types</category> <attributes> <package>ICCIncrementalTypes</package> </attributes> </class> <comment> ICC.IncrementalTypes.IT1TypeSpecifications
This class is a Singleton; its sole instance is accessible via 'default'. When classes are removed from the system, IncrementalTypes should be notified appropriately by ->removeSpecificationOf: aClass <- Instance Variables: fullTypes <IdentityDictionary key: Class value: IT1FullType> Class Variables: Default <IT1TypeSpecifications> ImplementationMapping <IdentityDictionary key: Symbol value: String>
</comment> <name>Default</name> <environment>ICC.IncrementalTypes.IT1TypeSpecifications</environment> <private>false</private> <constant>false</constant> <category>defaults</category> <attributes> <package>ICCIncrementalTypes</package> </attributes> <name>ImplementationMapping</name> <environment>ICC.IncrementalTypes.IT1TypeSpecifications</environment> <private>false</private> <constant>false</constant> <category>defaults</category> <attributes> <package>ICCIncrementalTypes</package> </attributes> <name>CompatibilityErrorSignal</name> <environment>ICC.IncrementalTypes.IT1FullType</environment> <private>false</private> <constant>false</constant> <category>signals</category> <attributes> <package>ICCIncrementalTypes</package> </attributes> <methods> ICC.IncrementalTypes.IT1TypeScheme <category>accessing</category>
baseClass "^<Class> Every type scheme is assumed to have a base class, defining a common behavior of the scheme. This assumption needs interpretation in specific cases." ^self subclassResponsibility
baseClassIn: aTypeEnvironment "^<Class> Default behavior" ^self baseClass
masterClass ^masterClass
masterClass: aClass masterClass := aClass
typeScheme ^self
</methods> <methods> ICC.IncrementalTypes.IT1TypeScheme <category>closure</category>
closureIn: aTypeEnvironment "The default for type expressions is to assume that they are closed." ^self
</methods> <methods> ICC.IncrementalTypes.IT1TypeScheme <category>testing</category>
hasTypeVarRecursion: aTypeVarName inElaborationContext: elabContext "^<Boolean>" "Check through recursive descent over a type scheme structure and its type variable bindings if a recursive type variable reference occurs." ^false
isFree ^false
</methods> <methods> ICC.IncrementalTypes.IT1TypeScheme <category>compatibility</category>
in: myEnv satisfiedBy: aTypeScheme in: aTypeSchemeEnv matchContext: matchContext "Check for compatibility is a property of all type schemes." ^self subclassResponsibility
</methods> <methods> ICC.IncrementalTypes.IT1TypeScheme <category>initialize-release</category>
initialize
</methods> <methods> ICC.IncrementalTypes.IT1TypeScheme <category>printing</category>
itTypeNotation | aStream | aStream := WriteStream on: (String new: 16). self printNotationOn: aStream. ^aStream contents
printNotationOn: aStream "Default is to use namespaces within notation." ^self printNotationOn: aStream showNamespaces: true
printNotationOn: aStream showNamespaces: aBoolean ^self subclassResponsibility
</methods> <methods> ICC.IncrementalTypes.IT1TypeScheme <category>IT-API</category>
itTypes ^self class itTypes
</methods> <methods> ICC.IncrementalTypes.IT1TypeScheme <category>error messages</category>
recursiveTypeVariableDeclarationError: aTypeVarName inElaborationContext: elabContext elabContext typeRep addError: 'Recursion error in class ''' , elabContext masterClassName , '''. Illegal recursive type binding of type variable ''' , aTypeVarName , ''' .'. ^nil
</methods> <methods> ICC.IncrementalTypes.IT1TypeScheme class <category>instance creation</category>
masterClass: aClass | obj | obj := self new initialize. obj masterClass: aClass. ^obj
</methods> <methods> ICC.IncrementalTypes.IT1UnionType <category>adding</category>
addTypeScheme: aTypeScheme self union add: aTypeScheme
addUnionType: aUnionType self union addAll: aUnionType union
</methods> <methods> ICC.IncrementalTypes.IT1UnionType <category>accessing</category>
baseClass "^<Class> The base class of a union type is defined as the common superclass of all base classes of union elements. This is a default which may be improved. Special treatment is given to nil: It is discarded unless it is the only type the union type merges to." ^self union inject: self union first baseClass into: [:tempUnion :next | self commonSuperclassOf: tempUnion and: next baseClass]
closedTypeVarTypeOf: typeVarName "^<ITTypeScheme | nil> This method yields a closed type scheme associated with the type variable binding of typeVarName in the context of the union type's base class. This property is only valid if there is exactly one union type component with the same base class as the union type's base class." | unionBaseClass baseTypes | unionBaseClass := self baseClass. baseTypes := self union select: [:each | each baseClass == unionBaseClass]. ^baseTypes size = 1 ifTrue: [baseTypes first closedTypeVarTypeOf: typeVarName] ifFalse: [nil]
union ^union
</methods> <methods> ICC.IncrementalTypes.IT1UnionType <category>private</category>
commonSuperclassOf: aClass1 and: aClass2 "^<Class> Find the nearest common superclass. Discard UndefinedObject. It is assumed that in many cases aClass2 is UndefinedObject." aClass2 == UndefinedObject ifTrue: [^aClass1]. aClass1 == UndefinedObject ifTrue: [^aClass2]. (aClass1 includesBehavior: aClass2) ifTrue: [^aClass2]. (aClass2 includesBehavior: aClass1) ifTrue: [^aClass1]. aClass1 superclass isNil ifTrue: [^Object]. ^self commonSuperclassOf: aClass1 superclass and: aClass2
</methods> <methods> ICC.IncrementalTypes.IT1UnionType <category>testing</category>
hasTypeVarRecursion: aTypeVarName inElaborationContext: elabContext ^self union contains: [:typeScheme | typeScheme hasTypeVarRecursion: aTypeVarName inElaborationContext: elabContext]
</methods> <methods> ICC.IncrementalTypes.IT1UnionType <category>compatibility</category>
in: myEnv satisfiedBy: aTypeScheme in: aTypeSchemeEnv matchContext: matchContext "^<ITMatchContext | nil>" | ok | aTypeScheme isFree ifTrue: [^matchContext]. ok := true. self union do: [:aType | (aType in: myEnv satisfiedBy: aTypeScheme in: aTypeSchemeEnv matchContext: matchContext) isNil ifTrue: [ok := false]]. ^ok ifTrue: [matchContext] ifFalse: [self unionTypeDoesNotMatchError: matchContext typeRep]
in: myEnv satisfies: aTypeScheme in: aTypeSchemeEnv matchContext: matchContext "^<ITMatchContext | nil>" | ok | ok := true. self union do: [:oneOfMyTypes | ok := ok & (aTypeScheme in: aTypeSchemeEnv satisfiedBy: oneOfMyTypes in: myEnv matchContext: matchContext) notNil]. ^ok ifTrue: [matchContext] ifFalse: [self unionTypeNotMatchedError: matchContext typeRep]
</methods> <methods> ICC.IncrementalTypes.IT1UnionType <category>initialize-release</category>
initialize super initialize. union := OrderedCollection new
</methods> <methods> ICC.IncrementalTypes.IT1UnionType <category>printing</category>
printNotationOn: aStream showNamespaces: aBoolean self union do: [:each | each printNotationOn: aStream showNamespaces: aBoolean] separatedBy: [aStream nextPutAll: ' | ']
</methods> <methods> ICC.IncrementalTypes.IT1UnionType <category>error messages</category>
unionTypeDoesNotMatchError: typeRep typeRep addError: 'Union type does not match.'. ^nil
unionTypeNotMatchedError: typeRep typeRep addError: 'Union type is not matched.'. ^nil
</methods> <methods> ICC.IncrementalTypes.IT1UnionType class <category>instance creation</category>
with: aTypeScheme ^(self masterClass: aTypeScheme masterClass) addTypeScheme: aTypeScheme; yourself
</methods> <methods> ICC.IncrementalTypes.IT1ClassType <category>accessing</category>
associatedFullType "^<ITFullType > Assuming that this method is not invoked in a situation bringing about recursive definitions." ^self itTypes fullTypeOfClass: self baseClass
baseClass ^baseClass
baseClass: aClass baseClass := aClass
baseClassName ^self baseClass fullName asString
baseClassShortName ^self baseClass name asString
closedTypeVarTypeOf: typeVarName "^<ITTypeScheme> This method yields a closed type scheme." ^self typeVariableScope typeVarTypeOf: typeVarName inEnvironment: self typeEnvironment
meta ^meta
meta: aBoolean meta := aBoolean
primTypeVariableScope ^typeVariableScope
typeVariableScope "^<IT1TypeVariableScope> The scope is given by the superclass of the base class (or the base class itself if superclass is nil as for Object and LensAbsentee)." | newOuterScope refClass | typeVariableScope isNil ifTrue: [refClass := (self baseClass superclass isNil ifTrue: [self baseClass] ifFalse: [self baseClass superclass]). newOuterScope := self itTypes typeVarDeclarationsOf: refClass. typeVariableScope := IT1TypeVariableScope outerScope: newOuterScope]. ^typeVariableScope
typeVariableScope: aTypeVariableScope typeVariableScope := aTypeVariableScope
typeVarTypeOf: typeVarName "^<ITTypeScheme> ---Attention--- This method yields a type scheme which might be open. It should therefore used with care." ^self typeVariableScope typeVarTypeOf: typeVarName
typeVarTypeOf: typeVarName inEnvironment: aTypeEnvironment "^<ITTypeScheme>" ^self closedTypeVarTypeOf: typeVarName
</methods> <methods> ICC.IncrementalTypes.IT1ClassType <category>error messages</category>
classTypeMismatch: className typeRep: typeRep typeRep addError: ('Class <1p> does not match <2p>.' expandMacrosWith: className with: self baseClassName). ^nil
missingTypeVarDeclarationError: typeVarName typeRep: typeRep typeRep addError: 'Type variable ''', typeVarName , ''' has no declaration.'. ^nil
noCompatibilityAtAllError: typeRep typeRep addError: 'Class ''', self baseClassName , ''' is not matched.'. ^nil
</methods> <methods> ICC.IncrementalTypes.IT1ClassType <category>closure</category>
closureIn: aTypeEnvironment ^self typeVariableScope isEmpty ifTrue: [self] ifFalse: [IT1TypeClosure typeScheme: self typeEnvironment: aTypeEnvironment]
typeEnvironment ^IT1TypeEnvironment closureOn: self typeVariableScope masterClass: self masterClass
</methods> <methods> ICC.IncrementalTypes.IT1ClassType <category>testing</category>
hasTypeVarRecursion: aTypeVarName inElaborationContext: elabContext "^<Boolean>" ^self typeVariableScope hasTypeVarRecursion: aTypeVarName inElaborationContext: elabContext
</methods> <methods> ICC.IncrementalTypes.IT1ClassType <category>compatibility</category>
in: myEnv genericsSatisfy: aClassTypeEnv matchContext: matchContext "^<ITMatchContext | nil> Check my own type variable definitions against generic definitions in aClassType. If I am not a constructed type, don't check. This prevents triggering of type scheme evaluations where not appropriate." | myTypeVarVal valToBeMatched | self primTypeVariableScope isNil ifTrue: [^matchContext]. self typeVariableScope typeVars keysAndValuesDo: [:typeVarName :typeVarVal | myTypeVarVal := self typeVariableScope atTypeVarName: typeVarName inEnvironment: myEnv. valToBeMatched := aClassTypeEnv atTypeVarName: typeVarName. valToBeMatched notNil ifTrue: [(valToBeMatched in: aClassTypeEnv satisfiedBy: myTypeVarVal in: myEnv matchContext: matchContext) isNil ifTrue: [^nil]]]. ^matchContext
in: myEnv satisfiedBy: aTypeScheme in: aTypeSchemeEnv matchContext: aMatchContext "^<ITTypeMatchContext | nil>" (aTypeScheme isKindOf: self class) ifTrue: [^self in: myEnv satisfiedByClassType: aTypeScheme in: aTypeSchemeEnv matchContext: aMatchContext]. (aTypeScheme isKindOf: IT1TypeClosure) ifTrue: [^self in: myEnv satisfiedBy: aTypeScheme typeScheme in: aTypeScheme typeEnvironment matchContext: aMatchContext]. (aTypeScheme isKindOf: IT1TypeVariable) ifTrue: [^self in: myEnv satisfiedByTypeVariable: aTypeScheme in: aTypeSchemeEnv matchContext: aMatchContext]. (aTypeScheme isKindOf: IT1UnionType) ifTrue: [^aTypeScheme in: aTypeSchemeEnv satisfies: self in: myEnv matchContext: aMatchContext]. (aTypeScheme isKindOf: IT1FreeType) ifTrue: [^aMatchContext]. ^self noCompatibilityAtAllError: aMatchContext typeRep
in: myEnv satisfiedByClassType: aClassType in: aClassTypeEnv matchContext: matchContext "^<ITMatchContext | nil>" "Note that neither myEnv nor aTypeSchemeEnv are used as base class types are closed by construction." ((aClassType baseClass includesBehavior: self baseClass) and: [aClassType meta = self meta]) ifTrue: [^aClassType in: aClassTypeEnv genericsSatisfy: self typeEnvironment matchContext: matchContext] ifFalse: [^self classTypeMismatch: aClassType baseClassName typeRep: matchContext typeRep]
in: myEnv satisfiedByTypeVariable: aTypeVariable in: aTypeVariableEnv matchContext: matchContext "^<ITMatchContext | nil>" "Type variables are dereferenced, their value tested again." | typeVarVal | typeVarVal := aTypeVariableEnv atTypeVarName: aTypeVariable typeVarName. ^typeVarVal isNil ifTrue: [self missingTypeVarDeclarationError: aTypeVariable typeVarName typeRep: matchContext typeRep] ifFalse: [self in: myEnv satisfiedBy: typeVarVal in: aTypeVariableEnv matchContext: matchContext]
</methods> <methods> ICC.IncrementalTypes.IT1ClassType <category>printing</category>
printNotationOn: aStream showNamespaces: aBoolean aStream nextPutAll: (aBoolean ifTrue: [self baseClassName] ifFalse: [self baseClassShortName]). self typeVariableScope printNotationOn: aStream showNamespaces: aBoolean
</methods> <methods> ICC.IncrementalTypes.IT1ClassType <category>type substitution</category>
substituteTypeVars: typeVarNames with: args inElaborationContext: elabContext "^<ITClassType | nil>" "Check base class for existence of type variables, check their values for args compatibility, and check whether type variable recursion occurs when substituting. Substitution is interpreted as true parallel substitution." | varVal match currentTypeVarBindings currentTypeEnvironment newTypeVarBindings | currentTypeVarBindings := self typeVarDeclarationsInElaborationContext: elabContext. elabContext updateStrictValidityReport: self associatedFullType strictValidityReport. currentTypeVarBindings isNil ifTrue: [^nil]. currentTypeEnvironment := IT1TypeEnvironment closureOn: currentTypeVarBindings masterClass: self masterClass. newTypeVarBindings := IT1TypeVariableScope outerScope: currentTypeVarBindings. typeVarNames with: args do: [:varName :arg | varVal := currentTypeEnvironment atTypeVarName: varName. varVal isNil ifTrue: [^self missingTypeVarDeclarationError: varName typeRep: elabContext typeRep]. match := varVal in: currentTypeEnvironment satisfiedBy: arg in: elabContext typeEnvironment matchContext: (IT1Inferencing typeRep: elabContext typeRep). match notNil ifTrue: [newTypeVarBindings addTypeVar: varName -> arg] ifFalse: [^nil]]. self updateTypeVariableScopeWith: newTypeVarBindings
</methods> <methods> ICC.IncrementalTypes.IT1ClassType <category>private</category>
typeVarDeclarationsInElaborationContext: elabContext "^<IT1TypeVariableScope | nil>" | associatedFullType newOuterScope | typeVariableScope isNil ifTrue: [(elabContext checkElaborationRecursionFor: self baseClass) ifTrue: [^nil] ifFalse: [associatedFullType := self associatedFullType. associatedFullType elaborateInContext: elabContext. newOuterScope := associatedFullType typeVarDeclarations. typeVariableScope := IT1TypeVariableScope outerScope: newOuterScope]]. ^typeVariableScope
updateTypeVariableScopeWith: aTypeVariableScope self typeVariableScope isEmpty ifTrue: [self typeVariableScope: aTypeVariableScope] ifFalse: [self typeVariableScope extendBy: aTypeVariableScope]
</methods> <methods> ICC.IncrementalTypes.IT1ClassType class <category>instance creation</category>
masterClass: aMasterClass baseClass: aBaseClass ^self masterClass: aMasterClass baseClass: aBaseClass meta: false
masterClass: aMasterClass baseClass: aBaseClass meta: aBoolean | obj | obj := self masterClass: aMasterClass. obj baseClass: aBaseClass. obj meta: aBoolean. ^obj
</methods> <methods> ICC.IncrementalTypes.IT1TypeVariable <category>accessing</category>
baseClass "Default baseClass" ^UndefinedObject
baseClassIn: aTypeEnvironment "^<Class>" ^aTypeEnvironment typeVarBaseClassOf: self typeVarName
meta ^meta
meta: aBoolean meta := aBoolean
typeVarName ^typeVarName
typeVarName: aString typeVarName := aString
typeVarTypeOf: aTypeVarName inEnvironment: aTypeEnvironment "^<ITTypeScheme> Basically, dereference myself and ask for aTypeVarName's value." | myValue | myValue := aTypeEnvironment typeVarTypeOf: self typeVarName. ^myValue typeVarTypeOf: aTypeVarName
</methods> <methods> ICC.IncrementalTypes.IT1TypeVariable <category>closure</category>
closureIn: aTypeEnvironment ^IT1TypeClosure typeScheme: self typeEnvironment: aTypeEnvironment
</methods> <methods> ICC.IncrementalTypes.IT1TypeVariable <category>testing</category>
hasTypeVarRecursion: aTypeVarName inElaborationContext: elabContext "^<Boolean> Note that due to the general assumption on absence of recursive type variable declarations, recursion over type variable bindings will be finite." (self typeVarName = aTypeVarName) ifTrue: [self recursiveTypeVariableDeclarationError: aTypeVarName inElaborationContext: elabContext. ^true] ifFalse: [^(elabContext typeEnvironment atTypeVarName: self typeVarName) typeScheme hasTypeVarRecursion: aTypeVarName inElaborationContext: elabContext]
isFree ^self typeVarName = 'free'
</methods> <methods> ICC.IncrementalTypes.IT1TypeVariable <category>compatibility</category>
in: myEnv satisfiedBy: aTypeScheme in: aTypeSchemeEnv matchContext: matchContext "^<ITMatchContext | nil> Note that in case that in case I am not free, current, instance or class, note a restricting binding in matchContext." | myVal match | aTypeScheme isFree ifTrue: [^matchContext]. myVal := myEnv atTypeVarName: self typeVarName. ^myVal isNil ifTrue: [self noValidTypeVariableValueError: matchContext typeRep] ifFalse: [match := myVal in: myEnv satisfiedBy: aTypeScheme in: aTypeSchemeEnv matchContext: matchContext. match notNil ifTrue: [(#('current' 'free' 'instance' 'class') includes: self typeVarName) ifFalse: [matchContext addTypeVarBinding: self typeVarName -> (IT1TypeClosure typeScheme: aTypeScheme typeEnvironment: aTypeSchemeEnv)]. matchContext] ifFalse: [nil]]
</methods> <methods> ICC.IncrementalTypes.IT1TypeVariable <category>error messages</category>
noValidTypeVariableValueError: typeRep typeRep addError: 'Type variable has invalid declaration.'. ^nil
recursiveTypeVariableDeclarationError: aTypeVarName inElaborationContext: elabContext elabContext typeRep addError: 'Recursion error in ''' , elabContext masterClassName , '''. Illegal recursive type binding of type variable ''' , aTypeVarName , '''.'. ^nil
</methods> <methods> ICC.IncrementalTypes.IT1TypeVariable <category>printing</category>
printNotationOn: aStream showNamespaces: aBoolean aStream nextPutAll: self typeVarName
</methods> <methods> ICC.IncrementalTypes.IT1TypeVariable class <category>instance creation</category>
masterClass: aMasterClass typeVarName: aTypeVarName | obj | obj := self masterClass: aMasterClass. obj typeVarName: aTypeVarName. obj meta: false. ^obj
</methods> <methods> ICC.IncrementalTypes.IT1TypeEnvironment <category>type variable properties</category>
atTypeVarName: aTypeVarName "^<TypeScheme | nil >" ^self typeVariableBindings atTypeVarName: aTypeVarName inEnvironment: self
isDefined: aTypeVarName "^<Boolean>" ^self typeVariableBindings isDefined: aTypeVarName
typeVarBaseClassOf: aTypeVarName "^<Class>" ^self typeVariableBindings baseClassOfTypeVar: aTypeVarName inEnvironment: self
typeVarTypeOf: aTypeVarName "^<ITTypeScheme | nil >" ^self typeVariableBindings typeVarTypeOf: aTypeVarName inEnvironment: self
</methods> <methods> ICC.IncrementalTypes.IT1TypeEnvironment <category>accessing</category>
masterClass ^masterClass
masterClass: aClass masterClass := aClass
meta ^meta
meta: aBoolean meta := aBoolean
</methods> <methods> ICC.IncrementalTypes.IT1TypeEnvironment <category>private</category>
typeVariableBindings ^typeVariableBindings
typeVariableBindings: aTypeVarScope typeVariableBindings := aTypeVarScope
</methods> <methods> ICC.IncrementalTypes.IT1TypeEnvironment class <category>instance creation</category>
closureOn: aTypeVarScope masterClass: aMasterClass ^self closureOn: aTypeVarScope masterClass: aMasterClass meta: false
closureOn: aTypeVarScope masterClass: aMasterClass meta: aBoolean | obj | obj := self new. obj typeVariableBindings: aTypeVarScope. obj masterClass: aMasterClass. obj meta: aBoolean. ^obj
</methods> <methods> ICC.IncrementalTypes.IT1TypeReport <category>adding-removing</category>
addAllErrors: aCollectionOfStrings aCollectionOfStrings do: [:each | self addError: each]
addError: aString | emptyLineString | emptyLineString := '\' withCRs. (aString = emptyLineString or: [(self errors includes: aString) not]) ifTrue: [errors add: aString]
errorsAddFirst: aString (self errors includes: aString) ifFalse: [errors addFirst: aString]
removeAllErrors: aCollectionOfStrings aCollectionOfStrings do: [:each | errors remove: each ifAbsent: []]
</methods> <methods> ICC.IncrementalTypes.IT1TypeReport <category>accessing</category>
errors errors isNil ifTrue: [errors := OrderedCollection new]. ^errors
errorText | aStream | aStream := (String new: 100) writeStream. self errors do: [:each | aStream nextPutAll: each; cr]. ^aStream contents
</methods> <methods> ICC.IncrementalTypes.IT1TypeReport <category>testing</category>
isEmpty ^self errors isEmpty
</methods> <methods> ICC.IncrementalTypes.IT1TypeReport <category>initialize-release</category>
reinitialize errors := nil
</methods> <methods> ICC.IncrementalTypes.IT1Context <category>accessing</category>
typeRep ^typeRep
typeRep: aTypeReport typeRep := aTypeReport
</methods> <methods> ICC.IncrementalTypes.IT1Context class <category>instance creation</category>
typeRep: aTypeReport ^self new typeRep: aTypeReport
</methods> <methods> ICC.IncrementalTypes.IT1FullType <category>accessing</category>
baseClass ^baseClass
baseClass: aClass baseClass := aClass
classType classType isNil ifTrue: [self elaborate]. ^classType
classType: aClassType classType := aClassType
clientRelationDeclarations "^<ITClientRelationScope | nil> Elaboration is triggered on demand." clientRelationDeclarations isNil ifTrue: [self elaborate]. ^clientRelationDeclarations
clientRelationDeclarations: aClientRelationDeclarations clientRelationDeclarations := aClientRelationDeclarations
clientRelationsOuterScope "^<ITClientRelationScope | nil>" ^self isRoot ifTrue: [nil] ifFalse: [self baseClass superclass clientRelationDeclarations]
typeDescriptor typeDescriptor isNil ifTrue: [typeDescriptor := IT1TypeDescriptor forFullType: self]. ^typeDescriptor
typeDescriptor: aTypeDescriptor typeDescriptor := aTypeDescriptor
typeEnvironment ^self classType typeEnvironment
typeRep ^self typeDescriptor typeRep
typeVarDeclarations "^<ITTypeVariableScope | nil>" ^self classType notNil ifTrue: [self classType typeVariableScope] ifFalse: [nil]
typeVarDeclarationsInElaborationContext: elabContext "^<ITTypeVariableScope | nil>" self elaborateInContext: elabContext. ^self typeVarDeclarations
typeVarOuterScope "^<ITTypeVariableScope | nil>" ^self isRoot ifTrue: [nil] ifFalse: [self baseClass superclass typeVarDeclarations]
</methods> <methods> ICC.IncrementalTypes.IT1FullType <category>private</category>
capitalizedFor: aString ^(aString at: 1) isUppercase ifTrue: [aString] ifFalse: [| result | result := aString copy. result at: 1 put: (result at: 1) asUppercase. result]
classDefinitionAlertFor: roleName implementation: implementation Dialog warn: ('Can''t create <1s> <2p>.<n>Check class-, superclass- and subclass definitions!' expandMacrosWith: (self itTypes class implementationStringFor: implementation) with: roleName) for: nil
mergeStrictValidityReports: aTypeReport | mySuperType | mySuperType := self superType. (mySuperType isNil and: [aTypeReport isNil]) ifTrue: [^IT1TypeReport new]. mySuperType isNil ifTrue: [^aTypeReport]. ^self strictValidityReportFrom: mySuperType strictValidityReport and: aTypeReport
typeFrom: aTypeString "^<ITTypeScheme> Build a type representation from aTypeString within the current context." ^IT1TypeElaboration elaborateParsedTypeExpression: (IT1VariableDeclarations new parseType: aTypeString) inClassContext: self baseClass
</methods> <methods> ICC.IncrementalTypes.IT1FullType <category>declarations</category>
checkCompatibilityOfClientRelation: aClientRelation "^<Boolean> Check if aClientRelation is not in conflict with an inherited declaration." | typeToBeCheckedAgainst check | typeToBeCheckedAgainst := self superType clientRelationTypeOf: aClientRelation roleName implementation: aClientRelation implementation. typeToBeCheckedAgainst isNil ifTrue: [^true] ifFalse: [check := typeToBeCheckedAgainst in: self typeEnvironment satisfiedBy: aClientRelation role in: self typeEnvironment matchContext: (IT1Inferencing typeRep: IT1TypeReport new). ^check notNil]
declareClientRelation: aRoleName role: aTypeString implementation: anImplementation explanation: anExplanation "^<current> aRoleName <String> aTypeString <String> describing the role of the client relation; any unbound references in the type string are resolved within my class context. anImplementation <Symbol> anExplanation <String | nil>" (self itTypes class varImplementationTypes includes: anImplementation) ifTrue: [self declareVarClientRelation: aRoleName role: aTypeString implementation: anImplementation explanation: anExplanation] ifFalse: [self declareNonVarClientRelation: aRoleName role: aTypeString implementation: anImplementation explanation: anExplanation]. self baseClass invalidateTypeDeclarations
declareNonVarClientRelation: aRoleName role: aTypeString implementation: implementation explanation: anExplanation "Declare a new client relation which is not implemented through an instance variable, check its consistency, and update the associated specification accordingly." | newClientRelation | newClientRelation := IT1ClientRelation roleContext: self baseClass roleName: aRoleName role: (self typeFrom: aTypeString) implementation: implementation explanation: anExplanation. self class errorSignal handle: [:ex | self classDefinitionAlertFor: aRoleName implementation: implementation. ex return] do: [(self checkCompatibilityOfClientRelation: newClientRelation) ifFalse: [self class compatibilityErrorSignal raise]. clientRelationDeclarations addClientRelation: newClientRelation. self updateClientRelationsSpec]
declareVarClientRelation: relationName role: typeString implementation: implementation explanation: comment "^<current> relationName <String> typeString <String> describing the role of the client relation; any unbound references in the type string are resolved within my class context. implementation <Symbol> comment <String | nil>" | theRelationName | theRelationName := implementation == #classVar ifTrue: [self capitalizedFor: relationName] ifFalse: [relationName]. ClassBuilder errorSignal handle: [:ex | self classDefinitionAlertFor: theRelationName implementation: implementation. ex return] do: [self adBasics systemOrganization addVariableNamed: theRelationName to: self baseClass implementation: implementation. (IT1VariableDeclarations on: self baseClass) declareVariable: theRelationName role: typeString implementation: implementation explanation: comment]
removeClientRelation: aRoleName implementation: anImplementation (self itTypes class varImplementationTypes includes: anImplementation) ifTrue: [self removeVarClientRelation: aRoleName implementation: anImplementation] ifFalse: [self removeNonVarClientRelation: aRoleName implementation: anImplementation]. self baseClass invalidateTypeDeclarations
removeNonVarClientRelation: aRoleName implementation: anImplementation self clientRelationDeclarations removeClientRelation: aRoleName implementation: anImplementation. self updateClientRelationsSpec
removeVarClientRelation: aRoleName implementation: implementation ClassBuilder errorSignal handle: [:ex | self classDefinitionAlertFor: aRoleName implementation: implementation. ex return] do: [self adBasics systemOrganization removeVariableNamed: aRoleName from: self baseClass implementation: implementation. (IT1VariableDeclarations on: self baseClass) removeVariable: aRoleName implementation: implementation]
</methods> <methods> ICC.IncrementalTypes.IT1FullType <category>variable values</category>
clientRelationTypeOf: aRoleName implementation: anImplementation "^<ITTypeScheme | nil> Triggers elaboration of declarations if necessary." | clientRelationDecls | clientRelationDecls := self clientRelationDeclarations. ^clientRelationDecls isNil ifTrue: [nil] ifFalse: [clientRelationDecls atRoleName: aRoleName implementation: anImplementation inEnvironment: self classType typeEnvironment]
locallyDefinedClientRelationsOfImplementation: anImplementation "^<Set of: String> Return all class instance variable names which have been defined within the local scope of the base class." | clientRelationDecls | clientRelationDecls := self clientRelationDeclarations. ^clientRelationDecls isNil ifTrue: [Set new] ifFalse: [clientRelationDecls locallyDefinedClientRelationsOfImplementation: anImplementation]
locallyDefinedClientRelationTypeOf: aRoleName implementation: anImplementation "^<ITTypeScheme | nil> Triggers elaboration of declarations if necessary." | clientRelationDecls | clientRelationDecls := self clientRelationDeclarations. ^clientRelationDecls isNil ifTrue: [nil] ifFalse: [clientRelationDecls atLocallyDefinedRoleName: aRoleName ofImplementation: anImplementation inEnvironment: self classType typeEnvironment]
</methods> <methods> ICC.IncrementalTypes.IT1FullType <category>elaboration</category>
completeElaboration: aTypeReport "From superclass strict validity and local validity information, construct a new strict validity report. At this point it is assumed that a superType has been fully elaborated." | aStrictValidityReport | aStrictValidityReport := self mergeStrictValidityReports: aTypeReport. self strictValidityReport: (self strictValidityReportFrom: aStrictValidityReport and: self localValidityReport)
elaborate "^<ITFullType> Trigger the elaboration of declarations. This is the entry point for a sequence of elaborations." self isElaborated ifTrue: [^self]. ^self elaborateInContext: nil
elaborateInContext: anElaborationContext "^<ITFullType> Trigger the elaboration of declarations in a specific context. This elaboration is always successful." ^self isElaborated ifTrue: [self] ifFalse: [IT1TypeElaboration new elaborateFullType: self inContext: anElaborationContext]
invalidateClientRelationsDeclaration "^<Boolean> Note that interface specifications are not affected." | result | (result := self isElaborated) ifTrue: [self classType: nil. self clientRelationDeclarations: nil. self typeDescriptor: nil]. ^result
superType "^<ITFullType |nil>" ^self isRoot ifTrue: [nil] ifFalse: [self itTypes fullTypeOfClass: self baseClass superclass]
superTypeClosureInContext: aTypeElaboration "^<ITFullType>" | fullSuperType | self isRoot ifTrue: [^self] ifFalse: [fullSuperType := self superType. fullSuperType elaborateInContext: aTypeElaboration]
typeVarElaborationValue: aTypeVarScope clientRelationElaborationValue: aClientRelationScope "Sending this message means that the full type has been successfully elaborated. Thus, create its associated type scheme." self classType: (IT1ClassType masterClass: self baseClass baseClass: self baseClass). self classType typeVariableScope: aTypeVarScope. self clientRelationDeclarations: aClientRelationScope
</methods> <methods> ICC.IncrementalTypes.IT1FullType <category>validity</category>
fullValidityReport "^<IT1TypeReport>" | resultReport localValidityReport nonlocalValidityReport | resultReport := IT1TypeReport new. localValidityReport := self localValidityReport. nonlocalValidityReport := self nonlocalValidityReport. localValidityReport isEmpty ifFalse: [resultReport addError: self localValidityErrorsHeader; addAllErrors: localValidityReport errors]. nonlocalValidityReport isEmpty ifFalse: [resultReport isEmpty ifFalse: [resultReport addError: '\' withCRs]. resultReport addError: self nonlocalValidityErrorsHeader; addAllErrors: nonlocalValidityReport errors]. resultReport addError: '\\' withCRs. ^resultReport
localValidityReport ^self typeDescriptor localValidityReport
localValidityReport: aTypeReport self typeDescriptor localValidityReport: aTypeReport
nonlocalValidityReport "^<IT1TypeReport> Answer the strictValidityReport with local errors removed." ^IT1TypeReport new addAllErrors: self strictValidityReport errors; removeAllErrors: self localValidityReport errors; yourself
strictValidityReport ^self typeDescriptor strictValidityReport
strictValidityReport: aTypeReport self typeDescriptor strictValidityReport: aTypeReport
strictValidityReportFrom: aStrictValidityReport and: aLocalValidityReport "^<IT1TypeReport>" aStrictValidityReport addAllErrors: aLocalValidityReport errors. ^(IT1TypeReport new) addAllErrors: aStrictValidityReport errors; yourself
</methods> <methods> ICC.IncrementalTypes.IT1FullType <category>testing</category>
isElaborated ^classType notNil
isLocallyValid ^self typeDescriptor isLocallyValid
isRoot ^self baseClass superclass isNil
isStrictlyValid ^self typeDescriptor isStrictlyValid
</methods> <methods> ICC.IncrementalTypes.IT1FullType <category>IT-API</category>
itTypes ^self class itTypes
</methods> <methods> ICC.IncrementalTypes.IT1FullType <category>private-validity</category>
localValidityErrorsHeader ^('Declaration errors in class <1p>:<n>' expandMacrosWith: self baseClass printString) , self separatorLine
nonlocalValidityErrorsHeader ^('Declaration errors related to class <1p>:<n>' expandMacrosWith: self baseClass printString) , self separatorLine
separatorLine ^'--------------------------------------------------------------------------------'
</methods> <methods> ICC.IncrementalTypes.IT1FullType <category>specifications</category>
migrateToITClientRelationSpec "^<Boolean> Generate a method answering the client relation spec. Answers true if method creation was successfull." | newMethodName oldMethodName oldMethodSource newMethodSource | newMethodName := #itClientRelationsSpec. oldMethodName := #clientRelationsSpec. (Dialog confirm: 'Incompatible Relation Spec for Class ', self baseClass fullName, ' detected. Perform migration to current format?\If you choose ''no'', the client relations may not be visible.' withCRs) ifTrue: [ oldMethodSource := (self baseClass class findSelector: oldMethodName) last getSource. newMethodSource := oldMethodSource copy. (Array with: (Array with: oldMethodName asString with: newMethodName asString) with: #('{ICC.ADvance.IT1ClientRelationScope}' '{ICC.IncrementalTypes.IT1ClientRelationScope}') with: #('{ICC.ADvance.IT1ClientRelation}' '{ICC.IncrementalTypes.IT1ClientRelation}')) do: [:eachPair | newMethodSource := newMethodSource copyReplaceAll: eachPair first with: eachPair last]. self baseClass class compile: newMethodSource classified: 'client relation specs'. self baseClass class removeSelector: oldMethodName]. ^self baseClass class includesSelector: newMethodName
nonVarClientRelations "^<OrderedCollection of: ITClientRelation> Retrieve itClientRelationsSpec from associated base class and build clientRelations from it. If such a spec does not exist but an older clientRelationsSpec does, user is asked whether migration shall be done." ^((self baseClass class includesSelector: #itClientRelationsSpec) or: [(self baseClass class includesSelector: #clientRelationsSpec) and: [self migrateToITClientRelationSpec]]) ifTrue: [self baseClass itClientRelationsSpec clientRelations] ifFalse: [OrderedCollection new]
updateClientRelationsSpec "For all non-variable client relation specs, create a new specification." clientRelationDeclarations save
</methods> <methods> ICC.IncrementalTypes.IT1FullType class <category>instance creation</category>
baseClass: aClass "^<ITFullType> Create a new full type and elaborate it in a liberal way." ^self new baseClass: aClass; yourself
</methods> <methods> ICC.IncrementalTypes.IT1FullType class <category>Signal constants</category>
compatibilityErrorSignal ^CompatibilityErrorSignal
</methods> <methods> ICC.IncrementalTypes.IT1FullType class <category>class initialization</category>
initialize "self initialize" CompatibilityErrorSignal := (Object errorSignal newSignalMayProceed: true) notifierString: 'Type compatibility error'; nameClass: self message: #errorSignal; yourself
</methods> <methods> ICC.IncrementalTypes.IT1TypeElaboration <category>validity</category>
addStrictValidityErrors: errors self strictValidityReport addAllErrors: errors
strictValidityReport strictValidityReport isNil ifTrue: [strictValidityReport := IT1TypeReport new]. ^strictValidityReport
updateStrictValidityReport: aTypeRep aTypeRep isNil ifFalse: [self addStrictValidityErrors: aTypeRep errors]
</methods> <methods> ICC.IncrementalTypes.IT1TypeElaboration <category>accessing</category>
baseClass ^self fullType baseClass
clientRelationDeclarations ^clientRelationDeclarations
clientRelationDeclarations: aClientRelationScope clientRelationDeclarations := aClientRelationScope
elaborationHistory ^elaborationHistory
fullType ^fullType
fullType: aFullType fullType := aFullType
infoString "Return the string this program will extract type information from." ^self masterClass infoString
localValidityReport ^localValidityReport
masterClass ^self fullType baseClass
masterClassName ^self masterClass name asString
typeEnvironment ^typeEnvironment
typeRep ^self localValidityReport
typeVarDeclarations ^typeVarDeclarations
typeVarDeclarations: aTypeVariableScope typeVarDeclarations := aTypeVariableScope
</methods> <methods> ICC.IncrementalTypes.IT1TypeElaboration <category>class elaboration</category>
checkElaborationRecursionFor: aClass "^<Boolean> Check if aClass is mentioned in my elab history." | hasRecursion | hasRecursion := self elaborationHistory contains: [:each | aClass includesBehavior: each baseClass]. hasRecursion ifTrue: [self classDeclarationRecursionError]. ^hasRecursion
checkForClassElaborationRecursionInContext: elabContext "^<Boolean> Check if I am evaluating a class recursively." | mc hasRecursion | elabContext isNil ifTrue: [^false]. mc := self baseClass. hasRecursion := elabContext elaborationHistory contains: [:each | mc includesBehavior: each baseClass]. hasRecursion ifTrue: [self classDeclarationRecursionError]. ^hasRecursion
elaborate "^<ITFullType> Elaborate my variable declarations and create appropriate semantics." self elaborateTypeVariables. self elaborateStateVariables. self elaborateInheritedStateVariables. self elaborateClientRelationsSpec. self fullTypeCompletion. ^self fullType
elaborateClientRelationsSpec self createNonVarClientRelationsSemantics. self typeRep isEmpty ifTrue: [^self]. self nonVarClientRelationsError. self fullTypeLocalValidityUpdate
elaborateInheritedStateVariables "Define semantics for those inherited variable declarations found. Semantics is defined independent of inconsistencies possibly found." | analyzer cmt | analyzer := IT1VariableDeclarations on: self masterClass. cmt := self infoString. analyzer checkInheritedVars: cmt typeRep: self typeRep. self typeRep isEmpty ifFalse: [self inheritedStateVariableDeclarationSyntaxError. self fullTypeLocalValidityUpdate]. self createInheritedStateVarSemantics: analyzer. self typeRep isEmpty ifTrue: [^self]. self inheritedStateVariableDeclarationSemanticsError. self fullTypeLocalValidityUpdate
elaborateStateVariables "Define semantics for those state variable declarations found. Semantics is defined independent of inconsistencies possibly found." | cmt analyzer | cmt := self infoString. analyzer := IT1VariableDeclarations on: self masterClass. analyzer checkVars: cmt typeRep: self typeRep. self typeRep isEmpty ifFalse: [self stateVariableDeclarationSyntaxError. self fullTypeLocalValidityUpdate]. self createStateVarSemantics: analyzer. self typeRep isEmpty ifTrue: [^self]. self stateVariableDeclarationSemanticsError. self fullTypeLocalValidityUpdate
elaborateTypeVariables "Define semantics for those type variable declarations found. Semantics is defined independent of inconsistencies possibly found." | analyzer | (self fullType baseClass class includesSelector: #genericTypeConstructors) ifFalse: [^self]. analyzer := IT1VariableDeclarations on: self masterClass. analyzer checkTypeVars: self fullType baseClass genericTypeConstructors typeRep: self typeRep. self typeRep isEmpty ifFalse: [self typeVariableDeclarationSyntaxError. self fullTypeLocalValidityUpdate]. self createTypeVarSemantics: analyzer typeVars. self typeRep isEmpty ifTrue: [^self]. self typeVariableDeclarationSemanticsError. self fullTypeLocalValidityUpdate
elaborationHistoryFrom: aTypeElaboration aTypeElaboration isNil ifTrue: [elaborationHistory := OrderedCollection new] ifFalse: [elaborationHistory := aTypeElaboration elaborationHistory copy. elaborationHistory add: self fullType]
fullTypeCompletion "Complete definition of full type, including completeness information." self fullType typeVarElaborationValue: self typeVarDeclarations clientRelationElaborationValue: self clientRelationDeclarations. self fullType completeElaboration: self strictValidityReport
</methods> <methods> ICC.IncrementalTypes.IT1TypeElaboration <category>error messages</category>
classDeclarationRecursionError self typeRep addError: 'Recursion error: ''' , self masterClassName , ''' is referring (in-)directly to itself.'. ^nil
inheritedStateVariableDeclarationError: anImplementation var: varName self typeRep addError: ('<1s> <2p> in class <3p> is defined without superclass definition.' expandMacrosWith: (self itTypes class implementationStringFor: anImplementation) with: varName with: self masterClassName). ^nil
inheritedStateVariableDeclarationSemanticsError self typeRep errorsAddFirst: 'Error occured during creation of inherited state variable semantics for class ''' , self masterClassName , '''.'. ^nil
inheritedStateVariableDeclarationSyntaxError self typeRep addError: 'Syntax error in inherited state variable declarations of class ''' , self masterClassName , '''.'. ^nil
nonVarClientRelationsError self typeRep addError: 'There is an incompatibility for query client relations with supertype definitions.'. ^nil
notAValidTypeError: aName self typeRep addError: '''' , aName , ''' is neither an existing type nor a valid type variable name.'
stateVariableDeclarationError: anImplementation var: varName self typeRep addError: (self itTypes class implementationStringFor: anImplementation) , ' ''' , varName , ''' in class ''' , self masterClassName , ''' is not properly declared.'. ^nil
stateVariableDeclarationSemanticsError self typeRep errorsAddFirst: 'Error occured during state variable semantics creation for class ''' , self masterClassName , '''.'. ^nil
stateVariableDeclarationSyntaxError self typeRep addError: 'Syntax error in state variable declarations of class ''' , self masterClassName , '''.'. ^nil
typeVariableDeclarationError: varName self typeRep addError: 'Type variable ''', varName , ''' in class ''' , self masterClassName , ''' is not properly declared.'. ^nil
typeVariableDeclarationSemanticsError self typeRep errorsAddFirst: 'Error occured during type variable semantics creation for class ''' , self masterClassName , '''.'. ^nil
typeVariableDeclarationSyntaxError self typeRep addError: 'Syntax error in type variable declarations of class ''' , self masterClassName , '''.'. ^nil
</methods> <methods> ICC.IncrementalTypes.IT1TypeElaboration <category>initialize-release</category>
clientRelationsOuterScope ^self fullType clientRelationsOuterScope
elaborateFullType: aFullType inContext: aTypeElaboration "^<ITFullType> Stop elaboration if there is a recursion error. Otherwise, trigger elaboration of a type's supertypes. Note that initialization of my own state and type variable declarations refers to supertype declarations." fullType := aFullType. localValidityReport := IT1TypeReport new. self elaborationHistoryFrom: aTypeElaboration. (self checkForClassElaborationRecursionInContext: aTypeElaboration) ifTrue: [aTypeElaboration updateStrictValidityReport: self typeRep. ^aFullType]. aFullType superTypeClosureInContext: self. self initializeDeclarationScope. typeEnvironment := self makeTypeEnvironment. ^self elaborate
initializeDeclarationScope self clientRelationDeclarations: (IT1ClientRelationScope outerScope: self clientRelationsOuterScope localScope: self fullType baseClass). self typeVarDeclarations: (IT1TypeVariableScope outerScope: self typeVarOuterScope)
makeTypeEnvironment ^IT1TypeEnvironment closureOn: self typeVarDeclarations masterClass: self masterClass
typeVarOuterScope ^self fullType typeVarOuterScope
</methods> <methods> ICC.IncrementalTypes.IT1TypeElaboration <category>semantics creation</category>
createInheritedStateVarSemantics: analyzer "analyzer <OrderedCollection of: (Association key: String value: ProgramNode)>" | vars | vars := self redefineSemanticsFor: #inheritedInstVar redefiningVars: analyzer inheritedInstVars stateVars: self clientRelationDeclarations instVars. self clientRelationDeclarations inheritedInstVars: vars. vars := self redefineSemanticsFor: #inheritedClassInstVar redefiningVars: analyzer inheritedClassInstVars stateVars: self clientRelationDeclarations classInstVars. self clientRelationDeclarations inheritedClassInstVars: vars
createNonVarClientRelationsSemantics | myNonVarClientRelations | myNonVarClientRelations := self fullType nonVarClientRelations. myNonVarClientRelations do: [:each | each checkCompatibilityInContext: self fullType typeRep: self typeRep]. self clientRelationDeclarations addClientRelations: myNonVarClientRelations
createSemanticsFor: implementation varDefs: stateVars "^<OrderedCollection of: (Association key: String value: (ITTypeScheme | nil))> For every variable which has been found declared, a semantics is created -- possibly nil." ^stateVars collect: [:assoc | | sem varName typeExpr | varName := assoc key. typeExpr := assoc value. sem := nil. typeExpr notNil ifTrue: [sem := typeExpr typeSemanticsInElaborationContext: self. sem isNil ifTrue: [self stateVariableDeclarationError: implementation var: varName]]. varName -> sem]
createStateVarSemantics: analyzer "analyzer <OrderedCollection of: (Association key: String value: ProgramNode)>" self clientRelationDeclarations instVars: (self createSemanticsFor: #instVar varDefs: analyzer instVars); classVars: (self createSemanticsFor: #classVar varDefs: analyzer classVars); classInstVars: (self createSemanticsFor: #classInstVar varDefs: analyzer classInstVars)
createTypeVarSemantics: typeVars "^<current> typeVars <OrderedCollection of: (Association key: String value: ProgramNode)> If necessary, a new scope for type variable declarations is created. Note that in case of type variable recursion, semantics is undefined." | varName sem outerScopeVal match typeExpr | typeVars isEmpty ifTrue: [^self]. typeVars do: [:assoc | varName := assoc key. typeExpr := assoc value. sem := typeExpr typeSemanticsInElaborationContext: self. sem notNil ifTrue: [(sem hasTypeVarRecursion: varName inElaborationContext: self) ifTrue: [sem := nil] ifFalse: [outerScopeVal := self typeEnvironment atTypeVarName: varName. outerScopeVal notNil ifTrue: [match := outerScopeVal in: self typeEnvironment satisfiedBy: sem in: self typeEnvironment matchContext: (IT1Inferencing typeRep: self typeRep). match isNil ifTrue: [self typeVariableDeclarationError: varName]]]] ifFalse: [self typeVariableDeclarationError: varName]. self typeVarDeclarations addTypeVar: varName -> sem]
redefineSemanticsFor: implementation redefiningVars: redefinedVars stateVars: stateVars "^<OrderedCollection of: (Association key: String value: (ITTypeScheme | nil))> " ^redefinedVars collect: [:assoc | | sem varName typeExpr | varName := assoc key. typeExpr := assoc value. sem := nil. typeExpr notNil ifTrue: [sem := typeExpr typeSemanticsInElaborationContext: self. sem isNil ifTrue: [self stateVariableDeclarationError: implementation var: varName] ifFalse: [(implementation == #inheritedInstVar ifTrue: [self clientRelationDeclarations atRoleName: varName baseImplementation: #instVar inEnvironment: self typeEnvironment] ifFalse: [self clientRelationDeclarations atRoleName: varName baseImplementation: #classInstVar inEnvironment: self typeEnvironment]) isNil ifTrue: [sem := nil. self inheritedStateVariableDeclarationError: implementation var: varName]]]. varName -> sem]
</methods> <methods> ICC.IncrementalTypes.IT1TypeElaboration <category>type expression elaboration</category>
elaborateParsedTypeExpression: aParseNode inClassContext: aClass "^<ITTypeScheme|nil>" fullType := self itTypes fullTypeOfClass: aClass. localValidityReport := IT1TypeReport new. self elaborationHistoryFrom: nil. self typeVarDeclarations: (IT1TypeVariableScope outerScope: self typeVarOuterScope). typeEnvironment := IT1TypeEnvironment closureOn: self typeVarDeclarations masterClass: self masterClass. ^aParseNode typeSemanticsInElaborationContext: self
</methods> <methods> ICC.IncrementalTypes.IT1TypeElaboration <category>private</category>
fullTypeLocalValidityUpdate self fullType localValidityReport addAllErrors: self localValidityReport errors. self localValidityReport reinitialize
</methods> <methods> ICC.IncrementalTypes.IT1TypeElaboration <category>testing</category>
isDefined: aTypeVarName ^self typeEnvironment isDefined: aTypeVarName
</methods> <methods> ICC.IncrementalTypes.IT1TypeElaboration <category>IT-API</category>
itTypes ^self class itTypes
</methods> <methods> ICC.IncrementalTypes.IT1TypeElaboration class <category>instance creation</category>
elaborateParsedTypeExpression: aParseNode inClassContext: aClass ^self new elaborateParsedTypeExpression: aParseNode inClassContext: aClass
forFullType: aFullType ^self new fullType: aFullType
</methods> <methods> ICC.IncrementalTypes.IT1VariableDeclarations <category>private-checking</category>
checkClassInstVars: cmt typeRep: typeRep self getClassInstVars: cmt. ^self checkVars: self definedClassInstVarNames heading: 'Class Instance' against: self declaredClassInstVars typeRep: typeRep
checkClassVars: cmt typeRep: typeRep self getClassVars: cmt. ^self checkVars: self definedClassVarNames heading: 'Class' against: self declaredClassVars typeRep: typeRep
checkInstVars: cmt typeRep: typeRep self getInstVars: cmt. ^self checkVars: self definedInstVarNames heading: 'Instance' against: self declaredInstVars typeRep: typeRep
checkVars: vars heading: aString against: found typeRep: typeRep | lcname foundVars missing | lcname := aString asLowercase. vars isEmpty ifTrue: [^(found isNil or: [found isEmpty]) ifTrue: [#()] ifFalse: [typeRep addError: class name , ' has no ' , lcname , ' variables, but it has a comment describing them.']]. found isNil ifTrue: [vars size = 1 ifTrue: [^typeRep addError: class name , ' has ' , vars size printString , ' ' , lcname , ' variable, but no comment describing it.'] ifFalse: [^typeRep addError: class name , ' has ' , vars size printString , ' ' , lcname , ' variables, but no comment describing them.']]. foundVars := found collect: [:vt | vt key]. missing := vars select: [:v | (foundVars includes: v) not]. missing isEmpty ifFalse: [missing size = 1 ifTrue: [typeRep addError: 'There is no description of the ' , lcname , ' variable ' , (missing at: 1) printString , '.'] ifFalse: [typeRep addError: 'There is no description of the ' , lcname , ' variables ' , missing printString , '.']]. missing := foundVars select: [:v | (vars includes: v) not]. missing isEmpty ifFalse: [missing size = 1 ifTrue: [typeRep addError: 'There is a description of a non-existent ' , lcname , ' variable ' , (missing at: 1) printString , '.'] ifFalse: [typeRep addError: 'There are descriptions of non-existent ' , lcname , ' variables ' , missing printString , '.']]. self checkSyntaxOfVars: vars in: found typeRep: typeRep
</methods> <methods> ICC.IncrementalTypes.IT1VariableDeclarations <category>checking</category>
checkInheritedVars: cmt typeRep: typeRep | varNames | self getInheritedInstVars: cmt. varNames := self inheritedInstVars collect: [:ivar | ivar key]. self checkSyntaxOfVars: varNames in: self inheritedInstVars typeRep: typeRep. self getInheritedClassInstVars: cmt. varNames := self inheritedClassInstVars collect: [:ivar | ivar key]. self checkSyntaxOfVars: varNames in: self inheritedClassInstVars typeRep: typeRep
checkTypeVars: cmt typeRep: typeRep | tVarNames | self getTypeVars: cmt. tVarNames := typeVars collect: [:tvar | tvar key]. ^self checkSyntaxOfVars: tVarNames in: typeVars typeRep: typeRep
checkVars: cmt typeRep: typeRep "^<current>" "Note that class instance variable definitions are not crossChecked with existing definitions." self checkInstVars: cmt typeRep: typeRep. self checkClassVars: cmt typeRep: typeRep. self checkClassInstVars: cmt typeRep: typeRep
</methods> <methods> ICC.IncrementalTypes.IT1VariableDeclarations <category>private</category>
checkSyntaxOfVars: vars in: found typeRep: typeRep found do: [:vt | (vars includes: vt key) ifTrue: [vt value isNil ifTrue: [typeRep addError: ('The description of <1s> has a syntax error.' expandMacrosWith: vt key)]]]
declaredClassInstVars ^self classInstVars select: [:each | each value notNil]
declaredClassVars ^self classVars select: [:each | each value notNil]
declaredInstVars ^self instVars select: [:each | each value notNil]
definedClassInstVarNames ^class class instVarNames
definedClassVarNames ^class classVarNames asSortedCollection asArray collect: [:each | each asString]
definedInstVarNames ^class instVarNames
</methods> <methods> ICC.IncrementalTypes.IT1VariableDeclarations <category>accessing</category>
class: aClass class := aClass
classInstVars ^classInstVars
classVars ^classVars
infoString "Return the string this program will extract type information from." ^class infoString
infoString: aString "Change the string this program will extract type information from." class infoString: aString
inheritedClassInstVars ^inheritedClassInstVars
inheritedInstVars ^inheritedInstVars
instVars ^instVars
typeVars ^typeVars
</methods> <methods> ICC.IncrementalTypes.IT1VariableDeclarations <category>private-support</category>
classInstanceVariableDeclarationHeader ^'Class Instance Variable'
classVariableDeclarationHeader ^'Class Variable'
inheritedClassInstanceVariableDeclarationHeader ^'Inherited Class Instance Variable'
inheritedInstanceVariableDeclarationHeader ^'Inherited Instance Variable'
instanceVariableDeclarationHeader ^'Instance Variable'
</methods> <methods> ICC.IncrementalTypes.IT1VariableDeclarations <category>declaration update</category>
declareVariable: aVariableName role: aTypeString implementation: anImplementation explanation: anExplanation "Update the declaration of aVariableName with aTypeString and anExplanation. If there is no variable declaration, take appropriate measures." | infoString explanation aDeclarationHeader position entry infoStream extendedTypeString | infoString := self infoString. explanation := anExplanation isNil ifTrue: [String new] ifFalse: [anExplanation copy replaceAll: Character cr with: Character space]. aDeclarationHeader := self itTypes class implementationStringFor: anImplementation. extendedTypeString := '<' , aTypeString , '>'. position := self variableDeclarationOf: aVariableName in: infoString readStream declarationHeader: aDeclarationHeader. position isNil ifTrue: [entry := self positionAfterHeading: aDeclarationHeader in: infoString readStream. entry isNil ifTrue: [infoStream := WriteStream with: self infoString. infoStream cr; cr; nextPutAll: aDeclarationHeader , 's:'; crtab] ifFalse: [infoStream := WriteStream with: self infoString from: 1 to: entry. infoStream tab]. infoStream nextPutAll: aVariableName; space; tab; nextPutAll: extendedTypeString; space; nextPutAll: explanation. entry notNil ifTrue: [infoStream nextPutAll: (infoString copyFrom: entry to: infoString size)]] ifFalse: [infoStream := WriteStream with: self infoString from: 1 to: (position at: 1). "infoStream setToEnd." infoStream nextPutAll: extendedTypeString; space; nextPutAll: explanation. infoStream cr; nextPutAll: (infoString readStream position: (position at: 3); upToEnd)]. self adBasics systemOrganization setComment: infoStream contents for: class
removeVariable: aVariableName implementation: anImplementation "Remove the declaration of aVariableName, if present. If there is no variable declaration, do nothing." | infoString aDeclarationHeader position infoStream skippedTo | infoString := self infoString. aDeclarationHeader := self itTypes class implementationStringFor: anImplementation. position := self linestartOfVariable: aVariableName in: infoString readStream declarationHeader: aDeclarationHeader. position isNil ifTrue: [^self]. infoStream := WriteStream with: self infoString from: 1 to: position - 1. skippedTo := self nextCRIn: infoString startingAt: position. skippedTo isNil ifFalse: [infoStream nextPutAll: (infoString copyFrom: skippedTo + 1 to: infoString size)]. self infoString: infoStream contents
</methods> <methods> ICC.IncrementalTypes.IT1VariableDeclarations <category>private-declaration update</category>
explanationOf: aVariableName declarationHeader: aDeclarationHeader "^<String | nil>" | answer i scan | scan := self infoString readStream. answer := self variableDeclarationOf: aVariableName in: scan declarationHeader: aDeclarationHeader. answer isNil ifTrue: [^nil]. i := (answer at: 2) isNil ifTrue: [1] ifFalse: [2]. scan position: (answer at: i). scan skipSeparators. "Preeceding spaces are cut of, otherwise they would become multiplied in subsequent save actions." ^((answer at: 3) > scan position) ifTrue: [scan next: (answer at: 3) - (scan position + 1)] ifFalse: ['']
findVariableDeclarationOf: aVarName in: scan "^<(Array of: (Integer|nil) size: 3)|nil> scan <ReadStream> Parse variable declarations from current scan position up to either the end of the stream, or a blank line followed by a line that does not begin with a space or tab. The answer contains the first and last position of the type declaration <...>, and the last position of a following explanation. If there is no declaration, answer nil." | positions linePositionInScan | positions := Array new: 3. [scan atEnd] whileFalse: [scan peek = Character cr ifTrue: [scan next. (scan atEnd or: [scan peek isSeparator not]) ifTrue: [^nil]] ifFalse: [| line vname type parens | scan skipSeparators. scan atEnd ifTrue: [^nil]. linePositionInScan := scan position. line := (scan upTo: Character cr) readStream. vname := String new writeStream. parens := line atEnd not and: [line peek = $(]. [line atEnd not and: [parens ifTrue: [line peek = $) ifTrue: [parens := false]. true] ifFalse: [line peek isSeparator not]]] whileTrue: [vname nextPut: line next]. vname contents = aVarName ifTrue: [line skipSeparators. positions at: 1 put: line position + linePositionInScan. positions at: 3 put: scan position. (line next = $< and: [type := line through: $>. ["Special hack for embedded ->" type size >= 2 and: [type last = $> and: [(type at: type size - 1) = $-]]] whileTrue: [type := type , (line through: $>)]. type size > 1 and: [type last = $>]]) ifTrue: [positions at: 2 put: line position + linePositionInScan]. ^positions]]]. ^nil
linestartOfVariable: aVarName in: scan "^<Integer | nil> scan <ReadStream> Parse variable declarations from current scan position up to either the end of the stream, or a blank line followed by a line that does not begin with a space or tab. The answer contains the position of the line containing the declaration of aVarName. If there is no declaration, answer nil." | position | [scan atEnd] whileFalse: [scan peek = Character cr ifTrue: [scan next. (scan atEnd or: [scan peek isSeparator not]) ifTrue: [^nil]] ifFalse: [| line vname type parens | position := scan position + 1. scan skipSeparators. scan atEnd ifTrue: [^nil]. line := (scan upTo: Character cr) readStream. vname := String new writeStream. parens := line atEnd not and: [line peek = $(]. [line atEnd not and: [parens ifTrue: [line peek = $) ifTrue: [parens := false]. true] ifFalse: [line peek isSeparator not]]] whileTrue: [vname nextPut: line next]. vname contents = aVarName ifTrue: [line skipSeparators. line next = $< and: [type := line through: $>. ["Special hack for embedded ->" type size >= 2 and: [type last = $> and: [(type at: type size - 1) = $-]]] whileTrue: [type := type , (line through: $>)]. type size > 1 and: [type last = $>]]. ^position]]]. ^nil
linestartOfVariable: anInstVarName in: scan declarationHeader: aDeclarationHeader "^<(Array of: (Integer|nil) size: 3)|nil> Parse variable declarations from current scan position up to either the end of the stream, or a blank line followed by a line that does not begin with a space or tab. Answer an array with the first and last position of the type declaration <...> of anInstVarName. If there is no declaration, answer nil." | res | res := self findHeading: aDeclarationHeader in: scan. ^res ifTrue: [self linestartOfVariable: anInstVarName in: scan] ifFalse: [nil]
nextCRIn: aString startingAt: aPosition "^<Integer|nil>" ^aString nextIndexOf: Character cr from: aPosition to: aString size
positionAfterHeading: aString in: scan "^<Integer|nil>" ^(self findHeading: aString in: scan) ifTrue: [scan position] ifFalse: [nil]
variableDeclarationOf: anInstVarName in: scan declarationHeader: aDeclarationHeader "^<(Array of: (Integer|nil) size: 3)|nil> Parse variable declarations from current scan position up to either the end of the stream, or a blank line followed by a line that does not begin with a space or tab. Answer an array with the first and last position of the type declaration <...> of anInstVarName. If there is no declaration, answer nil." | res | res := self findHeading: aDeclarationHeader in: scan. ^res ifTrue: [self findVariableDeclarationOf: anInstVarName in: scan] ifFalse: [nil]
</methods> <methods> ICC.IncrementalTypes.IT1VariableDeclarations <category>private-parsing</category>
findDeclarations: aString in: scan "Find and parse those declarations into an array which are listed under aString." ^(self findHeading: aString in: scan) ifTrue: [self parseVars: scan] ifFalse: [Array new]
findHeading: headString in: scan "Try to find headString: or headStrings: ." | cr | cr := Character cr. [scan atEnd] whileFalse: [| line | line := (scan upTo: cr) readStream. ((line nextAvailable: headString size) sameAs: headString) ifTrue: [line peekFor: $s. (line peekFor: $:) ifTrue: [line skipSeparators]. ^line atEnd]]. ^false
getClassInstVars: cmt | declarations | declarations := self findDeclarations: self classInstanceVariableDeclarationHeader in: cmt readStream. classInstVars := self definedClassInstVarNames collect: [:each | declarations detect: [:eachAssoc | each = eachAssoc key] ifNone: [each -> nil]]
getClassVars: cmt | declarations | declarations := self findDeclarations: self classVariableDeclarationHeader in: cmt readStream. classVars := self definedClassVarNames collect: [:each | declarations detect: [:eachAssoc | each asString = eachAssoc key] ifNone: [each -> nil]]
getInheritedClassInstVars: cmt inheritedClassInstVars := self findDeclarations: self inheritedClassInstanceVariableDeclarationHeader in: cmt readStream
getInheritedInstVars: cmt inheritedInstVars := self findDeclarations: self inheritedInstanceVariableDeclarationHeader in: cmt readStream
getInstVars: cmt | declarations | declarations := self findDeclarations: self instanceVariableDeclarationHeader in: cmt readStream. instVars := self definedInstVarNames collect: [:each | declarations detect: [:eachAssoc | each = eachAssoc key] ifNone: [each -> nil]]
getTypeVars: cmt typeVars := self findDeclarations: 'Type Variable' in: cmt readStream
parseType: typeString " Parse the typeString if possible. Answer an array (for now). If the string can't be parsed, answer nil. " | type | type := Object errorSignal handle: [:ex | ex returnWith: nil] do: [Kernel.Compiler preferredParserClass new parseType: typeString readStream builder: ProgramNodeBuilder new]. ^type
parseVars: scan "^<Array of: (Association key: String value: ProgramNode)> scan <ReadStream> Parse variable declarations from current scan position up to either the end of the stream, or a blank line followed by a line that does not begin with a space or tab. Answer an array of (varName -> type)." | vars | vars := (Array new: 6) writeStream. [scan atEnd] whileFalse: [scan peek = Character cr ifTrue: [scan next. (scan atEnd or: [scan peek isSeparator not]) ifTrue: [^vars contents]] ifFalse: [| line vname type parens vtype | scan skipSeparators. scan atEnd ifTrue: [^vars contents]. line := (scan upTo: Character cr) readStream. vname := (String new: 20) writeStream. parens := line atEnd not and: [line peek = $(]. [line atEnd not and: [parens ifTrue: [line peek = $) ifTrue: [parens := false]. true] ifFalse: [line peek isSeparator not]]] whileTrue: [vname nextPut: line next]. line skipSeparators. (line next = $< and: [type := line through: $>. ["Special hack for embedded ->" type size >= 2 and: [type last = $> and: [(type at: type size - 1) = $-]]] whileTrue: [type := type , (line through: $>)]. type size > 1 and: [type last = $>]]) ifTrue: [vtype := self parseType: (type copyFrom: 1 to: type size - 1). vars nextPut: vname contents -> vtype]]]. ^vars contents
</methods> <methods> ICC.IncrementalTypes.IT1VariableDeclarations <category>IT-API</category>
itTypes ^self class itTypes
</methods> <methods> ICC.IncrementalTypes.IT1VariableDeclarations class <category>instance creation</category>
on: aClass ^self new class: aClass
</methods> <methods> ICC.IncrementalTypes.IT1ClientRelation <category>properties</category>
checkCompatibilityInContext: fullType typeRep: typeRep "^<Boolean>" | result | (result := fullType checkCompatibilityOfClientRelation: self) ifFalse: [self compatibilityError: typeRep. self role: nil]. ^result
</methods> <methods> ICC.IncrementalTypes.IT1ClientRelation <category>private</category>
compatibilityError: typeRep typeRep addError: 'Incompatibility for role ' , self roleName , '.'. ^nil
fromLiteralArrayEncoding: anArray super fromLiteralArrayEncoding: anArray. roleContext := roleContext valueOrDo: [nil]. role := (IT1FullType baseClass: roleContext) typeFrom: role
implementationPrefix | anImplementation | anImplementation := self implementation. anImplementation == #inheritedInstVar ifTrue: [^'\']. anImplementation == #classInstVar ifTrue: [^'$']. anImplementation == #inheritedClassInstVar ifTrue: [^'\$']. anImplementation == #classQuery ifTrue: [^'$']. ^''
literalArrayEncoding ^(Array new: 11) at: 1 put: self class fullyQualifiedReference; at: 2 put: #roleContext:; at: 3 put: self roleContext fullyQualifiedReference; at: 4 put: #roleName:; at: 5 put: self roleName; at: 6 put: #role:; at: 7 put: self roleNotation; at: 8 put: #implementation:; at: 9 put: self implementation; at: 10 put: #explanation:; at: 11 put: self explanation; yourself
</methods> <methods> ICC.IncrementalTypes.IT1ClientRelation <category>accessing</category>
explanation "^<String | nil> Answers the value of the instance variable. If not already set and if possible, this becomes initialized from the current variable comment given in the class comment (resp. the advance info method)." explanation isNil ifTrue: [explanation := (self roleName isNil or: [self implementation isNil]) ifTrue: [nil] ifFalse: [self roleContext explanationOf: self roleName implementation: self implementation]]. ^explanation
explanation: anExplanation "anExplanation <String> Sets the instance variable's value. nil is ignored to force lazy initialization from class comment, see method #explanation." anExplanation notNil ifTrue: [explanation := anExplanation]
extendedRoleName ^self implementationPrefix , self roleName
implementation ^implementation
implementation: aValue implementation := aValue
implementationString ^self itTypes class implementationStringFor: self implementation
multiplicity ^self isMultiple ifTrue: ['*'] ifFalse: ['0..1']
role ^role
role: aValue role := aValue
roleClass | base aConstructor relationType | self role isNil ifTrue: [^nil]. base := self role baseClass. ^(self isMultiple or: [self isWrapped]) ifTrue: ["Look for the type of the relation constructor; take care: it may be 'free'." aConstructor := base defaultTypeConstructor. ((relationType := self role closedTypeVarTypeOf: aConstructor) isNil or: [relationType isFree]) ifTrue: [nil] ifFalse: [relationType baseClass]] ifFalse: [base]
roleContext ^roleContext
roleContext: aClass roleContext := aClass
roleName ^roleName
roleName: aValue roleName := aValue
roleNotation | aStream | aStream := WriteStream on: (String new: 16). self role printNotationOn: aStream. ^aStream contents
</methods> <methods> ICC.IncrementalTypes.IT1ClientRelation <category>testing</category>
hasInheritedImplementation ^self itTypes class inheritedVarImplementationTypes includes: self implementation
hasNonVarImplementation ^self itTypes class nonVarImplementationTypes includes: implementation
isMultiple ^self role isNil ifTrue: [false] ifFalse: [self role baseClass viewAsITCollectionType]
isWrapped ^self role isNil ifTrue: [false] ifFalse: [self role baseClass viewAsITWrappedType]
meta "Determine whether anImplementation addresses class or instance." ^#(#classVar #classInstVar #classQuery) includes: self implementation
</methods> <methods> ICC.IncrementalTypes.IT1ClientRelation <category>IT-API</category>
itTypes ^self class itTypes
</methods> <methods> ICC.IncrementalTypes.IT1ClientRelation <category>updating type</category>
updateTypeTo: typeString "Update the receivers type. Try to avoid going through the class definition and just manipulate the comment." (self itTypes class varImplementationTypes includes: self implementation) ifTrue: [(IT1VariableDeclarations on: self roleContext) declareVariable: self roleName role: typeString implementation: self implementation explanation: self explanation] ifFalse: [self roleContext declareClientRelation: self roleName role: typeString implementation: self implementation explanation: self explanation]. self roleContext invalidateTypeDeclarations
</methods> <methods> ICC.IncrementalTypes.IT1ClientRelation class <category>client relation specs</category>
itClientRelationsSpec "^<IT1ClientRelationsScope> Answer a client relations scope." ^( #(#{ICC.IncrementalTypes.IT1ClientRelationScope} #localScope: #{ICC.IncrementalTypes.IT1ClientRelation} #clientRelations: #( #(#{ICC.IncrementalTypes.IT1ClientRelation} #roleContext: #{ICC.IncrementalTypes.IT1ClientRelation} #roleName: 't1' #role: 'ICC.ADvance.IT1TypeVariableScope' #implementation: #instQuery #explanation: nil ) ) ) ) decodeAsLiteralArray
</methods> <methods> ICC.IncrementalTypes.IT1ClientRelation class <category>instance creation</category>
roleContext: aClass roleName: aRoleName role: aTypeScheme implementation: anImplementation ^self roleContext: aClass roleName: aRoleName role: aTypeScheme implementation: anImplementation explanation: nil
roleContext: aClass roleName: aRoleName role: aTypeScheme implementation: anImplementation explanation: anExplanation ^self new roleContext: aClass; roleName: aRoleName; role: aTypeScheme; implementation: anImplementation; explanation: anExplanation; yourself
</methods> <methods> ICC.IncrementalTypes.IT1NameScope <category>accessing</category>
outerScope ^outerScope
outerScope: aVariableDeclarations outerScope := aVariableDeclarations
</methods> <methods> ICC.IncrementalTypes.IT1NameScope class <category>instance creation</category>
outerScope: aNameScope | obj | obj := self new. obj outerScope: aNameScope. ^obj
</methods> <methods> ICC.IncrementalTypes.IT1ClientRelationScope <category>adding-removing</category>
addAsClientRelations: namesAndSemantics implementation: anImplementation namesAndSemantics do: [:each | self addClientRelation: (IT1ClientRelation roleContext: self localScope roleName: each key role: each value implementation: anImplementation)]
addClientRelation: aClientRelation "The first line leads to side effect considerations on aClientRelation!" aClientRelation roleContext: self localScope. self clientRelations add: aClientRelation
addClientRelations: aClientRelationsCollection aClientRelationsCollection do: [:each | self addClientRelation: each]
removeClientRelation: aRoleName implementation: anImplementation self clientRelations removeAllSuchThat: [:each | each roleName = aRoleName and: [each implementation = anImplementation]]
</methods> <methods> ICC.IncrementalTypes.IT1ClientRelationScope <category>state variable properties</category>
atLocallyDefinedRoleName: aRoleName ofImplementation: anImplementation inEnvironment: aTypeEnvironment "^<ITTypeScheme | nil >" | val | val := (self rolesWithImplementation: anImplementation) at: aRoleName ifAbsent: [^nil]. ^val closureIn: aTypeEnvironment
atRoleName: aRoleName baseImplementation: anImplementation inEnvironment: aTypeEnvironment "^<ITTypeScheme | nil >" | val | (val := (self varsWithBaseImplementation: anImplementation) at: aRoleName ifAbsent: [nil]) isNil ifTrue: [^self outerScope isNil ifTrue: [nil] ifFalse: [self outerScope atRoleName: aRoleName implementation: anImplementation inEnvironment: aTypeEnvironment]]. ^val closureIn: aTypeEnvironment
atRoleName: aRoleName implementation: anImplementation inEnvironment: aTypeEnvironment "^<ITTypeScheme | nil >" | val | (val := (self varsWithImplementation: anImplementation) at: aRoleName ifAbsent: [nil]) isNil ifTrue: [^self outerScope isNil ifTrue: [nil] ifFalse: [self outerScope atRoleName: aRoleName implementation: anImplementation inEnvironment: aTypeEnvironment]]. ^val closureIn: aTypeEnvironment
</methods> <methods> ICC.IncrementalTypes.IT1ClientRelationScope <category>vars</category>
classInstVars ^self varsWithImplementation: #classInstVar
classInstVars: namesAndSemantics self addAsClientRelations: namesAndSemantics implementation: #classInstVar
classVars ^self varsWithImplementation: #classVar
classVars: namesAndSemantics self addAsClientRelations: namesAndSemantics implementation: #classVar
inheritedClassInstVars: namesAndSemantics self addAsClientRelations: namesAndSemantics implementation: #inheritedClassInstVar
inheritedInstVars: namesAndSemantics self addAsClientRelations: namesAndSemantics implementation: #inheritedInstVar
instVars ^self varsWithImplementation: #instVar
instVars: namesAndSemantics self addAsClientRelations: namesAndSemantics implementation: #instVar
</methods> <methods> ICC.IncrementalTypes.IT1ClientRelationScope <category>accessing</category>
clientRelations ^clientRelations
clientRelations: aCollectionOfClientRelations clientRelations := aCollectionOfClientRelations
itTypes ^self class itTypes
locallyDefinedClientRelationsOfImplementation: anImplementation "^<Set of: String>" ^(self rolesWithImplementation: anImplementation) keys
localScope ^localScope
localScope: aClass localScope := aClass
nonVarClientRelations ^self clientRelations select: [:ea | ea hasNonVarImplementation]
rolesWithImplementation: anImplementation "^<Dictionary key: String value: ITTypeScheme>" | dict | dict := Dictionary new. self clientRelations do: [:each | each implementation == anImplementation ifTrue: [dict at: each roleName put: each role]]. ^dict
varsWithBaseImplementation: anImplementation "^<Dictionary key: String value: ITTypeScheme>" | dict implementations | dict := Dictionary new. implementations := self itTypes class implementationsForBaseImplementation: anImplementation. self clientRelations do: [:each | (implementations includes: each implementation) ifTrue: [dict at: each roleName put: each role]]. ^dict
varsWithImplementation: anImplementation "^<Dictionary key: String value: ITTypeScheme>" | dict | dict := Dictionary new. self clientRelations do: [:each | each implementation == anImplementation ifTrue: [dict at: each roleName put: each role]]. ^dict
</methods> <methods> ICC.IncrementalTypes.IT1ClientRelationScope <category>private</category>
fromLiteralArrayEncoding: anArray 2 to: anArray size by: 2 do: [:i | self perform: (anArray at: i) with: (anArray at: i + 1)]. localScope := localScope valueOrDo: [nil]. clientRelations := clientRelations collect: [:each | each decodeAsLiteralArray]
literalArrayEncoding "^<Array>" ^(Array new: 5) at: 1 put: self class fullyQualifiedReference; at: 2 put: #localScope:; at: 3 put: self localScope fullyQualifiedReference; at: 4 put: #clientRelations:; at: 5 put: (self nonVarClientRelations asArray collect: [:each | each literalArrayEncoding]); yourself
</methods> <methods> ICC.IncrementalTypes.IT1ClientRelationScope <category>initialize-release</category>
initialize clientRelations := OrderedCollection new
</methods> <methods> ICC.IncrementalTypes.IT1ClientRelationScope <category>specifications</category>
save "Generate a method answering my reincarnation." | methodName s | methodName := #itClientRelationsSpec. s := (String new: 1024) writeStream. s nextPutAll: methodName; crtab; nextPutAll: '"^<IT1ClientRelationsScope> Answer a client relations scope."'; cr; crtab; nextPutAll: '^( '. UISpecification prettyPrintSpecArray: self literalArrayEncoding on: s tabLevel: 1. s nextPutAll: ' ) decodeAsLiteralArray'. self adBasics systemOrganization compile: s contents classified: nil for: self localScope class
</methods> <methods> ICC.IncrementalTypes.IT1ClientRelationScope class <category>private</category>
decodeFromLiteralArray: anArray ^self new fromLiteralArrayEncoding: anArray
</methods> <methods> ICC.IncrementalTypes.IT1ClientRelationScope class <category>instance creation</category>
outerScope: anOuterScope localScope: aClass | obj | obj := self outerScope: anOuterScope. obj localScope: aClass. obj initialize. ^obj
</methods> <methods> ICC.IncrementalTypes.IT1TypeSpecificationsStub <category>elaboration</category>
invalidateTypeOf: aClass "This is a stub that avoids malfunctions of system modifications after reinstalling ADvance. Do nothing and answer false to indicate the nop." ^false
</methods> <methods> ICC.IncrementalTypes.IT1LiteralType <category>accessing</category>
literal ^literal
literal: anObject literal := anObject
</methods> <methods> ICC.IncrementalTypes.IT1LiteralType <category>printing</category>
printNotationOn: aStream showNamespaces: aBoolean self literal printOn: aStream
</methods> <methods> ICC.IncrementalTypes.IT1LiteralType class <category>instance creation</category>
masterClass: aMasterClass baseClass: aBaseClass literal: anObject | obj | obj := self masterClass: aMasterClass baseClass: aBaseClass. obj literal: anObject. ^obj
</methods> <methods> ICC.IncrementalTypes.IT1Inferencing <category>adding</category>
addTypeVarBinding: anAssociation self typeMatchConstraints add: anAssociation
</methods> <methods> ICC.IncrementalTypes.IT1Inferencing <category>accessing</category>
typeMatchConstraints inferenceConstraints isNil ifTrue: [inferenceConstraints := Dictionary new]. ^inferenceConstraints
</methods> <methods> ICC.IncrementalTypes.IT1TypeVariableScope <category>adding</category>
addTypeVar: anAssociation self typeVars add: anAssociation
extendBy: aTypeVariableScope aTypeVariableScope typeVars associationsDo: [:tVar | self addTypeVar: tVar]
</methods> <methods> ICC.IncrementalTypes.IT1TypeVariableScope <category>accessing</category>
atTypeVarName: aTypeVarName inEnvironment: aTypeEnvironment "^<ITTypeScheme>" | val | aTypeVarName = 'current' ifTrue: [^IT1ClassType masterClass: aTypeEnvironment masterClass baseClass: aTypeEnvironment masterClass meta: aTypeEnvironment meta]. aTypeVarName = 'class' ifTrue: [aTypeEnvironment meta ifTrue: [^nil] ifFalse: [^IT1ClassType masterClass: aTypeEnvironment masterClass baseClass: aTypeEnvironment masterClass meta: true]]. aTypeVarName = 'instance' ifTrue: [aTypeEnvironment meta ifTrue: [^IT1ClassType masterClass: aTypeEnvironment masterClass baseClass: aTypeEnvironment masterClass meta: false] ifFalse: [^nil]]. aTypeVarName = 'free' ifTrue: [^IT1FreeType masterClass: aTypeEnvironment masterClass]. (val := self typeVars at: aTypeVarName ifAbsent: [nil]) isNil ifTrue: [^self outerScope isNil ifTrue: [nil] ifFalse: [self outerScope atTypeVarName: aTypeVarName inEnvironment: aTypeEnvironment]]. ^val closureIn: aTypeEnvironment
typeVars typeVars isNil ifTrue: [typeVars := Dictionary new]. ^typeVars
</methods> <methods> ICC.IncrementalTypes.IT1TypeVariableScope <category>type variable properties</category>
baseClassOfTypeVar: aTypeVarName inEnvironment: aTypeEnvironment "^<Class> Triggers a dereferencing if necessary. Note that accessing type variables yields closed type schemes." ^(self typeVarTypeOf: aTypeVarName inEnvironment: aTypeEnvironment) baseClass
isDefined: aTypeVarName "^<Boolean>" ^(self typeVars includesKey: aTypeVarName) ifTrue: [true] ifFalse: [self outerScope isNil ifTrue: [false] ifFalse: [self outerScope isDefined: aTypeVarName]]
typeVarTypeOf: aTypeVarName "Short form for type variables with closed type schemes as values." ^self typeVars at: aTypeVarName ifAbsent: [self outerScope isNil ifTrue: [nil] ifFalse: [self outerScope typeVarTypeOf: aTypeVarName]]
typeVarTypeOf: aTypeVarName inEnvironment: aTypeEnvironment "^<ITTypeScheme | nil >" "Evaluate aTypeVarName in aTypeEnvironment, disallowing currentClass in class context and instance in instance context. Type variables are not! dereferenced." ^self atTypeVarName: aTypeVarName inEnvironment: aTypeEnvironment
</methods> <methods> ICC.IncrementalTypes.IT1TypeVariableScope <category>testing</category>
hasTypeVarRecursion: aTypeVarName inElaborationContext: elabContext "^<Boolean>" | ok | ok := false. self typeVars do: [:typeScheme | ok := ok or: [typeScheme hasTypeVarRecursion: aTypeVarName inElaborationContext: elabContext]]. ^ok
isEmpty "^<Boolean> Check if there exist a type variable in this scope." self typeVars isEmpty ifFalse: [^false] ifTrue: [self outerScope isNil ifTrue: [^true] ifFalse: [^self outerScope isEmpty]]
</methods> <methods> ICC.IncrementalTypes.IT1TypeVariableScope <category>printing</category>
printNotationOn: aStream "Default is to use namespaces within notation." ^self printNotationOn: aStream showNamespaces: true
printNotationOn: aStream showNamespaces: aBoolean "Printing does not take care of binding semantics." self typeVars associationsDo: [:assoc | aStream space; nextPutAll: assoc key; nextPut: $:; space. (assoc value closureIn: self) printNotationOn: aStream showNamespaces: aBoolean]
</methods> <methods> ICC.IncrementalTypes.IT1FreeType <category>accessing</category>
baseClass "^<Class>" ^Object
</methods> <methods> ICC.IncrementalTypes.IT1FreeType <category>compatibility</category>
in: myEnv satisfiedBy: aTypeScheme in: aTypeSchemeEnv matchContext: matchContext "^<ITMatchContext | nil>" "A free type is compatible with everything." ^matchContext
</methods> <methods> ICC.IncrementalTypes.IT1FreeType <category>testing</category>
isFree ^true
</methods> <methods> ICC.IncrementalTypes.IT1FreeType <category>printing</category>
printNotationOn: aStream showNamespaces: aBoolean aStream nextPutAll: 'free'
</methods> <methods> ICC.IncrementalTypes.IT1TypeClosure <category>accessing</category>
baseClass "^<Class>" ^self typeScheme baseClassIn: self typeEnvironment
closedTypeVarTypeOf: aTypeVarName ^self typeScheme typeVarTypeOf: aTypeVarName inEnvironment: self typeEnvironment
typeEnvironment ^typeEnvironment
typeEnvironment: aTypeEnvironment typeEnvironment := aTypeEnvironment
typeScheme ^typeScheme
typeScheme: aTypeScheme typeScheme := aTypeScheme
typeVarTypeOf: aTypeVarName ^self typeScheme typeVarTypeOf: aTypeVarName inEnvironment: self typeEnvironment
</methods> <methods> ICC.IncrementalTypes.IT1TypeClosure <category>compatibility</category>
in: myEnv satisfiedBy: aTypeScheme in: aTypeSchemeEnv matchContext: matchContext "^<ITMatchContext | nil>" ^self typeScheme in: self typeEnvironment satisfiedBy: aTypeScheme in: aTypeSchemeEnv matchContext: matchContext
</methods> <methods> ICC.IncrementalTypes.IT1TypeClosure <category>printing</category>
printNotationOn: aStream showNamespaces: aBoolean "Printing does not take care of binding semantics." self typeScheme printNotationOn: aStream showNamespaces: aBoolean
</methods> <methods> ICC.IncrementalTypes.IT1TypeClosure class <category>instance creation</category>
typeScheme: aTypeScheme typeEnvironment: aTypeEnvironment | obj | obj := self new. obj typeScheme: aTypeScheme. obj typeEnvironment: aTypeEnvironment. ^obj
</methods> <methods> ICC.IncrementalTypes.IT1TypeDescriptor <category>initialize-release</category>
forFullType: aFullType fullType := aFullType.
</methods> <methods> ICC.IncrementalTypes.IT1TypeDescriptor <category>accessing</category>
fullType ^fullType
typeRep self localValidityReport isNil ifTrue: [self localValidityReport: IT1TypeReport new]. ^self localValidityReport
</methods> <methods> ICC.IncrementalTypes.IT1TypeDescriptor <category>testing</category>
isLocallyValid ^self localValidityReport isEmpty
isStrictlyValid ^self strictValidityReport isEmpty
</methods> <methods> ICC.IncrementalTypes.IT1TypeDescriptor <category>validity</category>
localValidityReport localValidityReport isNil ifTrue: [localValidityReport := IT1TypeReport new]. ^localValidityReport
localValidityReport: aTypeReport localValidityReport := aTypeReport
strictValidityReport strictValidityReport isNil ifTrue: [strictValidityReport := IT1TypeReport new]. ^strictValidityReport
strictValidityReport: aTypeReport strictValidityReport := aTypeReport
</methods> <methods> ICC.IncrementalTypes.IT1TypeDescriptor class <category>instance creation</category>
forFullType: aFullType | obj | obj := self new. obj forFullType: aFullType. ^obj
</methods> <methods> ICC.IncrementalTypes.IT1TypeSpecifications <category>utility</category>
checkTypesFor: aCollectionOfClasses "Elaborate the type declarations for aCollectionOfClasses. Open an error report if any error occured." | errorReport aStream | errorReport := IT1TypeReport new. aStream := WriteStream on: (String new: 1000). aCollectionOfClasses do: [:each | | fullType | each invalidateTypeDeclarations. fullType := each fullType elaborate; yourself. (fullType isStrictlyValid and: [fullType isLocallyValid]) ifFalse: [| aReport | aReport := fullType fullValidityReport. errorReport addAllErrors: aReport errors. aStream nextPutAll: aReport errorText]]. errorReport isEmpty ifTrue: [^Dialog warn: 'State types successfully declared.'] ifFalse: [ComposedTextView open: aStream contents asValue label: 'Type Checking Report' icon: nil extent: 540 @ 400]
</methods> <methods> ICC.IncrementalTypes.IT1TypeSpecifications <category>accessing types</category>
clientRelationDeclarationsOf: aClass "<ITClientRelationScope | nil>" ^(self fullTypeOfClass: aClass) clientRelationDeclarations
fullTypeOfClass: aClass ^self fullTypes at: aClass ifAbsent: [self createFullTypeEntry: aClass]
typeVarDeclarationsOf: aClass "<ITTypeVariableScope|nil>" | typeSpec | typeSpec := self fullTypeOfClass: aClass. ^typeSpec typeVarDeclarations
</methods> <methods> ICC.IncrementalTypes.IT1TypeSpecifications <category>private</category>
createFullTypeEntry: aClass "^<IT1FullType>" ^self fullTypes at: aClass put: (IT1FullType baseClass: aClass)
fullTypes ^fullTypes
</methods> <methods> ICC.IncrementalTypes.IT1TypeSpecifications <category>initialize-release</category>
initialize fullTypes := IdentityDictionary new
reinitializeAll "This discards all type information including interface specs." (Dialog confirm: 'Do you really want to discard all type specifications including interface specs?\(You may use '' ITTypeSpecifications class>>#reinitializeDeclarations'' instead.)' withCRs) ifTrue: [self initialize]
reinitializeDeclarations (Dialog confirm: 'Do you really want to discard\all type variable declarations?' withCRs) ifTrue: [Class rootsOfTheWorld do: [:each | each invalidateTypeDeclarations]]
</methods> <methods> ICC.IncrementalTypes.IT1TypeSpecifications <category>elaboration</category>
invalidateTypeOf: aClass "^<Boolean> Answer true if an elaboration has been successfully removed." | aFullType | aFullType := self fullTypes at: aClass ifAbsent: [^false]. ^aFullType invalidateClientRelationsDeclaration
</methods> <methods> ICC.IncrementalTypes.IT1TypeSpecifications <category>updating</category>
update: anAspect with: anObject "Depending on the ADvance preferences (and whether ADvance is loaded) comment or special class method becomes updated." | shallUseComment theClassInfoSelector | shallUseComment := (self respondsTo: #advance) not or: [self advance preferences general classInfoSource == #comment]. theClassInfoSelector := (self respondsTo: #advance) ifTrue: [self advance preferences general classInfoSelector] ifFalse: [nil]. (#(#addClass: #changeClass: #removeClass:) includes: anAspect) ifTrue: [^anObject first invalidateTypeDeclarations]. (#commentClass: == anAspect and: [shallUseComment]) ifTrue: [^anObject first invalidateTypeDeclarations]. ((#(#addSelector:class: #changeSelector:class: #removeSelector:class:) includes: anAspect) and: [shallUseComment not and: [anObject first == theClassInfoSelector]]) ifTrue: [anObject last invalidateTypeDeclarations]
</methods> <methods> ICC.IncrementalTypes.IT1TypeSpecifications class <category>constants</category>
associationTypeStrings ^#('Single Association' 'ValueHolder' 'Collection' 'OrderedCollection' 'SortedCollection' 'Set' 'Array' 'Dictionary')
implementationTypes ^self varImplementationTypes , self nonVarImplementationTypes
implementationTypeStrings ^self implementationTypes collect: [:each | self implementationMapping at: each]
inheritedVarImplementationTypes ^#(#inheritedInstVar #inheritedClassInstVar)
nonVarImplementationTypes ^#(#instQuery #classQuery)
simpleVarImplementationTypes ^#(#instVar #classInstVar #classVar)
varImplementationTypes ^self simpleVarImplementationTypes , self inheritedVarImplementationTypes
</methods> <methods> ICC.IncrementalTypes.IT1TypeSpecifications class <category>accessing</category>
default Default isNil ifTrue: [self default: self new]. ^Default
default: typeSpecification Default notNil ifTrue: [ChangeSet current removeDependent: Default]. Default := typeSpecification. Default notNil ifTrue: [ChangeSet current addDependent: Default]
implementationMapping ^ImplementationMapping
</methods> <methods> ICC.IncrementalTypes.IT1TypeSpecifications class <category>utility</category>
implementationFor: anImplementationString ^self implementationTypes detect: [:each | anImplementationString = (self implementationStringFor: each)]
implementationsForBaseImplementation: anImplementation anImplementation == #instVar ifTrue: [^#(#instVar #inheritedInstVar)]. anImplementation == #classInstVar ifTrue: [^#(#classInstVar #inheritedClassInstVar)]. ^self error: 'Invalid implementation: ' , anImplementation printString
implementationStringFor: anImplementation ^self implementationMapping at: anImplementation
typeStringFor: aClassName roleType: aRoleType "^<String>" | prefix | prefix := aRoleType = 'Single Association' ifTrue: [''] ifFalse: [aRoleType = 'Dictionary' ifTrue: ['Dictionary key: Object value: '] ifFalse: [aRoleType = 'ValueHolder' ifTrue: ['ValueHolder on: '] ifFalse: [aRoleType , ' of: ']]]. ^prefix , aClassName asString
</methods> <methods> ICC.IncrementalTypes.IT1TypeSpecifications class <category>class initialization</category>
initialize "self initialize" self default: self new. self initializeImplementationMapping
initializeImplementationMapping "This method looks funny, because OSI forgot the method #withKeysAndValues: in the VW3.0 non-Envy." | initialMappings | initialMappings := #(#instVar 'Instance Variable' #classVar 'Class Variable' #classInstVar 'Class Instance Variable' #inheritedInstVar 'Inherited Instance Variable' #inheritedClassInstVar 'Inherited Class Instance Variable' #instQuery 'Instance Query' #classQuery 'Class Query'). ImplementationMapping := IdentityDictionary new: initialMappings size. 1 to: initialMappings size by: 2 do: [:i | ImplementationMapping at: (initialMappings at: i) put: (initialMappings at: i + 1)]
obsolete "This class is being removed from the system. Uninitialize the receiver." self uninitialize. super obsolete
reinitializeAll "self reinitializeAll" self default reinitializeAll
reinitializeDeclarations "self reinitializeDeclarations" self default reinitializeDeclarations
uninitialize self default notNil ifTrue: [self default initialize]. self default: nil
</methods> <methods> ICC.IncrementalTypes.IT1TypeSpecifications class <category>instance creation</category>
new ^super new initialize
</methods> <methods> Core.Metaclass <category>IT-API</category>
invalidateTypeDeclarations self soleInstance invalidateTypeDeclarations
</methods> <methods> Core.Collection class <category>IT-core</category>
defaultTypeConstructor ^'of'
genericTypeConstructors ^'Type Variables: of <free> size <free>'
viewAsITCollectionType ^true
</methods> <methods> Kernel.LiteralNode <category>IT-core</category>
isLiteralNode ^true
typeSemanticsInElaborationContext: elabContext "^<IT1TypeScheme | nil>" ^ICC.IncrementalTypes.IT1LiteralType masterClass: elabContext masterClass baseClass: self value class literal: self value
</methods> <methods> Kernel.VariableNode <category>IT-core</category>
isVariableNode ^true
typeSemanticsInElaborationContext: elabContext "^<IT1ClassType | nil>" "There are two kinds of type names: class names and type variable names. If name is a type variable, it must be defined in aTypeEnvironment already. This imposes certain restrictions on recursive definitions which are not of practical importance, however. Special type variables are current, class, instance and free." | theName typeName aType | theName := self name. typeName := theName asSymbol. aType := (typeName asQualifiedReference home: elabContext baseClass environment) valueOrDo: [nil]. (aType notNil and: [aType isBehavior]) ifTrue: [^ICC.IncrementalTypes.IT1ClassType masterClass: elabContext masterClass baseClass: aType]. ((elabContext isDefined: theName) or: [#(#current #free #instance #class) includes: typeName]) ifTrue: [^ICC.IncrementalTypes.IT1TypeVariable masterClass: elabContext masterClass typeVarName: theName]. elabContext notAValidTypeError: theName. ^nil
</methods> <methods> UI.SelectionInList class <category>IT-core</category>
defaultTypeConstructor ^'on'
genericTypeConstructors ^'Type Variables: with <free> on <free> for <free> of <free>'
viewAsITWrappedType ^true
</methods> <methods> Core.Class <category>IT-API</category>
clientRelationDeclarations ^self itTypes clientRelationDeclarationsOf: self
clientRelations ^self clientRelationDeclarations clientRelations
clientRelationTypeOf: aRoleName implementation: aSymbol "^<ITTypeScheme | nil> Triggers elaboration of declarations if necessary." ^(self itTypes fullTypeOfClass: self) clientRelationTypeOf: aRoleName implementation: aSymbol
declareClientRelation: aRoleName role: aTypeString implementation: anImplementation explanation: anExplanation "aRoleName <String> aTypeString <String> describing the role of the client relation; any unbound references in the type string are resolved within my class context. anImplementation <Symbol> anExplanation <String | nil>" self fullType declareClientRelation: aRoleName role: aTypeString implementation: anImplementation explanation: anExplanation
explanationOf: aVariableName implementation: anImplementation "^<String | nil>" ^(ICC.IncrementalTypes.IT1VariableDeclarations on: self) explanationOf: aVariableName declarationHeader: (self itTypes class implementationStringFor: anImplementation)
fullType "<ITFullType | nil>" ^self itTypes fullTypeOfClass: self
infoString "Return the string the Incremental Types will extract type information from. Depending on the ADvance settings use either the comment or the method given by the user in the preferences." | selector | ^(((self respondsTo: #advance) and: [self advance preferences general classInfoSource ~~ #comment and: [self class includesSelector: (selector := self advance preferences general classInfoSelector)]]) ifTrue: [self perform: selector] ifFalse: [self comment asString]) copy
infoString: aString "Store the string the Incremental Types will extract type information from. Depending on the ADvance settings use either the comment or the method given by the user in the preferences." | stream | ((self respondsTo: #advance) and: [self advance preferences general classInfoSource == #comment]) ifTrue: [self comment: aString] ifFalse: [stream := WriteStream on: (String new: aString size * 2). stream nextPutAll: self advance preferences general classInfoSelector; crtab; nextPut: $^; print: aString. self class compile: stream contents classified: #ADvance]
</methods> <methods> Core.Class <category>IT-core</category>
itTypes ^ICC.IncrementalTypes.IT1TypeSpecifications default
</methods> <methods> Core.Class <category>IT-API</category>
locallyDefinedClientRelationsOfImplementation: anImplementation "^<Set of: String> Triggers elaboration of declarations if necessary." ^(self itTypes fullTypeOfClass: self) locallyDefinedClientRelationsOfImplementation: anImplementation
locallyDefinedClientRelationTypeOf: aRoleName implementation: anImplementation "^<ITTypeScheme | nil> Triggers elaboration of declarations if necessary." ^(self itTypes fullTypeOfClass: self) locallyDefinedClientRelationTypeOf: aRoleName implementation: anImplementation
removeClientRelation: aRoleName implementation: anImplementation self fullType removeClientRelation: aRoleName implementation: anImplementation
removeVariable: aVariableName implementation: anImplementation (ICC.IncrementalTypes.IT1VariableDeclarations on: self) removeVariable: aVariableName implementation: anImplementation
typeVarDeclarations ^self itTypes typeVarDeclarationsOf: self
</methods> <methods> Core.Class <category>IT-core</category>
viewAsITCollectionType ^false
viewAsITWrappedType ^false
</methods> <methods> Kernel.MessageNode <category>IT-core</category>
argumentTypesFromArguments: elabContext "^<(OrderedCollection of: ITTypeScheme) | nil>" | ok args argType | ok := true. args := self arguments collect: [:arg | argType := arg typeSemanticsInElaborationContext: elabContext. argType isNil ifTrue: [ok := false]. argType]. ^ok ifTrue: [args] ifFalse: [nil]
associationTypeInElaborationContext: elabContext "^<ITTypeScheme | nil>" self arguments growToAtLeast: 2. self receiver: (VariableNode new name: 'Core.Association') selector: #key:value: arguments: (Array with: self receiver with: (self arguments at: 1)). ^self typeSemanticsInElaborationContext: elabContext
metaClassTypeInElaborationContext: elabContext "^<ITTypeScheme | nil>" "For metaclasses, we do not enter the loop of class/metaclass reference." | rec | rec := self receiver typeSemanticsInElaborationContext: elabContext. (rec isKindOf: ICC.IncrementalTypes.IT1ClassType) ifTrue: [rec meta ifFalse: [rec meta: true. ^rec] ifTrue: [^self noMetaclassClassError: elabContext typeRep]]. ^nil
noClassTypeError: typeRep typeRep addError: 'Class type expected for generic instantiation.'. ^nil
noMetaclassClassError: typeRep typeRep addError: 'The class of a metaclass must not be specified.'. ^nil
notACorrectSelectorError: str typeRep: typeRep typeRep addError: str , ' is not a correct type variable.'. ^nil
typeSemanticsInElaborationContext: elabContext "^<ITTypeScheme | nil>" self selector == #| ifTrue: [^self unionTypeInElaborationContext: elabContext]. self selector == #class ifTrue: [^self metaClassTypeInElaborationContext: elabContext]. self selector == #-> ifTrue: [^self associationTypeInElaborationContext: elabContext]. ^self typeSubstitutionInElaborationContext: elabContext
typeSubstitutionInElaborationContext: elabContext "^<IT1ClassType | nil>" "For specific receivers, types to be substituted may be specifically defined. After successful substitution, typeVarReferences are joined." | rec typeVarNames args | rec := self receiver typeSemanticsInElaborationContext: elabContext. (rec isKindOf: ICC.IncrementalTypes.IT1ClassType) ifFalse: [^self noClassTypeError: elabContext typeRep]. typeVarNames := self typeVarNamesFromSelector: elabContext typeRep. args := self argumentTypesFromArguments: elabContext. typeVarNames isNil | args isNil ifTrue: [^nil]. ^rec substituteTypeVars: typeVarNames with: args inElaborationContext: elabContext
typeVarNamesFromSelector: typeRep "^<(OrderedCollection of: String) | nil>" "Removes : from selector keywords. If there is a selector without a :, report an error." ^self selector keywords collect: [:keyword | | str | str := keyword asString. str last ~= $: ifTrue: [^self notACorrectSelectorError: str typeRep: typeRep]. keyword asString copyFrom: 1 to: keyword size - 1]
unionTypeInElaborationContext: elabContext "^<ITTypeScheme | nil>" | rec arg newType | rec := self receiver typeSemanticsInElaborationContext: elabContext. arg := (self arguments at: 1) typeSemanticsInElaborationContext: elabContext. rec isNil | arg isNil ifTrue: [^nil]. (rec isKindOf: ICC.IncrementalTypes.IT1UnionType) ifTrue: [(arg isKindOf: ICC.IncrementalTypes.IT1UnionType) ifTrue: [rec addUnionType: arg] ifFalse: [rec addTypeScheme: arg]. ^rec] ifFalse: [(arg isKindOf: ICC.IncrementalTypes.IT1UnionType) ifTrue: [arg addTypeScheme: rec. ^arg] ifFalse: [newType := ICC.IncrementalTypes.IT1UnionType masterClass: elabContext masterClass. newType addTypeScheme: arg. newType addTypeScheme: rec. ^newType]]
</methods> <methods> Kernel.ProgramNode <category>IT-core</category>
isLiteralNode ^false
isReturnNode ^false
isVariableNode ^false
</methods> <methods> Core.Dictionary class <category>IT-core</category>
defaultTypeConstructor ^'value'
genericTypeConstructors ^'Type Variables: key <free> value <free>'
</methods> <methods> UI.ValueModel class <category>IT-core</category>
defaultTypeConstructor ^'on'
genericTypeConstructors ^'Type Variables: with <free> on <free> for <free> of <free>'
viewAsITWrappedType ^true
</methods> <methods> Core.Behavior <category>IT-API</category>
invalidateTypeDeclarations "If there is a valid type declaration for me, it is invalidated and my subclasses are asked to invalidate." (ICC.IncrementalTypes.IT1TypeSpecifications default invalidateTypeOf: self) ifTrue: [self subclasses do: [:each | each invalidateTypeDeclarations]]
logDefinition "Log my definition in Change file." SourceFileManager default logChange: self definition
</methods> <methods> Core.Association class <category>IT-core</category>
genericTypeConstructors ^'Type Variables: key <free> value <free>'
</methods> <methods> Core.UndefinedObject <category>IT-core</category>
itTypeNotation | aStream | aStream := WriteStream on: (String new: 16). self printNotationOn: aStream. ^aStream contents
printNotationOn: aStream ^self printNotationOn: aStream showNamespaces: true
printNotationOn: aStream showNamespaces: aBoolean aStream nextPutAll: 'undefined'
</methods> <methods> Kernel.BlockClosure class <category>IT-core</category>
genericTypeConstructors "^<String>" ^'Type Variables: value <free>'
</methods> <methods> Kernel.ReturnNode <category>IT-core</category>
isReturnNode ^true
</methods> <methods> Core.Stream class <category>IT-core</category>
genericTypeConstructors ^'Type Variables: on <free>'
</methods> <methods> Core.CharacterArray class <category>IT-core</category>
viewAsITCollectionType ^false
</methods> <methods> Core.Semaphore class <category>IT-core</category>
viewAsITCollectionType ^false
</methods> <initialize> ICC.IncrementalTypes.IT1FullType </initialize> <initialize> ICC.IncrementalTypes.IT1TypeSpecifications </initialize> "Imported Classes:" self error: 'Attempting to file-in parcel imports. Choose terminate or close' <class> <name>Object</name> <environment>Core</environment> <super></super> <private>false</private> none <imports></imports> <category>Kernel-Objects</category> <attributes> <package>Kernel-Objects</package> </attributes> </class> <class> <name>Behavior</name> <environment>Core</environment> <super>Core.Object</super> <private>false</private> none superclass methodDict format subclasses <imports></imports> <category>Kernel-Classes</category> <attributes> <package>Kernel-Classes</package> </attributes> </class> <class> <name>ProgramNode</name> <environment>Kernel</environment> <super>Core.Object</super> <private>false</private> none sourcePosition comment compilerHints blockIndex mapEntry returnMapEntry <imports></imports> <category>System-Compiler-Program Objects</category> <attributes> <package>System-Compiler-Program Objects</package> </attributes> </class> <class> <name>Model</name> <environment>UI</environment> <super>Core.Object</super> <private>false</private> none dependents <imports></imports> <category>Kernel-Objects</category> <attributes> <package>Kernel-Objects</package> </attributes> </class> <class> <name>ReturnNode</name> <environment>Kernel</environment> <super>Kernel.StatementNode</super> <private>false</private> none value <imports></imports> <category>System-Compiler-Program Objects</category> <attributes> <package>System-Compiler-Program Objects</package> </attributes> </class> <class> <name>LiteralNode</name> <environment>Kernel</environment> <super>Kernel.LeafNode</super> <private>false</private> none value <imports></imports> <category>System-Compiler-Program Objects</category> <attributes> <package>System-Compiler-Program Objects</package> </attributes> </class> <class> <name>Metaclass</name> <environment>Core</environment> <super>Core.ClassDescription</super> <private>false</private> none thisClass <imports></imports> <category>Kernel-Classes</category> <attributes> <package>Kernel-Classes</package> </attributes> </class> <class> <name>UISpecification</name> <environment>UI</environment> <super>Core.Object</super> <private>false</private> none properties <imports></imports> <category>UIBuilder-Specifications</category> <attributes> <package>UIBuilder-Specifications</package> </attributes> </class> <class> <name>Class</name> <environment>Core</environment> <super>Core.ClassDescription</super> <private>false</private> none name classPool environment <imports></imports> <category>Kernel-Classes</category> <attributes> <package>Kernel-Classes</package> </attributes> </class> <class> <name>VariableNode</name> <environment>Kernel</environment> <super>Kernel.LeafNode</super> <private>false</private> none name read <imports></imports> <category>System-Compiler-Program Objects</category> <attributes> <package>System-Compiler-Program Objects</package> </attributes> </class> <class> <name>UndefinedObject</name> <environment>Core</environment> <super>Core.Object</super> <private>false</private> none <imports></imports> <category>Kernel-Objects</category> <attributes> <package>Kernel-Objects</package> </attributes> </class> <class> <name>MessageNode</name> <environment>Kernel</environment> <super>Kernel.SimpleMessageNode</super> <private>false</private> none expanded expansion <imports></imports> <category>System-Compiler-Program Objects</category> <attributes> <package>System-Compiler-Program Objects</package> </attributes> </class>