Interface


SmallInterfaces

Comment:



Hierarchy:

ProtoObject
Object
Interface

Summary:

methods:

instance class
no messages
accessing accessing-classes accessing-extended accessing-extending class creation code generation defaults documentation errors extending interface calculus interface creation printing querying subclass creation testing utilities

Detail:

instance methods:

class methods:

accessing
allRelevantClassesAndInterfaces


	^(Set with: self)
		addAll: self extendedInterfaces;
		addAll: self extenders;
		addAll: self understanders;
		yourself
configuration

	"<Interface configuration 
		enforceNonEmptyInterfaces: true;
		removeOnlyStubbedImplementations: true>"

	^InterfaceConfiguration current
home


	^InterfaceHome current
repertoire

	"Return all selectors for the messages I specify"
	
	^self selectors

accessing-classes
implementingClasses


	self isEmptyInterface ifTrue: [^Set new].
	^self environment allNonInterfaceClasses select: [:each | each implements: self]
implementors


	^self implementingClasses
understanders


	^self understandingClasses
understandingClasses


	self isEmptyInterface ifTrue: [^Set new].
	^self environment allNonInterfaceClasses select: [:each | each understands: self]

accessing-extended
ancestors

	"Return all interfaces which I extend (in bredth-first order).
	In other words: the lineage chain from the roots of my 'family tree'."

	| family elders ancestors |
	family := self extendedInterfaces.
		"now put an order within this family; oldest generation first, youngen last..."
	ancestors := OrderedCollection new: family size.
	elders := family select: [:each | each isOrphan].	
	[ancestors addAll: elders.
	family removeAll: elders.
	family notEmpty] whileTrue:
		[elders := family select: [:each | ancestors includesAny: each parents]].
	^ancestors
extendedInterfaces

	"Return all intefaces which I extend directly or indirectly.
	In other words: all my originating interfaces."

	self isEmptyInterface ifTrue: [^Set new].
	^(self home allNonEmptyInterfaces select: 
		[:each | self extends: each]) reject: 
			[:each | self isEquivalentTo: each]	"remove circularities"
extendedInterfacesMinimalSet


	^Interface consolidate: self extendedInterfaces
parents

	"Return my parents, which are the interfaces I immidiately extend.
	Note: a simple (root) interface is an orphan, while a composite 
	interface is a child of unlimitted number of parents."

	^self extendedInterfacesMinimalSet

accessing-extending
children

	"Return my children, which are the interfaces immidiately extending me."

	| family children |
	family := self extenders.
	family isEmpty ifTrue: [^family].
		"now gradually trim the family's youngest generation, until only 
		the oldest generation remains. these are my immediate children."
	[children := Interface consolidate: family.
	family removeAll: children.
	family notEmpty] whileTrue.
	^children
descendants


	^self progeny
extenders

	"Return all intefaces which extend me"

	^self extendingInterfaces
extendingInterfaces

	"Return all intefaces which extend me directly or indirectly.
	In other words: all (composite) interfaces for which I am a progenator."

	self isEmptyInterface ifTrue: [^Set new].
	^(self home allInterfaces select: 
		[:each | each extends: self]) reject: 
			[:each | self isEquivalentTo: each]	"remove circularities"
progeny

	"Return all interfaces which extend me (in bredth-first order).
	In other words: the branches of my 'family tree' eminating from me."

	| family children descendants |
	family := self extenders.
		"now put an order within this family; my children first, their children after ..."
	descendants := OrderedCollection new: family size.
	[children := Interface consolidate: family.	
	descendants addAll: children.
	family removeAll: children.
	family notEmpty] whileTrue.
	^descendants reversed

class creation
asClass


	^self asClassNamed: self defaultClassName
asClassNamed: aSymbol


	^self 
		asClassNamed: aSymbol 
		super: Object
asClassNamed: aSymbol super: aClass

	"SmallInterfaces: ##modified for Squeak -M.U. 6/23/1999 23:35"
	| defaultCategory |
	defaultCategory := InterfaceConfiguration current defaultInterfaceClassCategory.
	aClass isFixed 
		ifTrue:
			[^aClass
				subclass: aSymbol
				instanceVariableNames: ''
				classVariableNames: ''
				poolDictionaries: ''
				category: defaultCategory
				interfaces: self name asString].		
	^aClass isVariable 
		ifTrue:
			[aClass isBits
				ifTrue:
					[aClass
						variableByteSubclass: aSymbol
						instanceVariableNames: ''
						classVariableNames: ''
						poolDictionaries: ''
						category: defaultCategory
						interfaces: self name asString]
				ifFalse:
					[aClass  
						variableSubclass: aSymbol
						instanceVariableNames: ''
						classVariableNames: ''
						poolDictionaries: ''
						category: defaultCategory
						interfaces: self name asString]]
		ifFalse: [self error: 'Sorry, can not handle this type of class.']

code generation
createMethod: selector from: aClass


	| source category |
	source := self methodSourceFor: selector from: aClass.
	category := aClass isNil
		ifTrue: [#repertoire]
		ifFalse: [aClass organization categoryOfElement: selector].
	self compile: source classified: category
createMethods: selectors


	self createMethods: selectors from: nil
createMethods: selectors from: aClass


	selectors do: [:each | self createMethod: each from: aClass]
createStubbedMethodFor: selector from: aClass

	"Create a stub method implementation for a selector in <aClass> on behalf of me."

	| interfaceOwningSelector |
	interfaceOwningSelector := self ancestors 
		detect: [:each | each repertoire includes: selector] 
		ifNone: [self].
	aClass 
		compile: (self methodSourceFor: selector from: self)
		classified: (interfaceOwningSelector defaultClassification)
implementationStringForInterface


	^String newLarge writeStream
		nextPutAll: '^self';
		space;
		nextPutAll: self selectorForStubbedImplementation asString;
		space;
		nextPutAll: self name asString;
		contents
methodSourceFor: selector from: aClass


	^aClass isNil
		ifTrue: 
			[self
				methodSourceWithHeader: selector asSelectorStringWithArguments 
				comment: ''
				implementation: Class implementationStringForInterface]
		ifFalse:
			[self
				methodSourceWithHeader: (aClass>>selector) selectorWithArgumentsString 
				comment: (aClass commentFor: selector)
				implementation: aClass implementationStringForInterface]
methodSourceWithHeader: selectorWithArgumentsString comment: commentString implementation: implementationString


	| writer |
	writer := String newLarge writeStream.
	writer nextPutAll: selectorWithArgumentsString trimSeparators.
	commentString notEmpty 
		ifTrue:
			[writer
				crtab; 
				nextPut: $";
				nextPutAll: commentString;
				nextPut: $"].
	writer
		cr; 
		crtab; 
		nextPutAll: implementationString.
	^writer contents

defaults
defaultClassName

	"This method is called for the purpose of generating a 'real' class from an interface."

	^(self name, 'Implementation') asSymbol
defaultClassification


	^(self name, ' implementation') asSymbol
defaultInterfaceName

	"This method is called for the purpose of generating an interface from a 'real' class.
	Since I am an interface, reaching this method is probably an error."
	
	^self error: 'I am an interface; you should not create an inteface for me!'
selectorForImplementation

	"The selector to be embeded within any method of an Interface"

	^#implementorsResponsibility
selectorForStubbedImplementation

	"This selector is embeded as a stub within a method as initial implementation for an Interface"

	^#shouldImplementFor:

documentation
anOntologyOfInterfacesForSmalltalk4


"Each interface specifies a set of messages, which together constitutes its Repertoire.
Repertoires are not mutually exclusive; a message can be part of many repertoires.

Interfaces come in heterarchies, so that one interface can be declared as being a composite of other interfaces. A composite interface is an interface that extends other interfaces; it inherits message declarations from its extended interfaces, and may add additional declarations of its own. It is also referred to as an extending interface. These interface classifications are not mutually exclusive; an interface can be extended and extending at the same time.

At the top of the heterarchy are root interfaces, which are parentless interfaces; they extend no other interfaces. At the bottom of the heterarchy are the leaf interfaces, which are childless interfaces; no other interfaces extend them. These interface classifications also are not mutually exclusive. Consider the case where an environment contains a single interface; that singleton interface is both a root and a leaf at the same time.

An interface with no repertoire is referred to as an empty interface, and is considered to be an illegitimate interface.

Within a universe, interfaces forms a-cyclical directed graphs that are not necessarily connected.


A class is an understander of an interface (or understanding class) if it can respond to all messages of the interface's repertoire. A class can understand many interfaces, and an interface can be understood by many classes.

A class is an implementor of an interface (or implementing class) if it itself implements the entire interface's repertoire. Thus, being an implementor implies being an understander. A class can implement many interfaces, and an interface can be implemented by many classes."
interfacesAndSmalltalk3


"Interfaces are not about static typing. In principle, they are merely about typing. More specifically, they can be used to solely specify a behavior, detached from data.
The concept of interfaces is central to object-oriented methodologies. It is commonly referred to as Type. The interface of an object is determined by the set of all message sends that an object can respond to. It is therefore orthogonal to the concept of a class that propagates the implementation of a message to its instances. In other words, an interface specifies which messages an object will execute, where a class specifies how those messages will be executed.

Some OO languages have Interface and Class as two distinct concepts. For example, Java reifies both to some extent and includes syntax for defining and implementing interfaces, while Microsoft COM and OMG CORBA both have their own software object interface definition languages (IDLs).

In Smalltalk however, the interfaces of an object are implicit and folded into its class implementation. This is not to say that interfaces in Smalltalk can not be harvested and become tangible, first-class objects. On the contrary, this is exactly what SmallInterfaces sets to achieve - the reification of interfaces in Smalltalk.

For a dynamically typed language like Smalltalk it is sufficient for a message declaration to specify (implicitly) the number of arguments. That is what SmallInterfaces does. However, another scheme could be chosen where the input arguments would be specified together with their order, type, and associated constraints. It would make sense then to specify the return value as well."
tutorial


"I guess the biggest question everybody has is: 
	'How would I use one of 'them interfaces in Smalltalk?'

Within the context of Smalltalk, interfaces can be useful in three major areas: 
	Design, Documentation, and Exploration.
	
For each aspect, see the corresponding tutorial.

Note that all interfaces are classes, and as such can be browsed and modified using a generic browser. So once you have created an interface, you can use a generic browser to add some methods, and/or remove other methods."
tutorialDesigning


"The concept of interfaces can help us do a better job with using Responsibility Driven Design by facilitating a higher level of abstraction than that of a class. The gist of Responsibility Driven Design is that when one designs an object (in the context of a society of objects), one wants to concentrate on what services an object needs to offer to its clients.  What we are really after is figuring out what are the pure 'working relationships' an object has within its society. We do not care about *how* the object is going to work it out, nor what state it needs to maintain in order to do so.  

Each service an object is contracted to supply, or said differently - each role it plays, is embodied within an interface.

So, designing using interfaces can be a mind liberating experience. With interfaces one can better concentrate on the question: 'What are the responsibilities of a given object?' in terms of: 'What should be its repertoire?' 

Designing is then broken down into searching for the answer to: 'What messages this and that are supposed to communicate and understand in order to get a certain functionality/aspect accomplished?'

If we follow this design mode, we have: 
	Responsibilities beget Roles, 
		Roles beget Interfaces,  
			Interfaces beget Objects.


With that in mind, let us put this theory into practice using an example.  

Say you have a domain where you need the ability to price some objects.  Some objects have no price, some have a fixed price, and some have a dynamic price.  The dynamic price may depend on various factors such as time and locale.  Also, that price needs to be quoted in a parameterized way, such as: in a currency, in goods (as in: 'I'll give you three loaves of bread for two of these'), or in services (as in: 'will be president for food').  

An important aspect of these objects is that they can be priced; they are priceable (clink, clink...). Some of these objects have the capability to compute their price; others would use a helper pricer to do the job, and others yet, might do one or the other - depending on the context. What they all have in common is that they all need to understand (and respond to) the following group of messages:
	price
	priceAsOf: aTemporal   (such as Date, Timestamp, etc.)
	priceAsOf: aTemporal quantifyUsing: aTradable   (such as Money, Product, WorkService)
	defaultTemporal
	defaultTradable
	pricer

This group of messages, this repertoire, has semantic meaning on its own, and as such it deserves to be a first class object. We call such reification - an interface. And the above repertoire defines the Priceable interface. From that point on, we no longer need to say: 'Money or Product or WorkService or whatever' - we can refer to those entities as Priceables.

As an exercise, you might want to try and define the Pricer interface.  Note that a pricer for: 5 cubic miles of irrigation water in the Sahara for the summer of 1999 might have very little in common with a pricer for: 10,000 IBM stocks on the New York Exchange for 1/1/2000.
If you still got energy, go a head and define the Tradable and Temporal interfaces. Note that the price answered is a Quantifiable. Define that too.

Can you start to see the advantages of 'thinking' in interfaces?

When you are done with this little design you end up with capturing the core of your business. Furthermore, there is enough content in this design to facilitate some simulations of business scenarios, and by doing so, validating your understanding of the problem at hand.

Maybe you can also imagine that the actual classes that will be used to implement this design would cross hierarchies. For example, some objects' prices will be date-specific, some location-specific, some will be time & location specific, some will have to consider all factors or none - depending on the context when they are asked (like by whom).

Now you can use SmallInterfaces to make the first step in implementing this design - declaring those interfaces.
Using SmallInterfaces you can create interfaces programmatically by one of three ways:
	1. define the interface and its methods directly
	2. define the interface and its methods from a group of interfaces
	3. define the interface and its methods from a class

Using the Priceable interface as an example for the first way, we would execute:
	<Interface 
		newNamed: #Priceable
		withSelectors: #(price priceAsOf: priceAsOf:quantifyUsing: defaultTemporal defaultTradable pricer)>

Using an example from the attached ToyInterfaces package to illustrate the second way, we would execute:
	<Interface 
		newNamed: #ReadableWritable
		extending: 'Readable Writable'
		additionalSelectors: #()>

Now assuming you want to use Magnitude as a template for the Quantifiable interface, you could use the third way and execute:
	<Magnitude asInterfaceNamed: #Quantifiable> 
or:
	<Interface 
		newNamed: #Quantifiable 
		from: Magnitude>

Remember that all interfaces are classes, and can be browsed and modified using the generic browser. So, for example, after creating Quantifiable from Magnitude, you might want to remove some methods, and/or add some others.

Now you are ready for the next step - implementing some classes based on those interfaces.
Assuming you had Priceable & Quantifiable in mind, and you wanted to create Price & Quantity, you would execute something like:
	<Priceable asClassNamed: #Price super: MyDomainObject>
and:
	<Quantifiable asClassNamed: #Quantity>

The Price & Quantity classes would now hold stubbed method implementations for Priceable & Quantifiable repertoires (including comments, if you had any).


All the above operations and more are easily performed using the Interface Browser GUI."
tutorialDocumenting


"Using interfaces we can write a better self-documenting code, since we have a higher level of abstraction at our disposal. We can use interfaces to make the implicit explicit, thus helping the original design surface and stay visible as the code evolves. Their presence should help providing direction for the refactoring process. 

Consider the following implementation snippet for the example in the design section:

WorkService>>priceAsOf: aTemporal quantifyUsing: aTradable		
	^self pricer 
		price: self
		in: self location
		asOf: aTemporal
		quotingIn: aTradable

Notice that pricer, aTemporal, aTradable, and possibly location, represent interfaces. The actual possible objects that can occupy each slot are not necessarily sharing the same hierarchy!

Now consider how the very same code snippet would look without 'thinking in interfaces':

WorkService>>priceAsOf: aDateOrTimeOrTimestamp quantifyUsing: aMoneyOrProductOrWorkService		
	^self pricer 
		price: self
		in: self location
		asOf: aDateOrTimeOrTimestamp
		quotingIn: MoneyOrProductOrWorkService

Which version is better at self-documenting?


Interfaces can also be used in design validation. After specifying a #requiredInterfaces method on the class side of aClass, we now can use <aClass implementsRequiredInterfaces> in our code, like in a testcase: 
	<self should: [someObject class implementsRequiredInterfaces]>


A more explicit way of indicating the original design, is a variation of the #isSomething usage.
For example, all classes that implement Priceable will implement isPriceable to return true, while their superclasses will implement it to return false. Now we can have phrases such as:
	<anObject isPriceable
		ifTrue: [self charge: aCustomer for: anObject]
		ifFalse: [self giveAway: anObject to: aCustomer]>


Also, we can now sprinkle in our code statements like:
	<groupOfObjectsWhichSupposadlyAreKeyable do:
		[:each | 
		(each conformsTo: Keyable)
  			ifTrue: [each at: someplaceSafe put: somethingGood]
				ifFalse: [self giveMe: somethingGood]]>


Note that SmallInterfaces can automate some of these schemes, but does not."
tutorialExploring


"Interfaces can give us another mental navigation tool while browsing the environment. My contention is that if interfaces had been more explicit in Smalltalk then one could have used them to learn a Smalltalk environment faster.
Following are a few examples taken from the VisualWorks environment to illustrate how interfaces could be used in system exploration.

VisualWorks has Model which has a specialized implementation of the Observable interface found in Object. Now let's say you want to find out if the environment has a specialized Observable collection as well. You look and you don't seem to see one under the Model hierarchy. So you might want to create an Observable interface with #myDependents: and #myDependents as its repertoire and search for implementors of Observable. 
To create an Observable interface you would execute:
	<Interface
	newNamed: # Observable
	withSelectors: #(#myDependents: #myDependents)>

To look for its implementors you would execute:
	<Observable implementingClasses> 
Depending on your environment the result would be something like:
	{Object TableAdaptor TwoDList Model WidgetWrapper List ScrollWrapper WeakArray}.
Notice List and WeakArray - they might be what you were looking for. Notice the others too - if you are one of the curious kinds, it might be interesting for you to try and figure why the others have a specialized implementation of the Observable interface.

You can now refine your Observable interface by adding other messages you think are integral to it, and use it as a template to create other observable objects. For example, how about implementing an observable process: one that has dependents who can be notified when it is completed its task (like Promise or Future for asynchronous messaging). Such a class would probably implement a Runnable interface as well...


Another example is related to extending the environment.

If you happened to add your own extensions to base classes you probably extended Dictionary as well. When doing so, did you think it might be useful to add the same extension to KeyedCollection as well?  If not, why? After all, KeyedCollection and Dictionary are both keyable...

A similar connection exists between SequenceableCollection and Stream, especially String and Stream."
whatCanYouDoWithSmallInterfaces5


"1. Declare an interface and specify its behavior. This can be done in three distinct ways:
	- Directly, by specifying its name and selectors. (Look under the ''interface creation'' protocol under Interface.)
	- By composing from other interfaces.
	- By converting a class as a template (Look at the various asInterface* methods under Class.)

2. Declare a class as implementing one or more interfaces. This can be done in two distinct ways:
	- Directly, by adding a 'interfaces: stringOfInterfaceNames' to the class definition. 
	  (Look under the 'compiling' protocols under Class.)
	- By converting an interface to a class (Look at the various as Class* methods under Interface.)
	Both methods will create stubbed methods as necessary on behalf of the implemented interface(s)

3. Given a class, you can ask: 
	- What interfaces does it implement?

4. Given an interface, you can ask: 
	- Which classes understand it? 
	- Which classes implement it?

5. Given an interface, you can ask: 
	- Which interfaces extend it? 
	- Which interfaces it is extending?

6. Given a class and an interface, answer whether the class implements the interface.


Other features and important considerations:

Right now, a class' repertoire is considered to be its instance side repertoire only. A future implementation will separate the instance side repertoire and the class side (metaclass) repertoire as two distinct interfaces. This would be done together with reifying Repertoire.

The classes <--> interfaces relationships as well as interfaces <--> interfaces relationships are of a dynamic nature. This is to say that the web of relationships is always inferred from the actual composition of classes and interfaces every time a query is attempted. This is neat, but also very inefficient, especially when a query for all understanding classes is executed for an interface. Therefore, a caching scheme was implemented in RepertoireHome. As of now, the cache has to be invalidated manually.

When a class is added/changed/removed to/from the environment, all relevant interfaces are immediately affected by the event (causal connection). This is a byproduct of the dynamic relationship inference.

Ideally, when an interface is added/changed/removed to/from the environment, all relevant classes and interfaces should be immediately affected by the event (causal connection).
This ideal is only halfway implemented. For example, existing stubbed methods can be removed (configurable) when a class declares it understands/implements a different set of interfaces. 

Currently, the notion that an interface is a composite is implicit; when a new interface is composed from other interfaces, the repertoires of these interfaces are copied over. 

An empty interface (with no repertoire) is considered to be an illegitimate interface, and an attempt is made to prevent such interfaces from being created. This feature is configured via a flag in InterfaceConfiguration that can be changed. (InterfaceConfiguration contains other flags that can be configured by the user.)"
whatIsAnInterface2


" An interface is an abstract type, unlike class, which is a concrete type. An interface specifies a set of messages that an object of any class implementing it would respond to. Therefore, it is orthogonal to class, which propagates the implementation of a message to its instances. 

Said differently, an interface specifies which messages an object will execute but it has no method implementations for those messages, where a class specifies how those messages will be executed by specifying method implementations for those messages.

Each interface specifies a set of messages, which together constitutes its repertoire. In turn, each message declaration specifies the message's name, and its arguments. For various languages, specifying the arguments for a message can mean different things, and there are many opinions and debates with regard to this issue."
whyShouldYouBotherWithInterfaces1


"In the realm of domain analysis, the use of roles (also known as facets) has emerged as an important technique for classifying the features of objects. Roles reflect the various aspects of the object they describe, and the different roles that an object may play in relationship to other objects. More so, the assignment of responsibilities to an object depends on the role(s) it plays in a system of objects. 

Roles serve as an increasingly important metaphor for communicating object-oriented software designs and recognition of their importance has grown in recent years. For example, the codification of object-oriented software design knowledge in design patterns is founded in part on the metaphor of roles. Software design patterns describe reusable collaborations between design elements. Each design element plays an identifiable role with well-defined responsibilities.

Now, a design process and a programming language work well together when there is support and clean translation from the design process conceptual units to the programming language abstraction and composition mechanisms. An interface is the programming language mechanism that maps the design process role concept. 

The mental process that leads us from design to implementation can be summarized as:
Responsibilities beget Roles, 
Roles beget Interfaces,  
Interfaces beget Objects.

So interfaces are a very basic mechanism for thinking in terms of objects; they both define and organize the services objects provide. This is why designing good interfaces for objects becomes such an important endeavor when building applications using objects. "

errors
basicNew


	self error: 'I am an Interface. I can not be instantiated!'
implementorsResponsibility

	"Besides being an indicator, this method is envoked via: 'anObject shouldImplementFor: anInterface'.
	As a consequence, this message sets up a framework for the behavior of the interface's implementors."

	self error: 'My implementing class should have overridden one of my messages.'


"to facilitate laissez faire programming, one implementation could be:
	1. open an editor on the calling method (allow the user to abort).
	2. accept the source and copile it in the original sending class.
	3. continue execution (restart?)"
new


	self error: 'I am an Interface. I can not be instantiated!'

extending
extendInterface: anInterface

	"SmallInterfaces: ##modified for Squeak -M.U. 6/23/1999 23:35"

	| classification |
	anInterface repertoire do: 
		[:each | 
		classification := anInterface organization categoryOfElement: each.
		(classification == #repertoire or:
		[(self environment hasClassNamed: classification) not])
			ifTrue: [classification := anInterface name].
		self 
			compile: (anInterface sourceCodeAt: each)
			classified: classification]
extendInterfaces: interfaces
 

	self unimplementInterfaces: (self extendedInterfaces - interfaces).
	(Interface consolidate: interfaces) do: [:each | self extendInterface: each]
implementInterfaces: interfaces
 

	self extendInterfaces: interfaces
unimplementInterfaces: interfaces


	interfaces do: [:each | self unimplementInterface: each]

interface calculus
& anInterface


	^self intersectionWith: anInterface
+ anInterface


	^self unionWith: anInterface
- anInterface


	^self differenceFrom: anInterface
differenceFrom: anInterface


	| repertoire interface |
	repertoire := self repertoire reject: [:each| anInterface repertoire includes: each].
	interface := (self home interfaceWithRepertoire: repertoire) 
		ifNil: 
			[Interface 
				newNamed: (self name, 'Minus', anInterface name) asSymbol 
				withSelectors: repertoire].
	^interface
intersectionWith: anInterface


	| repertoire interface |
	repertoire := self repertoire & anInterface repertoire.
	interface := (self home interfaceWithRepertoire: repertoire) 
		ifNil: 
			[Interface 
				newNamed: (self name, 'IntersectionWith', anInterface name) asSymbol 
				withSelectors: repertoire].
	^interface
unionWith: anInterface


	| repertoire interface |
	repertoire := self repertoire + anInterface repertoire.
	interface := (self home interfaceWithRepertoire: repertoire) 
		ifNil: 
			[Interface 
				newNamed: (self name, 'Plus', anInterface name) asSymbol 
				withSelectors: repertoire].
	^interface

interface creation
discardExistingInterfacesNottIn: interfaces

	"SmallInterfaces: ##modified for Squeak -M.U. 6/23/1999 23:35  bug?"
	| interfacesToDiscard | 
	interfacesToDiscard := self implementedInterfaces - interfaces.
	interfacesToDiscard remove: self ifAbsent:[].		"we do not want to unimplement the reciever's addtions"
	self unimplementInterfaces: interfacesToDiscard.
newNamed: aSymbol
 

	"self isPrivateMethod."
	"SmallInterfaces: ##modified for Squeak -M.U. 6/23/1999 23:35"

	self ~~ Interface 
		ifTrue: [self error: 'an interface must be a direct subclass of Interface!!'].
	(self home includesInterfaceNamed: aSymbol) 
		ifTrue: [^self error: aSymbol asString, ' interface already exists!!'].
	^self 
		subclass: aSymbol
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: InterfaceConfiguration current defaultInterfaceClassCategory "M.U. 6/23/1999 23:35"
		interfaces: ''
newNamed: aSymbol extending: stringOfInterfaces additionalSelectors: selectors


	| interface |
	interface := self newNamed: aSymbol.
	interface extendInterfaces: (Interface interfacesFromString: stringOfInterfaces).
	interface createMethods: selectors.
	^interface
newNamed: aSymbol from: aClass


	^self 
		newNamed: aSymbol 
		withSelectors: aClass selectors 
		from: aClass
newNamed: aSymbol withSelectors: selectors


	(selectors isEmpty and:
	[self configuration enforceNonEmptyInterfaces])
		ifTrue: [^self error: 'can not create an empty interface!'].

	^(self newNamed: aSymbol) createMethods: selectors
newNamed: aSymbol withSelectors: selectors from: aClass

	"SmallInterfaces: ##modified for Squeak -M.U. 6/23/1999 23:35 bug?"
	(selectors isEmpty and:
	[self configuration enforceNonEmptyInterfaces])
		ifTrue: [^self error: 'can not create an empty interface!'].

	^(self newNamed: aSymbol)
		createMethods: selectors 
		from: aClass

printing
ancestorsString


	| writer ancestors  |
	writer := String newLarge writeStream.
	(ancestors := self ancestors) notEmpty
		ifTrue:
			[writer 
				crtab; 
				nextPutAll: 'ancestors: {'.
			ancestors do: [:each | writer nextPutAll: each name asString; space].
			writer 
				skip: -1; 
				nextPutAll: '}'].
	^writer contents
definition


	| writer extendedInterfacesSelector extendedInterfaces |
	self == Interface ifTrue: [^super definition].
	
	writer := String newLarge writeStream.
	writer
		nextPutAll: super definition;
		crtab;
		nextPutAll: 'interfaces: ';
		nextPut: $'.
	extendedInterfacesSelector := self configuration selectorForInterfaceInheritance.
	extendedInterfaces := (self perform: extendedInterfacesSelector) asSortedCollection: Class sortBlock.
	extendedInterfaces do: [:each | writer nextPutAll: each name asString; space].
	writer nextPut: $'.
	^writer contents
definitionWithInterfaces


	^self definition
familyString


	^String newLarge writeStream
		nextPutAll: self name asString;
		nextPutAll: self ancestorsString;
		nextPutAll: self progenyString;
		contents
progenyString


	| writer progeny |
	writer := String newLarge writeStream.
	(progeny := self progeny) notEmpty
		ifTrue:
			[writer 
				crtab; 
				nextPutAll: 'progeny: {'.
			progeny do: [:each | writer nextPutAll: each name asString; space].
			writer 
				skip: -1; 
				nextPutAll: '}'].
	^writer contents

querying
methodsImplementedBy: aClass


	^self repertoire & aClass repertoireImplemented
methodsNotImplementedBy: aClass


	^self repertoire - aClass repertoireImplemented
methodsNotUnderstoodBy: aClass


	^self repertoire - aClass repertoire
methodsStubbedIn: aClass


	^self repertoire & (aClass whichSelectorsReferTo: self selectorForStubbedImplementation)

subclass creation
subclass: interfaceName instanceVariableNames: stringOfInstVars classVariableNames: stringOfClassVars poolDictionaries: stringOfPoolNames category: category interfaces: stringOfInterfaces

	"Create or modify an interface so it would adhere to the declared Interfaces."

	| interface |
	interface := self
		subclass: interfaceName
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: category.
	interface implementInterfacesNamed: stringOfInterfaces.		
	^interface
variableByteSubclass: interfaceName instanceVariableNames: stringOfInstVars classVariableNames: stringOfClassVars poolDictionaries: stringOfPoolNames category: category interfaces: stringOfInterfaces

	"Create or modify an interface so it would adhere to the declared Interfaces.
	Note: since an interface must be a subclass"

	^self
		subclass: interfaceName
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: category
 		interfaces: stringOfInterfaces
variableSubclass: interfaceName instanceVariableNames: stringOfInstVars classVariableNames: stringOfClassVars poolDictionaries: stringOfPoolNames category: category interfaces: stringOfInterfaces

	"Create or modify an interface so it would adhere to the declared Interfaces."

	^self
		subclass: interfaceName
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: category
 		interfaces: stringOfInterfaces

testing
extends: anInterface


	^self ~~ anInterface and:
	[self repertoire includesAll: anInterface repertoire]
hasParents

	"A simple interface is an orphan"

	^self parents notEmpty
isEmbodiedIn: anObject


	^anObject conformsTo: self
isEmptyInterface


	^self repertoire isEmpty
isEquivalentTo: anInterface


	^self repertoire consistsOf: anInterface repertoire
isExtended

	"Note: not using 'self extendingInterfaces notEmpty' for speed"

	^self home allInterfaces contains: [:each | self isExtendedBy: each]
isExtendedBy: anInterface


	^anInterface extends: self
isExtending


	^self home allInterfaces contains: [:each | self extends: each]
isImplementedBy: aClass

	"Does <aClass> directly implement all of my repertoire?"

	^aClass repertoireImplemented includesAll: self repertoire
isInterface

	"All subclass are considered as interfeces, excluding the superclass - Interface."

	^self ~~ Interface
isOrphan

	"A composite interface has parents"
	
	^self hasParents not
isUnderstoodBy: aClass

	"Can <aClass> understand all of <anInterface> repertoire?"

	^aClass repertoire includesAll: self repertoire
mustBeImplemented

	"Indicating the way I should be implemented by a class. 
	Consider the case of #hash and #=. How can we indicate that if a class implements one, 
	it should implement the other? (By overriding this method to return true.)
	The default is false, which means it is sufficient that I am understood by the implementing class."

	^false

utilities
consolidate: interfaces

	"out of <interfaces>, return the minimal descriptive set.
	mostly, these are the interfaces which are not extended by any of the others."

	^interfaces select: [:each | (interfaces contains: [:interface | interface extends: each]) not]
interfacesFromString: stringOfInterfaces


	^((stringOfInterfaces subStrings collect: 
		[:each | each asClass]) select: 
			[:each | each notNil]) select: 
				[:each | each isInterface]

^top


- made by Dandelion -