'From Squeak3.0 of 4 February 2001 [latest update: #3545] on 21 June 2001 at 7:36:37 pm'!
"Change Set:		Arrows
Date:			June 16, 2001
Author:			Brian T. Rice (email:water@tunes.org)

This is the Arrows package, consisting of a core set of classes defining the basic arrow relationships, and a utility for managing object references lazily with suspensions and value semantics. This package cannot support fully-general ontologies until TODO's #2 and 3 are complete.

This package requires the WeakSet class added to Squeak 2.9, but otherwise is compatible with any version after 2.0. If necessary, WeakSet can be retrofitted to an older version trivially using a fileOut/fileIn process of the Collections-Weak category.

Note for porting: This code relies in one place on #become: and in a couple of places on #becomeForward:, which may not be supported well in all Smalltalk implementations.

TODO:
	(1) Recover noisy subclasses as results of instance-specific behavior modification to ArrowGraph's instances. (Almost done. See the Unfinished category of classes.)
	(2) Implement a self-hosted but Smalltalk assisted SEXP-eating REPL.
	(3) Integrate the REPL with pattern-matching using arrows as the constraints and term graph construct. This requires the #anyOne and intension system to be completed.
	(4) Create a set of graphical and text-based presentation packages for arrows and graphs, using color and transparent panes to classify the information presented visually."!

Object subclass: #ArrowStub
	instanceVariableNames: 'name '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-Core'!

!ArrowStub commentStamp: '<historical>' prior: 0!
This class provides the default behavior for all parts of the arrow system.  As yet, the only use for it is to provide a system-wide naming protocol for a base-level user-interface (textual sugaring, really). This allows one to see some names when using the Object Explorer to view arrow structures, or for general debugging purposes.
!

ArrowStub subclass: #Arrow
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-Core'!

!Arrow commentStamp: '<historical>' prior: 0!
Arrows reference exactly two objects that must be other arrows.  Arrows are instantiated (as extensional entities) for user-choice purposes only.  This includes calculations and user-interface choices.

References are actually implemented as Reference objects, which are containers for the actual objects desired.  This allows self-reference by arrows and reference on a graph that contains the particular arrow without causing the VM to go into an infinite recursion (this is a Smalltalk-specific problem; Self avoids this primitively).
Also, arrows are immutable: all mutation operations beyond initialization return new instances. (However, arrows are not guaranteed to have unique values, except with respect to certain contexts.)

Instance variables:
	Just to be clear, an arrow "looks" like this:
		tail -> head
	Instantiate it like this:
		t->h, or
		t=>h, or
		t@h, or
		Arrow head: h tail: t, or
		Arrow from: t to: h
	which give you an arrow leading from 't' to 'h'.
	Abstract arrows are made by sending the message 'new' to the class 'Arrow':
		Arrow new
	use it when you don't care what its values are or do not consider it constructively.

NOTE: @ is included for Smalltalk sugaring (due to similarity to Point/Number>>@), and is not necessary.

Protocol:
	isIdentity		identity
	inv				invert
	++				compose
	-> or @			pair arrows as an arrow; analogous to CONS
	*				apply with a graph
	raiseHead		reify the head reference as an arrow
	raiseTail		reify the tail reference as an arrow
	raiseIdentity	reify the identity of the arrow as a node

	coincidesWith:coords:	Provides the co-incidence relationship. x R<i,j> y IFF x[i]==y[j].
	incidesUpon:coord:		Provides the incidence relationship. x R<i> y IFF x[i]==y.

	domainElement		tail		graph-application synonym
	codomainElement	head	graph-application synonym

	source				state-transition synonym for tail
	target, destination	state-transition synonyms for head
!
]style[(1521 404)f1,f1cblack;!

Arrow class
	instanceVariableNames: ''!
ArrowStub subclass: #ArrowFrame
	instanceVariableNames: 'arrows assertions compositions heads inversions nodes objects tails values '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-Frames'!

!ArrowFrame commentStamp: '<historical>' prior: 0!
An ArrowFrame is the closure of information regarding all the elements of a graph that it wraps. It provides the base model of functionality for arrows and graphs by managing their information's implementation transparently. In arrow logic, a frame is the set of knowledge of the ++, inv, and Identity relations over some set of arrows W (i.e. F(W)=(W,I,R,C)). This implementation attempts to do a similar thing for reflective arrow systems in a way that allows for serious flexibility in specification source.

This class is (currently) a singleton whose sole instance is the class variable Instance and which is accessible as 'ArrowWorld' or as 'ArrowFrame lobby'.

However, it is more crucial to the meaning of this type that it manage context-related activities. Basically, this type records information about restrictions in context which makes quicker work of brute-force searches performed as arrow queries.

Instance variables:
	arrows		-<ArrowGraph> that is the basis of the world
	assertions	-<AssertionGraph> extensional graph to provide a place to store facts and
			queries (unverified facts)
	compositions	-<CompositionGraph> denoting the compositions possible in the given world
	graphs		-mapping from apex arrows to graphs that the frame acknowledges;
			without this, graphs have no place in the arrow world
	heads, tails	-<HeadGraph> and <TailGraph> for the world
	inversions	-<InversionGraph> denoting the inversion relations possible in the given world
	nodes		-<MonoidGraph> that constitutes the ground type for the particular world
	objects		-<ObjectGraph> that manages the frame's Smalltalk MOP facility
	values		-<SquareGraph> that constitutes the value representation for the world

TODO:
	Clarify the role of 'graphs'.
	This implementation is completely blind to the notion of multiple worlds. While the only intent of this class is to handle the Smalltalk business of tracking Arrow objects image-wide, it should be friendly to the notion of taking some graph-relationship over it as another virtual world. Using the term 'virtual' however, is not to mean to deprecate its information value WRT the ArrowWorld. It often should allow for more arrows to exist than allocated, giving single arrow objects (regardless of uniqueness of value per object) multiple identities. So...
	(1) Implement a world-creation protocol.
	(2) Implement a reasonable policy for world-inclusion and de-resolution.!
]style[(95 2069 4 250)f1c138036000,f1,f1u,f1!

ArrowStub subclass: #ArrowGraph
	instanceVariableNames: 'apex infinitary intension cache '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-Graphs'!

!ArrowGraph commentStamp: '<historical>' prior: 0!
ArrowGraph has been refactored into two classes. This Stub class defines the set-theoretic operations and the minimum set of graph operations with exception to certain ones that are handled regularly according to set-theoretic operations. See UnionGraph and IntersectionGraph etc.

Basically the protocol remaining in ArrowGraphMain is that which set-theoretic operators can delegate to regularly, as well as those protocol elements which should not be inherited by the set-theoretic types, due to e.g. cache manipulation.

It is intended for all graphs to be subclasses of ArrowGraph, to allow for straightforward testing of type. (i.e. someVariable isKindOf: ArrowGraph) However, there should never be direct instances of ArrowGraph.!

ArrowGraph subclass: #ArrowGraphMain
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-Graphs'!

!ArrowGraphMain commentStamp: '<historical>' prior: 0!
Arrows can always be referenced as members of graphs. Graphs are sets of arrows that are intensionally (and lazily) implemented, so that they may contain an infinite number of arrows. The implementation as for access will be to first search the underlying finite set of chosen arrows. If the arrow is not found there, then the graph 'declaration' is consulted (whether implemented by graphs or SmallTalk objects). If neither of these violates the predication of the arrow, then it is added.

Each graph's contents represent a (possibly reflective) relation, providing the fundamental constraint construct for specification.  Graphs are relative, in that they only represent the resulting relation computed by a declarative inference scheme.  In this way, ArrowGraphs are an implementational hack, in that they encode the information of the arrows they replace (which is represented by its MetaGraph).

Note that the entire protocol in a complete Arrow system can be represented and used as graphs. However, graphs are not special as arrow structures in the semantic sense. They are merely a convenient starting point for this implementation. At the implementation level, ArrowGraphs are merely compact notations for MetaGraphs, with Set-membership encoding the meta-arrows. This makes it a compression algorithm somewhat like f(size)->size/2 +1 where n is the number of references in the structure. Basically the apex encodes all of the domainElements (tails) of the meta-arrows encoded. The implementation plan in general is to create more versatile data structures for encoding arrow structures, until the system is expressive enough to allow fully-general arrow encoding of foreign objects and their structure (part of the function of SmalltalkMOP).

An interpretation of the intensional/extensional distinction is the notion of an inductive vs. co-inductive definition. (Perhaps this should be an abstract superclass of an inductive and a co-inductive pair of class branches.) In an inductive graph, an arrow is an element of the graph if and only if some program can generate it. So, arrows in inductively-defined graphs are constructive expressions. In a co-inductive graph, an arrow is an element of the graph until system interactions result in an inconsistency that invalidates that relationship's existence. This basically amounts to backtracking the supposition of the arrow's existence in the first place. So, it's also an indication of the need for laziness in arrow evaluation.

Notice that ArrowGraphs are extensions/annotations of Arrows, in that each ArrowGraph's apex node is the arrow it annotates. The ArrowGraph as Arrow represents the node of the meta-graph that reifies its structure. 'Its structure' means the notion that each arrow in the graph is there because of another relation that holds between an arrow representing that graph conceptually and those arrows as independent entities.

ArrowGraph is also intended to rely heavily on other classes to perform its work, for complexity's sake. So, as many methods are delegations as possible, which results in some very simple expressions in this type. By contrast, Arrow does nearly everything itself.

Structure:
	apex		This is the arrow in the graph's inclusion relation representation (the meta-
				graph). The graph is essentially an annotation of its apex in another sense.
				Should always satisfy the equation:
					graph apex == graph meta apexNode.
	infinitary	Describes whether the graph is infinitary or finite.
				Iteration behavior is controlled by this.
	intension	Collaborates with arrows from SmalltalkMOP to encode meanings of graphs.
				The intension should be an arrow with exactly the necessary information
				that all of the graph's elements satisfy and no more.
	cache		When extensional, the cache is the immutable set of arrows that the graph is
				intended to represent. When intensional, it is treated as a proper cache.
				The cache can be a <Set> or <WeakSet> transparently to other code.

Protocol:
	Set-theoretic:
	&			Intersection.
	|			Union.
	>=			Superset(graph) of.
	<=			Subset(graph) of.
	=			Equals.
	includes:	Has as an element.
	anyOne		Existential quantifier.
	+			Immutable addition of elements.
	>>			Filtering over a block of Smalltalk code.
	intensionallyIncludes:	Whether the argument semantically belongs.

	Relational:
	inv			Inversion.
	**			Composition.
	*			Application to graphs or arrows (wrapped in singleton graphs).
	restrictedTo:	Restricting the domain to those of some set(graph).

	Book-keeping:
	holdWeakly		coerces the cache to be a <WeakSet>
	holdStrongly	coerces the cache to be a <Set>

TODO:
	Reduce my subclasses to instance-specific behavior for my operations' results.
	Improve the generality and robustness of the interaction between ArrowGraph and MetaGraph. For example, what count for ArrowGraphs should be relative to context, but obviously isn't.!
]style[(4012 13 313 10 176 12 367)f1,f1u,f1,f1u,f1,f1u,f1!

ArrowGraphMain subclass: #ApplicationGraph
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-Relational Ops'!

!ApplicationGraph commentStamp: '<historical>' prior: 0!
This is graph type holds the results of graph applications. It is responsible for ensuring the laziness of the operation by never allocating arrows until they are absolutely necessary. It should keep its results consistent with updates to the original graph. Instances of this graph type represent the result of single applications.

The apex node holds my argument list. The tail is the operator and the head is the argument.

TODO: Complete this implementation so that #applyTo: can delegate to me in the general case.!

ArrowGraphMain subclass: #ApplyToGraph
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-Unfinished'!

!ApplyToGraph commentStamp: '<historical>' prior: 0!
This graph object should abstractly encapsulate the functionality of the #applyTo: protocol of ArrowGraph and subclasses. Basically, it reifies and represents graph-applications to arrows as arrows themselves. Instances of this graph represent single applications.

TODO:
	make sure that it delegates to #applyTo: properly, in order to have, say, metagraphs return their base graphs whenever they are applied to their apex nodes.!

ArrowGraphMain subclass: #BaseToMetaGraph
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-Graphs'!

!BaseToMetaGraph commentStamp: '<historical>' prior: 0!
This graph type encapsulates ArrowGraph>>metaGraph and delegates to MetaGraph to manage the results.!

ArrowGraphMain subclass: #CategoryGraph
	instanceVariableNames: 'nodes identities compositions '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-Unfinished'!

!CategoryGraph commentStamp: '<historical>' prior: 0!
Graphs to represent categories must have special semantics: every arrow must be over a set of nodes that the category graph knows, and no meta-arrows of those arrows can be part of it. Also, the category contains one special identity arrow over each node, so 'identities' and 'nodes' are one-for-one to represent identity mappings. Of course there may be other identity arrows over nodes which are not identity mappings and so are not part of 'identities'. Finally, any composition of two of its arrows must also belong to the category. However, equality of compositions must be supposed and proven or refuted through the use of the 'compositions' graph.!

Arrow subclass: #ConcreteArrow
	instanceVariableNames: 'tail head '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-Core'!

!ConcreteArrow commentStamp: '<historical>' prior: 0!
This type represents arrows made constructively, where the head and tail references are already known. This makes them usable by recursive-access algorithms, but much more difficult to use (without the abstract protocol) for equational pattern matching. Users should not have to manipulate this class explicitly.

Any method directly accessing the head and tail slots must be here.

NOTE about the implementation: ConcreteArrow code is entirely independent of even the existence of ArrowGraph and its variants except where syntactic sugaring is provided to make things simpler to express for the user. In every case, however, ConcreteArrow is only responsible for its own instances and basic operations.
!
]style[(382 49 273)f1,f1cblack;,f1!

ArrowGraphMain subclass: #EpsilonGraph
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-Unfinished'!

!EpsilonGraph commentStamp: '<historical>' prior: 0!
This class should be the basis for a "give me one of these" type statement: an existential quantification. See ArrowGraph>>anyOne.!

Arrow subclass: #EquationalArrow
	instanceVariableNames: 'tailsTo headsTo '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-Unfinished'!

!EquationalArrow commentStamp: '<historical>' prior: 0!
Variant of an abstract arrow which knows arrows that point to it and register themselves for later usage. This is meant to improve query results through extended caching.!

ArrowGraphMain subclass: #FilteredObjectGraph
	instanceVariableNames: 'objectGraph testBlock '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-SmalltalkMOP'!

!FilteredObjectGraph commentStamp: '<historical>' prior: 0!
This graph type represents lazy results of queries on wrapped objects. This class has a strange place in the Arrow class hierarchy because it is a subgraph of its ObjectGraph while at the same time should not inherit from it and is not a proper MetaObjectGraph since it does not hold an operation over WrapperArrows' objects. See also <FilteredGraph>. However, note that FilteredObjectGraph differs from FilteredGraph in requiring that it's arrows be wrappers within the objectGraph originally filtered, and not any intermediate filteredObjectGraph.

Filters are created from any graph and their testBlocks are composed via the >> selector.

Structure:
	objectGraph	<ObjectGraph> or <FilteredObjectGraph> which is the operand of this
			filter. The accessor method always returns the original ObjectGraph in the
			filter chain.
	testBlock	Determines membership by the call 'testBlock value: anArrow object'.
		Example: If all objects of class OrderedCollection are desired, I can use:
			testBlock _ [:object | object class == OrderedCollection]
			so that the mechanism is basically a lazy filter or set comprehension.!
]style[(336 13 771)f1,f1LFilteredGraph Comment;,f1!

ArrowGraphMain subclass: #FilteredOverGraph
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-Graphs'!

!FilteredOverGraph commentStamp: '<historical>' prior: 0!
My graph type implements the #restrictedTo: protocol of ArrowGraphs, which produces subsets of the graph over a restricted set of nodes.!

ArrowGraphMain subclass: #GraphCompositionGraph
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-Relational Ops'!

!GraphCompositionGraph commentStamp: '<historical>' prior: 0!
I represent the graph type of graph composition results.!

ArrowGraphMain subclass: #InductionGraph
	instanceVariableNames: 'kernel monoid '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-Graphs'!

!InductionGraph commentStamp: '<historical>' prior: 0!
This graph type provides a recursive single-threaded test for membership. It should be isomorphic to the natural numbers, and the class supports conversion to and from Smaltlalk naturals. There is basic support for variables instantiated by #anyOne. Note that this class is odd in that it is more concerned with its nodes than with its arrows. However, it's purpose is to encapsulate information over them in a modular way (multiple induction graphs can deal with the same (immutable) objects cleanly).

This is implemented as a relation over a MonoidGraph (actually its frame's ObjectGraph).
!

ArrowGraphMain subclass: #MappingGraph
	instanceVariableNames: 'domain codomain '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-Unfinished'!

!MappingGraph commentStamp: '<historical>' prior: 0!
This graph type knows its domain and codomain graphs and type-checks all arrows according to those choices. It is highly recommended to use this graph along with FilteredGraphs for the domain and codomain.!

ArrowGraphMain subclass: #MetaFrameGraph
	instanceVariableNames: 'frame '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-Frames'!

!MetaFrameGraph commentStamp: '<historical>' prior: 0!
This abstract graph type is the kind for meta-graphs of ArrowFrames, which are used to encode systematic knowledge about a particular universe of arrow information. So, all subclasses of this type encode the various basic relationships among arrows, and also must know of the other relationships among the same arrows. If the graph type does not need to interact in this way, it should be a subtype of MetaGraphGraph.!

MetaFrameGraph subclass: #AssertionGraph
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-Frames'!

!AssertionGraph commentStamp: '<historical>' prior: 0!
Dummy class for the use of the assertions slot of frames. If changes are made to this class, evaluate whether they should be rolled back into MetaFrameGraph which is just as useful. Potentially remove this class if differences from MetaFrameGraph are not found useful or necessary, and update the frame code to use it.!

MetaFrameGraph subclass: #CompositionGraph
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-Frames'!

!CompositionGraph commentStamp: '<historical>' prior: 0!
This graph type encapsulates the #composeElements protocol for frames. It attempts or rather promises a resulting arrow which is the composition of the arrows found as elements of the given domain arrow.!

MetaFrameGraph subclass: #HeadGraph
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-Frames'!

!HeadGraph commentStamp: '<historical>' prior: 0!
This graph type encapsulates the ability to create arrows representing the structure of the head reference of any arrow in the system. See Arrow>>raiseHead.

When an instance is searched, it either finds a meta-head arrow or subsequently asks the arrow itself if it knows.!

MetaFrameGraph subclass: #InversionGraph
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-Frames'!

!InversionGraph commentStamp: '<historical>' prior: 0!
This graph type encapsulates Arrow>>#inv.!

ArrowGraphMain subclass: #MetaGraphGraph
	instanceVariableNames: 'graph '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-Graphs'!

!MetaGraphGraph commentStamp: '<historical>' prior: 0!
This abstract graph type encapsulates all graph types whose function it is to provide information or operations over another specific graph. Common protocol for those types is collected here.!

MetaGraphGraph subclass: #FilteredGraph
	instanceVariableNames: 'testBlock '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-Graphs'!

!FilteredGraph commentStamp: '<historical>' prior: 0!
This graph type represents lazy results of queries on arrows. See also <FilteredObjectGraph>.

Filters are created from any graph and their testBlocks are composed via the >> selector.

Structure:
	<testBlock>	Determines membership by the call 'testBlock value: anArrow'.
		Example: If all arrows whose heads point to foo are desired, I can use:
			testBlock _ [:value | value head == foo]
			so that the mechanism is basically a lazy filter or set comprehension.!
]style[(72 19 372)f1,f1LFilteredObjectGraph Comment;,f1!

MetaGraphGraph subclass: #IdentityGraph
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-Relational Ops'!

!IdentityGraph commentStamp: '<historical>' prior: 0!
This graph encapsulates Arrow>>#identity functionality.!

MetaGraphGraph subclass: #InvertedGraph
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-Relational Ops'!

!InvertedGraph commentStamp: '<historical>' prior: 0!
I wrap a graph to produce a lazy implementation of graph inversion. My instances' operations delegate to the original properly and generically. Also, each instance is unique per argument graph, as in MetaGraph.

In order for a graph type to delegate to InvertedGraph its #invert operation, it must provide #applyTo: and #invertedApplyTo:. Notice that most methods just replace the use of the argument arrow with its inverse. This works in almost every case.!

MetaGraphGraph subclass: #MetaGraph
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-Graphs'!

!MetaGraph commentStamp: '<historical>' prior: 0!
This graph type's arrows represent the relationship that constitute what other graphs are, conceptually. So, all the arrows should lead from one arrow representing the graph to all the arrows which are elements of the graph. This is something that should only be done lazily. Technically, it counts as the graph type of #includes: from ArrowGraph, however iteration over the graph's elements is not always provided except lazily (since it would be impossible to handle in general).

Alternatively, the MetaGraph could be strictly specified, with the graph generated lazily from the MetaGraph's information. This graph could also be called GraphInclusionGraph.

Instance Variables:
	baseGraph -- the object-level ArrowGraph whose graph meta-level this graph represents.!

MetaGraph class
	instanceVariableNames: ''!
ArrowGraphMain subclass: #MetaGraphSansBase
	instanceVariableNames: 'apexNode '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-Graphs'!

!MetaGraphSansBase commentStamp: '<historical>' prior: 0!
This graph type implements a variant of MetaGraph that does not have an explicit baseGraph. In fact, it is intended for this class to be used to instantiate arbitrary graphs by specifying their meta-level structure first.

Instance variables:
	apexNode	This is my potential base-graph's apex. Determined dynamically.!

ArrowGraphMain subclass: #MetaObjectGraph
	instanceVariableNames: 'objectGraph '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-SmalltalkMOP'!

!MetaObjectGraph commentStamp: '<historical>' prior: 0!
This abstract graph type is the kind for meta-graphs of ObjectGraph, which itself is used as a monoid reifying Smalltalk objects. So, all subclasses of this type encode the relationships among objects that define them.

Because ObjectGraph is not implemented as a singleton, this graph type must know the objectGraph that it manages.!

MetaObjectGraph subclass: #ClassInstanceGraph
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-SmalltalkMOP'!

!ClassInstanceGraph commentStamp: '<historical>' prior: 0!
I am the graph type of the class-to-instance relationship.!

MetaObjectGraph subclass: #ClassSubclassGraph
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-SmalltalkMOP'!

!ClassSubclassGraph commentStamp: '<historical>' prior: 0!
I am the graph type of the class-to-subclass (inheritance) relationship.!

MetaObjectGraph subclass: #ClosureResultGraph
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-SmalltalkMOP'!

!ClosureResultGraph commentStamp: '<historical>' prior: 0!
I am the graph type of the mapping of block- and method-closures to their results.

NOTE: The implementation of this type is difficult due to the multiplicity of selector arities. Currently, only completed closures (vice partial closures) are supported. Also, inverse graph application is undecidable in general.!

Arrow subclass: #MonoidArrow
	instanceVariableNames: 'graph '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-Core'!

!MonoidArrow commentStamp: '<historical>' prior: 0!
This arrow type is responsible for grounding arrow structures in worlds by knowing which world it belongs to, since it knows which monoid it belongs to. The head and tail are determined dynamically on the basis of that information.!

ArrowGraphMain subclass: #MonoidGraph
	instanceVariableNames: 'kernel '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-Graphs'!

!MonoidGraph commentStamp: '<historical>' prior: 0!
The arrows of this graph type's instances all lead to and from a single arrow, so they all have the same extensional value, and are all identity arrows. What distinguishes any of these arrows from the others is the presence of meta-arrows: arrows that refer to arrows in this graph. (See InductionGraph for an example.)!
]style[(288 14 17)f1,f1LInductionGraph Comment;,f1!

MonoidGraph subclass: #ObjectGraph
	instanceVariableNames: 'closureTo instanceOf subclassOf slotOf '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-SmalltalkMOP'!

!ObjectGraph commentStamp: '<historical>' prior: 0!
This is a MonoidGraph designed to manage the reification of objects into the Arrow system. The objects are the elements of the monoid graph, and the relations that the Smalltalk VM supports over them are collaborating graphs. Arrow identity in this graph is the same as Smalltalk object identity with exceptions for instantiation of arrows within it.

Those graphs should not be manipulated except through this interface.

Also note that the nature of information is such that it does not handle state as usually presented in Smalltalk without a little assistance. For now, all MetaObjectGraph instances work only for objects which do not have or use their variables. Even accessing of variables can lead to code which mutes their values, so basically safety is impossible in that case.!

MetaObjectGraph subclass: #ObjectInstVarGraph
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-SmalltalkMOP'!

!ObjectInstVarGraph commentStamp: '<historical>' prior: 0!
This is the graph type of mappings from objects to the objects which are their instance variables.

These graph instances are also one of the main focal points of mutability concern for the arrow system. Note that ClassSubclass and ClassInstance are just special cases of this graph that are fundamental to evaluation.

TODO: Implement an immutable model of the mutable state centered here, and support it in the system.!

MetaObjectGraph subclass: #PartialClosureResultGraph
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-SmalltalkMOP'!

!PartialClosureResultGraph commentStamp: '<historical>' prior: 0!
This graph type encapsulates all closures, block and method, full and partial, as one arrow abstraction. ClosureResultGraph has an obvious embedding into me.

This is also the first attempt at creating a structured graph, i.e. one where the arrows are themselves only representatives of other compactified arrow data structures (in this case, graphs).!

ArrowGraphMain subclass: #PluggableGraph
	instanceVariableNames: 'selector args block '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-Graphs'!

!PluggableGraph commentStamp: '<historical>' prior: 0!
This graph type should consist of potentially all graphs which generalizes the inductive relationship that one of the Smalltalk methods of Arrow or ArrowGraph to a more equational semantics.

Structure:
	block	a <BlockContext> taking any input/output arrow pair of other arrows and verifying
			that it fulfills the intension of the graph instance.
!

MetaObjectGraph subclass: #PluggableObjectGraph
	instanceVariableNames: 'selector args block '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-SmalltalkMOP'!

!PluggableObjectGraph commentStamp: '<historical>' prior: 0!
Similar to PluggableGraph, but knows its objectGraph and is of course intended as a MetaObjectGraph to handle things like filters over ObjectGraph and its auxiliaries.

Structure:
	block	-<BlockContext> testing for intensional inclusion by sending 'perform: selector withArguments: args' to the domain arrow and comparing with the codomain arrow. This graph type can also be instantiated with an arbitrary block and no selector/args pair.
	selector, args	-<Symbol>, <Array>: Define what basic application is.!

ArrowGraphMain subclass: #RSTGraph
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-Unfinished'!

!RSTGraph commentStamp: '<historical>' prior: 0!
I am the graph type for RST (=Reflexive, Symmetric, Transitive) relations, which include all equivalence relations. In the terms of arrow logic, I represent the class of relativised square frames. My instances' elements therefore must satisfy:
	a _ R anyOne domainElement
	(1) aRa					R includes: (a raiseIdentity)
	(2) aRb <=> bRa			R includes: (R anyOne inv)
	(3) aRb & bRc => aRc	(x ++ y) ifNotNil: [^ R includes: (x ++ y)] ifNil: [^ false]
within the frame that it basically defines (all graphs form frames).

Incidentally, for every graph Q, the union of Q's inverse and its transitive closure is always an equivalence relation.

It is significant that equivalence relations establish a notion of identity of objects within one theory as expressed within some other theory. In this way, RST is an important basis for forming ontologies.

TODO: Implement it. ;)
	Plans: R is the graph representing the desired relation. Queries over this graph basically would perform a lazy search for a proof that a given arrow is an element of it. It is known from logic programming language implementation experience that the search is obviously deterministic, so opening it up is the ultimate goal. In the meantime, however, symmetry of relations is an obvious point where recursive or iterative search could lead to looping non-deterministically.

!

Object subclass: #Reference
	instanceVariableNames: 'value '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-References'!

!Reference commentStamp: '<historical>' prior: 0!
This is a box class for objects (and by extension, arrows and graphs), to help with creating circular structures and with polymorphism with suspensions. These should support lazy evaluation, and the implementation can be shifted to a lazy block closure instead of a box per se.

Reference is the abstract superclass of both Value- and SuspendedReferences. It provides the common behavior for instance-copying, and allows one to instantiate for both lazy and strict cases using the simpler interface here. You should not be playing with direct instances of me.!

Reference class
	instanceVariableNames: ''!
MessageSend subclass: #SafeMessageSend
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-References'!

!SafeMessageSend commentStamp: '<historical>' prior: 0!
Intended as a safe substitute for BlockContexts or Suspensions for lazy references. It basically protects its potentially mutable receiver object and uses a restricted initialization protocol.!

ArrowGraph subclass: #SetOpsGraph
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-Set Ops'!

!SetOpsGraph commentStamp: '<historical>' prior: 0!
Handles some common protocol between Intersection- and UnionGraphs.!

SetOpsGraph subclass: #IntersectionGraph
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-Set Ops'!

!IntersectionGraph commentStamp: '<historical>' prior: 0!
I represent the result of applying the intersection relation onto pairs of graphs, resulting in set-theoretic intersection (for first-order graphs, anyway).

Whether appropriate or not, it currently uses its apex-node as the argument pairing. TODO: Investigate if this is inline with the rest of the theory and update the theory or implementation as appropriate.!

ArrowGraphMain subclass: #SingletonGraph
	instanceVariableNames: 'singleton '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-Graphs'!

!SingletonGraph commentStamp: '<historical>' prior: 0!
This is the graph type of intensionally single-element graphs. It is implemented for very quick access, since it is meant for combining arrows into graphs one-by-one. This is also essential for polymorphic calls to graphs so that they apply to graphs and arrows equally well.!

MetaFrameGraph subclass: #SquareGraph
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-Frames'!

!SquareGraph commentStamp: '<historical>' prior: 0!
This is a speculative definition of a graph type. It represents pairings of arrows. It is called "square" because the pairing of objects in this graph coincides with the square frame from arrow logic. So, there exists for each two arrows in the domain a unique arrow representing their pairing which is an element of this graph. Furthermore, all pairs of arrows have a unique arrow in this graph. This will likely collaborate with RSTGraph.

What is questionable is the identity of square-pair arrows. They should obviously not be strictly identifiable (via #==) with any arrow that is not in the SquareGraph.
!

Reference subclass: #SuspendedReference
	instanceVariableNames: 'suspension '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-References'!

!SuspendedReference commentStamp: '<historical>' prior: 0!
I am a variant of Reference which uses the instance variable 'value' as a cache for my block closure's return value. I store the block closure as 'suspension', and delegate accessing my value to it on initialization. Instance creation should occur by passing the block to the class, which in turn wraps that block in an instance.
Lazy evaluation is supposed to occur by the following mechanism. 'value' requests should trigger (force) the evaluation of the blocks in each reference. The SuspendedReference forwards 'value' to the block it owns, which in turn should forward it on... however there is no mechanism in the Reference hierarchy yet for ensuring that only the appropriate kinds of blocks are used. One possibility is to meta-program the blocks, providing the interface to the meta-program in the class instantiation protocol. Anyway, SuspendedReferences evaluate to ValueReferences to their answers; this helps ensure that no more than one ValueReference exists for any given object. Naturally, there can be no such protection for SuspendedReferences, since it supposes knowledge of value ahead of time.!

BlockContext variableSubclass: #Suspension
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-References'!
MetaFrameGraph subclass: #TailGraph
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-Frames'!

!TailGraph commentStamp: '<historical>' prior: 0!
This graph type encapsulates the ability to create arrows representing the structure of the tail reference of any arrow in the system. See Arrow>>#raiseTail.

When an instance is searched, it either finds a meta-tail arrow or subsequently asks the arrow itself if it knows.!

ArrowGraphMain subclass: #TopOrBottomGraph
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-Set Ops'!

!TopOrBottomGraph commentStamp: '<historical>' prior: 0!
This abstract graph class represents the top and bottom of the set-theoretic lattice of possible graphs.!

TopOrBottomGraph subclass: #EmptyGraph
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-Set Ops'!

!EmptyGraph commentStamp: '<historical>' prior: 0!
This graph is an intensionally empty one. Methods are only implemented here to speed its run-time use and to prevent errors.!

TopOrBottomGraph subclass: #TopGraph
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-Set Ops'!

!TopGraph commentStamp: '<historical>' prior: 0!
This graph type just contains everything you feed it. It rejects nothing and contains every arrow you test for. This graph type basically represents 'Arrow allSubInstances' (and also any that are not allocated). Note that this graph does not behave normally at all.!

SetOpsGraph subclass: #UnionGraph
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-Set Ops'!

!UnionGraph commentStamp: '<historical>' prior: 0!
I represent the result of applying the union relation onto pairs of graphs, resulting in set-theoretic union (for first-order graphs, anyway).

Whether appropriate or not, it currently uses its apex-node as the argument pairing. TODO: Investigate if this is inline with the rest of the theory and update the theory or implementation as appropriate.!

Reference subclass: #ValueReference
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-References'!

!ValueReference commentStamp: '<historical>' prior: 0!
I am a box for values: a strictly-evaluating reference. I also am a cached result of a block that is wrapped as a SuspendedReference. In either case, I am immutable and attempts to mute me return the result of a request to my class for a new reference.
About my class: requests for references to an object should return any existing reference to that object before allocating a new reference to it. By routing all instantiation through one method which finds one existing duplicate if there is any, all duplications are avoided.!

MonoidArrow subclass: #WrapperArrow
	instanceVariableNames: 'object '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Arrow-SmalltalkMOP'!

!WrapperArrow commentStamp: '<historical>' prior: 0!
This arrow implementation type is solely responsible for managing proxies of objects in the arrow type space. Notice that this arrow has a specialized notion of its head and tail.

Instance Variables:
	object	-the wrapped object
	graph	-the monoid which the arrow is tied to (the objectGraph of various metaObjectGraphs)!


!ArrowStub methodsFor: 'accessing' stamp: 'btr 3/6/2001 18:07'!
name
	"Answers the object's given name."
	^ name! !

!ArrowStub methodsFor: 'accessing' stamp: 'btr 3/18/2001 20:55'!
name: aString 
	"Sets the object's given name to the argument. Type-checking is  
	deliberately omitted, to allow for pretty-printing and generalization of  
	user interface to implmentation via other abstract objects."
	name _ aString.
	^ self! !

!ArrowStub methodsFor: 'initialize' stamp: 'btr 3/28/2001 10:04'!
initialize
	"Support for naming: useful for object browsers."
	name _ String new! !


!Arrow methodsFor: 'accessing' stamp: 'btr 6/10/2001 10:28'!
allMetaArrows
	"Answer every allocated arrow that points to me. 
	TODO: abstract arrows should not need to be skipped.
	TODO: the graph abstraction should not have to be explicitly consulted."
	| temp |
	temp _ WeakSet newFrom: {}.
	Arrow
		allSubInstancesDo: [:each | each class == Arrow
				ifFalse: [(each head = self
							or: [each tail = self])
						ifTrue: [temp add: each]]].
	ArrowGraph
		allSubInstancesDo: [:each | (each includes: self)
			ifTrue: [temp add: (each metaGraph metaArrowFor: self)]].
	^ temp! !

!Arrow methodsFor: 'accessing' stamp: 'btr 5/15/2001 09:58'!
at: anIndex 
	"Answers the reference indexed by the argument. This supports the  
	generalization to multi-arrows. Since this arrow type is abstract, it must pretend to know its slots."
	^ anIndex caseOf: {
		[0] -> [self tail].
		[1] -> [self head]}! !

!Arrow methodsFor: 'accessing' stamp: 'btr 4/4/2001 01:53'!
at: anIndex put: anArrow 
	"Changes the indexed reference to the argument. Type-checking and  
	mutation protection performed by head:tail:. Returns a new arrow."
	^ anIndex caseOf:
		{[0]->[self tail: anArrow].
		[1]->[self head: anArrow]}! !

!Arrow methodsFor: 'accessing' stamp: 'btr 6/10/2001 10:31'!
atBitString: anOrderedCollection 
	"Accesses the arrow obtained by using the addresses specified by each  
	element of the array; so that array must only contain 0's and 1's.  
	e.g. self atBitString: #(1 0 0 1 0 1)."
	| a indexer |
	a _ self.
	"Provide automatic coercion."
	indexer _ anOrderedCollection asArray.
	1
		to: indexer size
		do: [:each | a _ a
						at: (indexer at: each)].
	^ a! !

!Arrow methodsFor: 'accessing' stamp: 'btr 5/27/2001 21:08'!
frame
	"For now, the frame construct and the world construct are the same."
	^ self world! !

!Arrow methodsFor: 'accessing' stamp: 'btr 5/21/2001 11:50'!
head
	"A lot of methods rely on this abstract lazy query."
	self world heads applyTo: self! !

!Arrow methodsFor: 'accessing' stamp: 'btr 4/27/2001 13:10'!
object
	"Designed to handle error cases of trying to treat an ordinary arrow as  
	a wrapper arrow. Return self instead of an error to allow for easy 
	recursion testing. No arrow object will represent itself."
	^ self! !

!Arrow methodsFor: 'accessing' stamp: 'btr 5/21/2001 11:51'!
tail
	"A lot of methods rely on this abstract lazy query."
	self world tails applyTo: self! !

!Arrow methodsFor: 'accessing' stamp: 'btr 5/27/2001 21:01'!
value
	"The responsible world ensures that value comparisons only mean something within the same world / frame. Naturally, values of arrows have value semantics."
	^ self world valueOf: self! !

!Arrow methodsFor: 'accessing' stamp: 'btr 5/15/2001 18:49'!
world
	"This is a recursive method to determine what world an arrow is in  
	without having to perform searches throuh all frames and graphs."
	"For now, perform the search here as last resort."
	^ ArrowFrame allInstances
		detect: [:each | each includes: self]! !

!Arrow methodsFor: 'accessing-synonyms' stamp: 'btr 3/13/2001 17:11'!
codomainElement
	"If I were an element of a function or relation applied as a function,  
	my head would point to the result side."
	^ self head! !

!Arrow methodsFor: 'accessing-synonyms' stamp: 'btr 5/23/2001 21:47'!
destination
	"If I were the element of a category, this is my destination object."
	^ self head! !

!Arrow methodsFor: 'accessing-synonyms' stamp: 'btr 3/13/2001 16:59'!
domainElement
	"If I were an element of a function or relation applied as a function, my tail would point to the argument side."
	^ self tail! !

!Arrow methodsFor: 'accessing-synonyms' stamp: 'btr 3/13/2001 16:59'!
rangeElement
	"If I were an element of a function or relation applied as a function, 
	my head would point to the result side."
	^ self head! !

!Arrow methodsFor: 'accessing-synonyms' stamp: 'btr 5/23/2001 21:27'!
source
	"If I were the element of a category, this is my source object."
	^ self tail! !

!Arrow methodsFor: 'accessing-synonyms' stamp: 'btr 5/23/2001 21:27'!
target
	"If I were the element of a category, this is my destination object."
	^ self head! !

!Arrow methodsFor: 'comparing' stamp: 'btr 5/29/2001 05:51'!
equals: anArrow 
	"Recursive test for value equality on an arrow which has no concrete 
	value."
	^ (self head equals: anArrow head)
		and: [self tail equals: anArrow tail]! !

!Arrow methodsFor: 'converting' stamp: 'btr 5/27/2001 21:07'!
asAbstract
	"I'm already abstractly specified."
	^ self! !

!Arrow methodsFor: 'converting' stamp: 'btr 5/27/2001 21:10'!
asArrow
	"Of course I'm an arrow. Implemented for polymorphism with ArrowGraphs."
	^ self! !

!Arrow methodsFor: 'converting' stamp: 'btr 4/25/2001 11:55'!
asConcrete
	"Finds out if self head and self tail return something coherent. If so,  
	make a concrete version of me and forward pointers to me to the  
	concrete instance."
	^ self
		becomeForward: (ConcreteArrow from: self head to: self tail)! !

!Arrow methodsFor: 'converting' stamp: 'btr 6/10/2001 11:27'!
asGraph
	"This is not conversion per se."
	^ self wrapInGraph! !

!Arrow methodsFor: 'converting' stamp: 'btr 6/15/2001 07:03'!
asGraphForArrow: anArrow 
	"This is not conversion per se. This differs from #asGraph in initializing 
	the apex."
	^ self wrapInGraph apex: anArrow! !

!Arrow methodsFor: 'converting' stamp: 'btr 6/10/2001 11:26'!
asReference
	"This is not conversion per se."
	^ self boxMeUp! !

!Arrow methodsFor: 'initialize' stamp: 'btr 4/25/2001 11:58'!
head: anArrow 
	"Changes the second reference to the argument. Delegates to head:tail:."
	(anArrow isKindOf: Arrow)
		ifFalse: [self error: 'Arrows may only reference other arrows.'].
	^ self head: anArrow tail: self tail! !

!Arrow methodsFor: 'initialize' stamp: 'btr 6/10/2001 11:13'!
head: firstArrow tail: secondArrow 
	"Relies on Arrow class>>head:tail: creating a ConcreteArrow. 
	TODO: implement checking for knowledge of head and tail. 
	UNSAFE AS IS (expect to see this in a debugger near you ;)."
	^ self
		becomeForward: (self class head: firstArrow tail: secondArrow)! !

!Arrow methodsFor: 'initialize' stamp: 'btr 3/18/2001 20:54'!
head: anArrow1 tail: anArrow2 name: aString 
	"Set the receiver's references and given name."
	^ (self head: anArrow1 tail: anArrow2)
		name: aString! !

!Arrow methodsFor: 'initialize' stamp: 'btr 4/25/2001 11:58'!
headKnown
	"Answers whether the receiver has previously determined that it has a  
	unique head value specified.""^ (head isKindOf: Reference) 
	and: [head value isKindOf: Arrow]"
	^ self error: 're-implement this'! !

!Arrow methodsFor: 'initialize' stamp: 'btr 4/25/2001 11:56'!
tail: anArrow 
	"Changes the first reference to the argument. Delegates to head:tail:."
	(anArrow isKindOf: Arrow)
		ifFalse: [self error: 'Arrows may only reference other arrows.'].
	^ self head: self head value tail: anArrow! !

!Arrow methodsFor: 'initialize' stamp: 'btr 4/25/2001 11:59'!
tailKnown
	"Answers whether the receiver has previously determined that it has a  
	unique tail value specified."
	"^ (tail isKindOf: Reference)
		and: [tail value isKindOf: Arrow]"
	^ self error: 're-implement this'! !

!Arrow methodsFor: 'operations' stamp: 'btr 3/29/2001 20:30'!
++ anArrow 
	"Sugaring; polymorphic."
	(anArrow isKindOf: Arrow)
		ifTrue: [^ self compose: anArrow].
	(anArrow isKindOf: ArrowGraph)
		ifTrue: [^ self notYetImplemented].
	^ nil! !

!Arrow methodsFor: 'operations' stamp: 'btr 3/23/2001 12:59'!
-> anArrow 
	"Sugaring; intended to be conceptually similar to Point>>@."
	^ self pairWith: anArrow! !

!Arrow methodsFor: 'operations' stamp: 'btr 4/7/2001 22:25'!
=> anArrow 
	"Sugaring; intended to be conceptually similar to Point>>@."
	^ self pairWith: anArrow! !

!Arrow methodsFor: 'operations' stamp: 'btr 3/12/2001 10:34'!
@ anArrow
	"Sugaring; intended to be conceptually similar to Point>>@."
	^ self pairWith: anArrow! !

!Arrow methodsFor: 'operations' stamp: 'btr 6/10/2001 09:50'!
addToGraph: anArrowGraph 
	"Both #add: and #addToGraph: return the arrow vice the graph for compatibility with Smalltalk collection class behavior."
	"This ensures that a == a addToGraph: b == b add: a."
	^ anArrowGraph add: self! !

!Arrow methodsFor: 'operations' stamp: 'btr 3/23/2001 13:01'!
compose: anArrow 
	"Answers the arrow composition of two arrows, the receiver being the  
	second arrow in the sequence and the argument the first."
	(anArrow isKindOf: Arrow)
		ifFalse: [self error: 'Arrows can only be composed with other arrows.'].
	self head == anArrow tail
		ifTrue: [^ self tail -> anArrow head].
	"Don't return self, as it would be confused with an appropriate result."
	^ nil! !

!Arrow methodsFor: 'operations' stamp: 'btr 6/10/2001 14:38'!
composeElements
	"Abstract specification of the composition of elements is not yet handled."
	self notYetImplemented! !

!Arrow methodsFor: 'operations' stamp: 'btr 6/6/2001 18:22'!
identity
	"The simplest possible operation."
	^ self! !

!Arrow methodsFor: 'operations' stamp: 'btr 3/2/2001 20:49'!
inv
	"Sugaring."
	^ self invert! !

!Arrow methodsFor: 'operations' stamp: 'btr 6/16/2001 09:59'!
inverse
	"Sugaring."
	^ self invert! !

!Arrow methodsFor: 'operations' stamp: 'btr 5/26/2001 11:58'!
invert
	"Answers a new arrow with transposed references."
	^ self head -> self tail! !

!Arrow methodsFor: 'operations' stamp: 'btr 6/10/2001 09:55'!
pairWith: anArrow 
	"Answers #(self anArrow) as an arrow. This should be compatible with  
	all of my subclasses without modification. #-> is a sugaring of this."
	(anArrow isKindOf: Arrow)
		ifFalse: [^ nil].
	^ Arrow head: anArrow tail: self! !

!Arrow methodsFor: 'operations' stamp: 'btr 3/23/2001 13:01'!
raiseNode
	"Create an identity over me. Deprecated for now to raiseIdentity."
	^ self -> self! !

!Arrow methodsFor: 'reifications' stamp: 'btr 6/10/2001 09:56'!
raise: aSelector 
	"This is the basis for all reifications."
	((aSelector isKindOf: Symbol) not
			or: [aSelector numArgs < 0])
		ifTrue: [^ self error: aSelector asString , ' is not a valid selector.'].
	^ self
		-> (self perform: aSelector)! !

!Arrow methodsFor: 'reifications' stamp: 'btr 6/6/2001 18:18'!
raiseHead
	"This performs the basic operation of reifying the head reference as an Arrow. Related context management of the result should be handled with a HeadGraph. This evaluates self head value"
	^ self -> self head! !

!Arrow methodsFor: 'reifications' stamp: 'btr 4/2/2001 12:59'!
raiseIdentity
	"Create an identity over me. This does NOT evaluate my references."
	^ self -> self! !

!Arrow methodsFor: 'reifications' stamp: 'btr 6/6/2001 18:18'!
raiseTail
	"This performs the basic operation of reifying the tail reference as an 
	Arrow. Related context management of the result should be handled 
	with a TailGraph. This evaluates self tail value"
	^ self -> self tail! !

!Arrow methodsFor: 'reifications' stamp: 'btr 6/10/2001 14:38'!
raiseValue
	"The arrow leading from me to my value."
	^ self -> self value! !

!Arrow methodsFor: 'testing' stamp: 'btr 6/6/2001 18:25'!
coincidesWith: anArrow coords: aPoint 
	"Provides the co-incidence relationship. x R<i,j> y IFF x[i]==y[j].
	e.g. (a -> b) coincidesWith: (b -> c) coords: 1@0"
	^ (self at: aPoint x)
		== (anArrow at: aPoint y)! !

!Arrow methodsFor: 'testing' stamp: 'btr 6/10/2001 09:57'!
incidesUpon: anArrow 
	"Sugaring; also similarity with #coincidesWith:coords:"
	^ self references: anArrow! !

!Arrow methodsFor: 'testing' stamp: 'btr 3/18/2001 01:46'!
incidesUpon: anArrow coord: anIndex 
	"Provides the incidence relationship. x R<i> y IFF x[i]==y."
	^ self at: anIndex == anArrow! !

!Arrow methodsFor: 'testing' stamp: 'btr 6/15/2001 07:00'!
isApexOfGraph
	"This is the most general algorithm for finding all graphs using me as  
	an apex arrow. Frames should introduce specialized versions to form a 
	constructor for context-restriction."
	ArrowGraph
		allSubInstancesDo: [:eachGraph | eachGraph apex == self
				ifTrue: [^ true]].
	^ false! !

!Arrow methodsFor: 'testing' stamp: 'btr 6/2/1999 12:00'!
isCompositionOf: anArrow1 and: anArrow2 
	"Syntactic sugar."
	^ self isCompositionOf: anArrow1 with: anArrow2! !

!Arrow methodsFor: 'testing' stamp: 'btr 6/10/2001 10:01'!
isCompositionOf: firstArrow with: secondArrow 
	"Answers whether the receiver is a valid composition result of the  
	arguments in the given order."
	"^ firstArrow coincidesWith: secondArrow coords: 0@1"
	^ self equals: (firstArrow ++ secondArrow)! !

!Arrow methodsFor: 'testing' stamp: 'btr 6/13/2001 21:52'!
isElementOf: anArrowGraph
	"Sugaring."
	^ anArrowGraph includes: self! !

!Arrow methodsFor: 'testing' stamp: 'btr 6/10/2001 09:48'!
isIdentity
	"Answers whether the receiver's references are identical. Identity  
	arrows represent nul information transitions."
	"^ self coincidesWith: self coords: 0@1"
	^ self head == self tail! !

!Arrow methodsFor: 'testing' stamp: 'btr 6/10/2001 10:03'!
isInverseOf: anArrow 
	"Answers whether the receiver is a valid inverse of the argument."
	"^ self raiseIdentity isCompositionOf: self with: anArrow"
	^ self inv equals: anArrow! !

!Arrow methodsFor: 'testing' stamp: 'btr 3/28/2001 09:46'!
isNodeTo: anArrowGraph 
	"Sugaring; another delegation to a graph."
	^ anArrowGraph treatsAsNode: self! !

!Arrow methodsFor: 'testing' stamp: 'btr 6/13/2001 14:52'!
isWrapper
	"Wrappers form a strict tower, so any arrow answering itself will not be 
	a wrapper arrow."
	^ self object ~~ self! !

!Arrow methodsFor: 'testing' stamp: 'btr 4/7/2001 22:12'!
references: anArrow 
	"Answers whether or not the receiver points to the argument."
	^ (self head == anArrow)
		or: [self tail == anArrow]! !

!Arrow methodsFor: 'wrapping' stamp: 'btr 3/28/2001 09:49'!
boxMeUp
	"Sugaring."
	^ Reference to: self! !

!Arrow methodsFor: 'wrapping' stamp: 'btr 6/10/2001 11:25'!
wrapInGraph
	"Answer a graph whose meaning is that I am its contents."
	^ SingletonGraph of: self! !

!Arrow methodsFor: 'adding' stamp: 'btr 6/18/2001 17:03'!
+ anArrow 
	"Polymorphic operator to construct graphs. This assumes no intension 
	other than user-driven composition."
	(anArrow isKindOf: Arrow)
		ifTrue: [^ self asGraph | anArrow asGraph].
	^ (anArrow isKindOf: ArrowGraph)
		ifTrue: [anArrow addImmutable: self]
		ifFalse: [self error: 'Arrows can only be composed with other arrows and graphs.']! !


!Arrow class methodsFor: 'accessing' stamp: 'btr 3/28/2001 09:52'!
null
	"Answer a nul arrow, distinct from an arrow pointing to a ground arrow."
	^ self head: nil tail: nil! !

!Arrow class methodsFor: 'accessing' stamp: 'btr 5/27/2001 21:10'!
unspecified
	"New arrow instances have no information in their head and tail."
	^ self new! !

!Arrow class methodsFor: 'instance creation' stamp: 'btr 4/11/2001 23:56'!
from: tailArrow
	"Create a new arrow according to this sugaring."
	^ self head: nil tail: tailArrow! !

!Arrow class methodsFor: 'instance creation' stamp: 'btr 4/4/2001 01:36'!
from: tailArrow to: headArrow 
	"Create a new arrow according to this sugaring."
	^ self head: headArrow tail: tailArrow! !

!Arrow class methodsFor: 'instance creation' stamp: 'btr 4/2/2001 12:39'!
head: firstArrow tail: secondArrow 
	"Create a new arrow and initialize it."
	^ ConcreteArrow new head: firstArrow tail: secondArrow! !

!Arrow class methodsFor: 'instance creation' stamp: 'btr 4/11/2001 23:56'!
to: headArrow 
	"Create a new arrow according to this sugaring."
	^ self head: headArrow tail: nil! !

!Arrow class methodsFor: 'instance creation' stamp: 'btr 4/24/2001 18:37'!
wrapping: anObject in: anObjectGraph 
	"Introduce a wrapper for any object."
	^ WrapperArrow for: anObject in: anObjectGraph! !


!ArrowFrame methodsFor: 'accessing' stamp: 'btr 5/27/2001 21:14'!
arrows
	"The core graph of arrows that I represent."
	^ arrows! !

!ArrowFrame methodsFor: 'accessing' stamp: 'btr 6/10/2001 10:52'!
assertions
	^ assertions! !

!ArrowFrame methodsFor: 'accessing' stamp: 'btr 5/29/2001 06:03'!
compositions
	"A graph representing abstractly-specified composition relationships."
	^ compositions! !

!ArrowFrame methodsFor: 'accessing' stamp: 'btr 6/10/2001 10:51'!
graphs
	"A variable of dubious use at the moment. 'Arrows' itself is a graph that 
	can be itself a composition of others, so graph semantics are usable, 
	but not reifiable. This variable seeks to make that reification possible. 
	TODO: determine where this fits."
	"^ graphs"! !

!ArrowFrame methodsFor: 'accessing' stamp: 'btr 5/8/2001 00:02'!
heads
	^ heads! !

!ArrowFrame methodsFor: 'accessing' stamp: 'btr 5/29/2001 06:03'!
inversions
	"A graph representing abstractly-specified inversion relationships."
	^ inversions! !

!ArrowFrame methodsFor: 'accessing' stamp: 'btr 5/27/2001 21:14'!
nodes
	"The ground type handler for the frame. Abstract arrows can use this as a fallback."
	^ nodes! !

!ArrowFrame methodsFor: 'accessing' stamp: 'btr 6/10/2001 14:40'!
objects
	"My objectGraph (my reflective interface handle)."
	^ objects! !

!ArrowFrame methodsFor: 'accessing' stamp: 'btr 5/8/2001 00:02'!
tails
	^ tails! !

!ArrowFrame methodsFor: 'accessing' stamp: 'btr 5/27/2001 21:13'!
valueOf: anArrow 
	"Frames should know the values of their arrows without the client objects having to know a frame's structure."
	^ values valueOf: anArrow! !

!ArrowFrame methodsFor: 'initialize' stamp: 'btr 6/10/2001 11:03'!
graph: anArrowGraph 
	"Mutation protection is all that is provided for frames. Frames cannot be 
	unique per graph since they represent informational interpretations  
	over that set. Of course this means the frame protocol needs to be  
	expanded to express these kinds of different possible interpretations."
	(anArrowGraph isKindOf: ArrowGraph)
		ifFalse: [^ self error: 'Frames must be based on graphs.'].
	arrows
		ifNotNil: [^ ArrowFrame for: anArrowGraph].
	arrows _ anArrowGraph! !

!ArrowFrame methodsFor: 'initialize' stamp: 'btr 6/15/2001 19:40'!
initialize
	"This initialization method is odd in that it sets up a lot of variables. Note 
	that #initialize should not be called in user code;  
	ArrowFrame >> #graph: and ArrowFrame class >> #for: initialize  
	automatically."
	| root |
	super initialize.
	root _ Arrow new.
	root head: root tail: root;
		 name: 'Root Node'.
	arrows
		ifNil: [arrows _ ArrowGraph new holdWeakly].
	assertions _ AssertionGraph over: self.
	compositions _ CompositionGraph over: self.
	inversions _ InversionGraph over: self.
	nodes _ MonoidGraph of: root.
	objects _ ObjectGraph newFromArrow: nodes anyOne.
	tails _ TailGraph over: self.
	heads _ HeadGraph over: self.
	values _ SquareGraph over: self.
	arrows add: root! !

!ArrowFrame methodsFor: 'initialize' stamp: 'btr 6/15/2001 19:34'!
name: aString 
	"Protected mutator for frames' names. TODO: make this redundant by 
	the equivalent of Dictionaries reified as arrow objects (graphs from  
	Smalltalk symbols to values)."
	name
		ifNotNil: [self error: 'I already have a name.'].
	name _ aString asString! !

!ArrowFrame methodsFor: 'testing' stamp: 'btr 5/8/2001 14:26'!
includes: anArrow
	"The frame is the closure of all of the information of the ArrowGraph it wraps, so this catch-all method allows for getting that information transparently. Alternatively, the frame structure can be accessed publically for more refined searches by the sender."
	(arrows includes: anArrow) ifTrue: [^true].
	(nodes includes: anArrow) ifTrue: [^true].
	(heads includes: anArrow) ifTrue: [^true].
	(tails includes: anArrow) ifTrue: [^true].
	^ values includes: anArrow! !


!ArrowFrame class methodsFor: 'accessing instances and variables' stamp: 'btr 6/6/2001 15:41'!
lobby
	"My sole or default instance can be referred to as 'ArrowWorld'."
	^ Smalltalk at: #ArrowWorld! !

!ArrowFrame class methodsFor: 'class initialization' stamp: 'btr 6/10/2001 12:08'!
initialize
	"ArrowFrame initialize."
	"Provides a default arrow frame to play with, which can be directly  
	referred to as 'ArrowWorld'. Try this: 'ArrowWorld explore.'"
	Smalltalk at: #ArrowWorld put: (self new name: 'The Arrow Lobby';
			 initialize)! !

!ArrowFrame class methodsFor: 'instance creation' stamp: 'btr 6/10/2001 11:05'!
for: anArrowGraph 
	"Frames are not even unique per graph handled. Beware. However,  
	mutation is certainly protected."
	^ self new graph: anArrowGraph; initialize! !

!ArrowFrame class methodsFor: 'instance creation' stamp: 'btr 6/10/2001 11:09'!
for: anArrowGraph named: aString
	"Frames are not even unique per graph handled. Beware. However,  
	mutation is certainly protected."
	^ self new graph: anArrowGraph;
		name: aString;
		 initialize! !


!ArrowGraph methodsFor: 'accessing' stamp: 'btr 4/12/2001 16:34'!
anyOne
	"Returns an example member of this graph. First look for examples in  
	the cache; if none are there, make up an arrow if the set is  
	intensional. Later, it may be proven that this arrow is not consistent  
	with the definition of the graph or is identical to another instance;  
	handling the inconsistency is deferred until then.  
	NOTE: Any graph subclass implementing this should ensure that self  
	anyOne satisfies self intensionallyIncludes:."
(	self isIntensional and: [cache isNil])
		ifTrue: [^ self add: Arrow new].
	^ cache anyOne! !

!ArrowGraph methodsFor: 'accessing' stamp: 'btr 6/15/2001 07:00'!
apex
	"An accessor; initializing the apex arrow implicitly is debatable."
	apex
		ifNil: [^ apex _ Arrow new].
	^ apex! !

!ArrowGraph methodsFor: 'accessing' stamp: 'btr 6/15/2001 07:03'!
apex: anArrow 
	"Protected mutation. Avoid if at all possible effects on the annotated  
	arrow."
	(anArrow isKindOf: Arrow)
		ifFalse: [(anArrow isKindOf: ArrowGraph)
				ifTrue: [^ self apex: ArrowGraph apex].
			^ self error: 'Only arrows can be used to instantiate graphs.'].
	apex
		ifNil: [apex _ anArrow.
			^ self].
	"Use an identity filter to make the new graph without copying over the  
	apex variable."
	^ self identity apex: anArrow! !

!ArrowGraph methodsFor: 'accessing' stamp: 'btr 3/28/2001 10:00'!
cache
	"Allow collaborating graphs to manipulate my cache if necessary.
	If security is an issue, check all calls to this method."
	^ cache! !

!ArrowGraph methodsFor: 'accessing' stamp: 'btr 6/10/2001 14:43'!
frame
	"Worlds and frames are synonymous."
	^ self world! !

!ArrowGraph methodsFor: 'accessing' stamp: 'btr 6/15/2001 07:01'!
world
	"This is a recursive method to determine what world a graph is in  
	without having to perform searches throuh all frames and graphs."
	"For now, assume that the graph belongs to the same world as its  
	apex."
	^ self apex world! !

!ArrowGraph methodsFor: 'adding' stamp: 'btr 3/26/2001 23:24'!
+ anArrow 
	"Sugaring; #add: was not sugared this way because it resembles Collection>>add: rather than Number>>+."
	^ self addImmutable: anArrow! !

!ArrowGraph methodsFor: 'adding' stamp: 'btr 5/27/2001 14:29'!
add: anArrow 
	"This modifies the cache of the graph to include the argument as well. It 
	is not meant to represent actual addition of elements to an enumerated  
	(extensional) graph, so the argument must satisfy the receiver's  
	intension. Provide the proof incrementally and intensionally."
	(anArrow isKindOf: Arrow)
		ifFalse: [self error: 'ArrowGraphs can only contain arrows'].
	(self intensionallyIncludes: anArrow)
		ifFalse: [self error: 'This arrow does not satisfy the graph definition.'].
	(cache isNil or: [cache size = 0])
		ifTrue: [^ cache _ WeakSet with: anArrow].
	^ cache add: anArrow!
]style[(5 7 3 280 3 7 11 5 14 4 8 37 5 4 24 7 14 4 8 51 52 5 3 7 7 7 6 5 6 7)f1b,f1cblack;b,f1,f1c146044000,f1,f1cblack;,f1,f1cblack;,f1,f1cblack;,f1,f1cblue;,f1,f1cblack;,f1,f1cblack;,f1,f1cblack;,f1,f1cblue;,f1,f1cblack;,f1,f1cblack;,f1,f1cblack;,f1,f1cblack;,f1,f1cblack;! !

!ArrowGraph methodsFor: 'adding' stamp: 'btr 6/13/2001 14:16'!
addImmutable: anArrow 
	"Supports immutability and reification of extensional graph structure as  
	arrows. Note that this returns the resulting collection instead of the  
	added element, so it is unlike add:."
	(self intensionallyIncludes: anArrow)
		ifTrue: [self add: anArrow.
			^ self].
	^ UnionGraph of: (SingletonGraph of: anArrow) with: self! !

!ArrowGraph methodsFor: 'comparing' stamp: 'btr 3/26/2001 23:59'!
<= anArrowGraph 
	"Sugaring."
	^ self isSubGraphOf: anArrowGraph! !

!ArrowGraph methodsFor: 'comparing' stamp: 'btr 3/26/2001 23:59'!
>= anArrowGraph
	"Sugaring."
	^ self isSuperGraphOf: anArrowGraph! !

!ArrowGraph methodsFor: 'comparing' stamp: 'btr 6/10/2001 14:41'!
isSubGraphOf: anArrowGraph 
	"This class exists to separate out the non-set-theoretic protocol."
	self subclassResponsibility! !

!ArrowGraph methodsFor: 'comparing' stamp: 'btr 6/10/2001 14:41'!
isSuperGraphOf: anArrowGraph 
	"This class exists to separate out the non-set-theoretic protocol."
	self subclassResponsibility! !

!ArrowGraph methodsFor: 'converting' stamp: 'btr 6/15/2001 07:01'!
asArrow
	"Not a conversion per se. The apex is the arrow this graph is an  
	annotation for, so they are not identical semantically.  
	TODO: re-evaluate the apex identification."
	^ self apex! !

!ArrowGraph methodsFor: 'converting' stamp: 'btr 6/15/2001 19:33'!
asFrame
	"Answer a frame representing me with no default semantics."
	^ ArrowFrame for: self! !

!ArrowGraph methodsFor: 'converting' stamp: 'btr 6/11/2001 10:23'!
asGraph
	"Supports the coercion of arrows to singleton graphs."
	^ self! !

!ArrowGraph methodsFor: 'converting' stamp: 'btr 6/15/2001 07:03'!
asGraphForArrow: anArrow 
	"Supports the coercion of arrows to singleton graphs coupled with 
	specification of the apex."
	^ self identity apex: anArrow! !

!ArrowGraph methodsFor: 'converting' stamp: 'btr 4/10/2001 22:07'!
asMetaStructure
	"Provide a downward method of reifying an arrow structure when 
	taking it to be the meta-graph (or structure in general) of the resulting 
	graph. "
	^ self as: MetaGraphSansBase! !

!ArrowGraph methodsFor: 'converting' stamp: 'btr 6/15/2001 07:01'!
asReference
	"This doesn't quite make sense. I also want to pass around graphs in a 
	boxed style. However, there is no direct use for that yet."
	^ Reference to: self apex! !

!ArrowGraph methodsFor: 'converting' stamp: 'btr 6/13/2001 15:39'!
asSet
	"Provide the ability to strip away the graph semantics overhead if 
	needed, while protecting against unsafe mutation."
	^ cache clone! !

!ArrowGraph methodsFor: 'initialize' stamp: 'btr 6/12/2001 07:06'!
cache: aCollection 
	"Sets the cache to a known set. Type-checking is not implemented yet.  
	Note that this method allows for non-weak sets, which is what is desired 
	in many cases for initialization.  
	TODO: Protect mutation according to a high-level policy."
	(cache isNil not
		and: [cache isEmpty not])
		ifTrue: [^ self class newFrom: aCollection].
	cache _ aCollection asSet
				select: [:each | each isKindOf: Arrow]!
]style[(7 11 3 242 58 33 4 5 3 11 20 6 2 4 11 5 1)f1b,f1cblack;b,f1,f1c148046000,f1,f1c148046000,f1,f1cblack;,f1,f1cblack;,f1,f1cblack;,f1,f1cblack;,f1,f1cblack;,f1! !

!ArrowGraph methodsFor: 'operations' stamp: 'btr 6/12/2001 07:01'!
* anArrow 
	"Sugaring; polymorphic."
	(anArrow isKindOf: Arrow)
		ifTrue: [^ self applyTo: anArrow].
	(anArrow isKindOf: ArrowGraph)
		ifTrue: [^ self applyToGraph: anArrow].
	^ nil!
]style[(2 7 3 24 41 4 10 7 5 7 11 10 15 4 15 7 6 3)f1b,f1cblack;b,f1,f1c148046000,f1,f1cblack;,f1,f1cblack;,f1,f1cblack;,f1,f1cblack;,f1,f1cblack;,f1,f1cblack;,f1,f1cblack;! !

!ArrowGraph methodsFor: 'operations' stamp: 'btr 3/26/2001 23:40'!
** anArrowGraph
	"Sugaring."
	^ self graphCompose: anArrowGraph! !

!ArrowGraph methodsFor: 'operations' stamp: 'btr 6/11/2001 10:25'!
++ anArrow 
	"Sugaring; polymorphic over-riding of Arrow>>++."
	(anArrow isKindOf: ArrowGraph)
		ifTrue: [^ self graphCompose: anArrow].
	^ nil! !

!ArrowGraph methodsFor: 'operations' stamp: 'btr 6/21/2001 01:16'!
>> aBlockContext 
	"Sugaring."
	^ self filteredBy: aBlockContext! !

!ArrowGraph methodsFor: 'operations' stamp: 'btr 6/15/2001 06:57'!
identity
	"Answer my (intensional) self. This is preferred over cloning to allow 
	cache synchronization."
	^ self
		>> [:value | true]! !

!ArrowGraph methodsFor: 'operations' stamp: 'btr 3/26/2001 23:22'!
inv
	"Sugaring."
	^ self invert! !

!ArrowGraph methodsFor: 'operations' stamp: 'btr 3/26/2001 23:21'!
invert
	"Answers a new graph with arrows in the opposite configuration of the  
	receiver."
	^ InvertedGraph of: self! !

!ArrowGraph methodsFor: 'operations' stamp: 'btr 4/27/2001 13:16'!
transitiveClosure
	"Answer the graph that would result if I were composed with myself ad  
	infinitum. This is a method to support recursion.  
	i.e. self transitiveClosure = self | self ** self | self ** self ** self | ... ."
	^ self notYetImplemented! !

!ArrowGraph methodsFor: 'set operations' stamp: 'btr 6/13/2001 13:23'!
& anArrowGraph 
	"Set-theoretic intersection."
	^ IntersectionGraph of: self with: anArrowGraph! !

!ArrowGraph methodsFor: 'set operations' stamp: 'btr 6/13/2001 13:23'!
| anArrowGraph 
	"Set-theoretic union."
	^ UnionGraph of: self with: anArrowGraph! !

!ArrowGraph methodsFor: 'testing' stamp: 'btr 3/28/2001 09:56'!
contains: anArrow
	"Sugaring; supports the notion of graph as a space."
	^ self includes: anArrow! !

!ArrowGraph methodsFor: 'testing' stamp: 'btr 6/13/2001 19:28'!
holdsStrongly
	^ cache class isWeak not! !

!ArrowGraph methodsFor: 'testing' stamp: 'btr 6/13/2001 19:28'!
holdsWeakly
	^ cache class isWeak! !

!ArrowGraph methodsFor: 'testing' stamp: 'btr 6/13/2001 12:10'!
intensionallyIncludes: anArrow 
	"Default answer for all graphs; subclasses should override according to  
	their semantic intent."
	"TODO: alter this to use 'intension' (which requires building an intension system first)."
	^ self isIntensional! !

!ArrowGraph methodsFor: 'testing' stamp: 'btr 6/13/2001 12:11'!
intensionallyIncludes: anArrow using: aSelector 
	"This is an abstract method parametrized by the selector that the class  
	knows it encodes. This begs to have reflective equational semantics."
	"^ anArrow tail <foo> = anArrow head."
	"^ anArrow domainElement <foo> = anArrow rangeElement."
	"^ domainElement -(foo)-> rangeElement at anArrow."
	^ (anArrow tail perform: aSelector)
		= anArrow head! !

!ArrowGraph methodsFor: 'testing' stamp: 'btr 5/26/2001 08:55'!
intensionallyIncludes: anArrow using: aSelector withArgs: anArray 
	^ (anArrow tail perform: aSelector withArguments: anArray) = anArrow head! !

!ArrowGraph methodsFor: 'testing' stamp: 'btr 3/27/2001 00:37'!
isDegenerate
	"Answers whether the graph 'speaks about' its own arrows. If true, then 
	the graph cannot represent a first-order relation."
	^ self hasMetaArrowsFor: self! !

!ArrowGraph methodsFor: 'testing' stamp: 'btr 6/13/2001 13:07'!
isExtensional
	"Graphs without intensions are extensional. See #isIntensional."
	^ intension isNil not! !

!ArrowGraph methodsFor: 'testing' stamp: 'btr 3/27/2001 00:57'!
isFinite
	"Answers whether the internal cache should be treated as the graph 
	itself. "
	^ infinitary not! !

!ArrowGraph methodsFor: 'testing' stamp: 'btr 6/15/2001 07:01'!
isFirstOrder
	"Answers whether the receiver constitutes a valid first-order logical  
	relation. It also addresses whether the graph's arrows refer to the  
	graph itself."
	^ self isNonDegenerate & (self includesReferencesTo: self apex) not! !

!ArrowGraph methodsFor: 'testing' stamp: 'btr 3/27/2001 00:57'!
isInfinitary
	"Answers if evaluation should be strictly lazy."
	^ infinitary! !

!ArrowGraph methodsFor: 'testing' stamp: 'btr 6/13/2001 13:08'!
isIntensional
	"Any graph with an intension is checked for #intensionallyIncludes: for membership, whether finite or not."
	^ intension isNil! !

!ArrowGraph methodsFor: 'testing' stamp: 'btr 3/27/2001 03:02'!
isNonDegenerate
	"Answers whether the receiver is valid as a first-order relation."
	^ self isDegenerate not! !

!ArrowGraph methodsFor: 'testing' stamp: 'btr 5/31/2001 06:02'!
treatsAsCodomainElement: anArrow 
	"Default answer."
	^ anArrow isKindOf: Arrow! !

!ArrowGraph methodsFor: 'testing' stamp: 'btr 6/10/2001 10:04'!
treatsAsDomainElement: anArrow 
	"Default answer."
	^ anArrow isKindOf: Arrow! !

!ArrowGraph methodsFor: 'testing' stamp: 'btr 6/10/2001 10:07'!
treatsAsNode: anArrow 
	"Nodes are a term for an arrow relative to another graph. Graphs  
	strictly contain their directed edges (their arrows) as a set does its  
	elements. The nodes of the graph are those arrows referenced by those  
	edges. System-wide graphs should include a separate intensional check."
	^ ((self treatsAsDomainElement: anArrow)
				or: [self treatsAsCodomainElement: anArrow])
			or: [self includesReferencesTo: anArrow]! !

!ArrowGraph methodsFor: 'private' stamp: 'btr 6/13/2001 13:10'!
beExtensional
	intension _ nil! !

!ArrowGraph methodsFor: 'private' stamp: 'btr 6/13/2001 13:10'!
beIntensional
	"Default answer until some expressive intension system is designed."
	intension _ true! !

!ArrowGraph methodsFor: 'private' stamp: 'btr 6/13/2001 05:27'!
holdStrongly
	"I convert my cache to a Set from whatever it was before (most likely a WeakSet). This is useful when the graph is intensional but is passed around linearly (usually as the result of a computation) so that it is the primary source of reference for its contents."
	| tempCache |
	tempCache _ Set new.
	cache
		ifNotNil: [
			tempCache init: cache size.
			cache
				do: [:each | tempCache add: each].
			cache _ tempCache].
	infinitary _ false! !

!ArrowGraph methodsFor: 'private' stamp: 'btr 6/13/2001 05:29'!
holdWeakly
	"The cache is forced to be a WeakSet, whose references aren't valid to the garbage collector. Allows evaluation to be lazy, treating the inner set as a cache. This can be used whenever graph definition is intensional, even if the extension of the graph is finite, since the algorithm is only used when cache searches fail. However, if the graph is the only source of references to the arrow elements and they are not trivially recomputed, then my cache should #holdStrongly."
	| tempCache |
	tempCache _ WeakSet newFrom: {}.
	cache
		ifNotNil: [
			tempCache init: cache size.
			cache
				do: [:each | tempCache add: each]].
	cache _ tempCache.
	infinitary _ true! !

!ArrowGraph methodsFor: 'private' stamp: 'btr 6/15/2001 07:09'!
orientTailSmaller
	"Use this to be lazy about iterating through the apex. This ensures 
	that the tail points to something with fewer elements. Use only when  
	the head/tail distinctions of the apex are not meaningful."
	apex head isExtensional
			& (apex tail isIntensional
					or: [apex head cache size < apex tail cache size])
		ifTrue: [apex _ Reference to: apex inv]! !


!ArrowGraph class methodsFor: 'instance creation' stamp: 'btr 6/10/2001 16:27'!
bottom
	"Answer a bottom element of the set-theoretic lattice."
	^ EmptyGraph new! !

!ArrowGraph class methodsFor: 'instance creation' stamp: 'btr 6/12/2001 07:11'!
new
	"Ensure that all my sub-instances are initialized automatically. Don't let 
	ArrowGraph itself be instantiated."
	^ ArrowGraphMain basicNew initialize! !

!ArrowGraph class methodsFor: 'instance creation' stamp: 'btr 6/13/2001 13:13'!
newFrom: aCollection 
	"Create a new extensional graph with the contents of aCollection."
	^ self new holdStrongly; beExtensional; cache: aCollection! !

!ArrowGraph class methodsFor: 'instance creation' stamp: 'btr 6/15/2001 07:03'!
newFromArrow: anArrow 
	"Annotate the argument with an initialized empty graph."
	^ self new apex: anArrow! !

!ArrowGraph class methodsFor: 'instance creation' stamp: 'btr 6/11/2001 10:03'!
top
	"Answer a top element of the set-theoretic lattice of graphs."
	^ TopGraph new! !


!ArrowGraphMain methodsFor: 'comparing' stamp: 'btr 6/10/2001 14:02'!
isSubGraphOf: anArrowGraph 
	"Answers whether the argument contains all of the receiver's arrows.  
	The implementation so far is only extensional."
	(self isExtensional
			and: [cache size > anArrowGraph cache size])
		ifTrue: [^ false].
	(cache isEmpty
			or: [anArrowGraph cache isEmpty])
		ifTrue: [^ true].
	^ (cache
		anySatisfy: [:eachArrow | (anArrowGraph includes: eachArrow) not]) not! !

!ArrowGraphMain methodsFor: 'comparing' stamp: 'btr 6/10/2001 12:43'!
isSuperGraphOf: anArrowGraph 
	"Set-theoretic inclusion."
	^ anArrowGraph isSubGraphOf: self! !

!ArrowGraphMain methodsFor: 'operations' stamp: 'btr 6/11/2001 10:29'!
applyTo: anArrow 
	"A method for applying a graph as a function to an arrow. This  
	amounts to returning a graph of all arrows referenced by the heads of 
	those arrows whose tails reference the argument. This implementation  
	is the most generic case of graph-application. If the graph is intensional, coerce the arrow to a singleton graph and re-cast the call."
	self isExtensional
		ifTrue: [^ ArrowGraph new
				cache: (cache
						select: [:each | each domainElement == anArrow]
						thenCollect: [:each | each codomainElement])].
	^ self applyToGraph: anArrow asGraph! !

!ArrowGraphMain methodsFor: 'operations' stamp: 'btr 6/9/2001 12:46'!
applyToGraph: anArrowGraph 
	"Generalizes #applyTo: so that a graph can be applied to all the elements 
	of another graph. I always answer a new graph."
	^ ApplicationGraph newFromArrow: (self -> anArrowGraph)! !

!ArrowGraphMain methodsFor: 'operations' stamp: 'btr 6/21/2001 01:17'!
filteredBy: aBlockContext 
	"Provide for filtering of my arrows by a test block taking the arrow as  
	argument. In this generic case, no cache or set of example values is  
	given."
	^ FilteredGraph
		newFrom: {}
		of: self
		for: aBlockContext! !

!ArrowGraphMain methodsFor: 'operations' stamp: 'btr 6/21/2001 01:17'!
filteredBy: aBlockContext caching: anArrowGraph 
	"Provide for filtering of my arrows by a test block taking the arrow as argument and an example graph of arrows satisfying the test."
	^ FilteredGraph
		newFrom: anArrowGraph asSet
		of: self
		for: aBlockContext! !

!ArrowGraphMain methodsFor: 'operations' stamp: 'btr 6/11/2001 10:27'!
graphCompose: anArrowGraph 
	"Answer a graph of arrows which are those resulting from all possible  
	compositions of arrows from the receiver and argument respectively. #asGraph coerces arrows to singleton graphs."
	^ GraphCompositionGraph newFromArrow: self -> anArrowGraph asGraph! !

!ArrowGraphMain methodsFor: 'operations' stamp: 'btr 6/11/2001 10:29'!
invertedApplyTo: anArrow 
	"A method for UNapplying a graph as a function to an arrow. This  
	amounts to returning a graph of all arrows referenced by the tails of  
	those arrows whose heads reference the argument. This implementation  
	is the most generic case of graph-application. If the graph is 
	intensional, coerce the arrow to a singleton graph and re-cast the call."
	self isExtensional
		ifTrue: [^ ArrowGraph new
				cache: (cache
						select: [:each | each codomainElement == anArrow]
						thenCollect: [:each | each domainElement])].
	^ self applyToGraph: anArrow asGraph! !

!ArrowGraphMain methodsFor: 'operations' stamp: 'btr 6/9/2001 12:47'!
invertedApplyToGraph: anArrowGraph 
	"Generalizes #invertedApplyTo: so that a graph can be applied to all the elements of another graph. I always answer a new graph."
	^ ApplicationGraph newFromArrow: anArrowGraph -> self! !

!ArrowGraphMain methodsFor: 'operations' stamp: 'btr 6/21/2001 00:36'!
metaGraph
	"Sugaring; delegation to a graph type."
	^ MetaGraph of: self! !

!ArrowGraphMain methodsFor: 'operations' stamp: 'btr 4/10/2001 20:54'!
predecessorsOf: anArrow 
	"Answer the nodes preceding the given node using my arrows by one 
	step. "
	^ self inv * anArrow! !

!ArrowGraphMain methodsFor: 'operations' stamp: 'btr 6/13/2001 16:18'!
restrictedTo: anArrowGraph 
	"The argument acts as a filter over the set of nodes (arrows referred to 
	by the receiver's arrows) that the receiver applies to."
	^ FilteredOverGraph newFromArrow: anArrowGraph -> self! !

!ArrowGraphMain methodsFor: 'operations' stamp: 'btr 3/19/2001 18:13'!
selfComposeTimes: aNatural 
	"Apply composition to myself n times and answer the result."
	| temp |
	aNatural < 1
		ifTrue: [^ self notYetImplemented].
	temp _ self.
	1
		to: aNatural
		by: 1
		do: [temp _ self graphCompose: temp].
	^ temp! !

!ArrowGraphMain methodsFor: 'operations' stamp: 'btr 4/10/2001 20:54'!
sucessorsOf: anArrow 
	"Answer the nodes following the given node using my arrows by one 
	step."
	^ self * anArrow! !

!ArrowGraphMain methodsFor: 'testing' stamp: 'btr 4/12/2001 14:49'!
hasMetaArrowsFor: anArrowGraph 
	"Answers whether the receiver contains arrows which reference any  
	arrows from the argument."
	(cache isEmpty
			or: [anArrowGraph cache isEmpty])
		ifTrue: [^ false].
	cache size ~= anArrowGraph cache size
		ifTrue: [^ false].
	^ cache
		anySatisfy: [:element | (anArrowGraph includes: element tail)
				or: [anArrowGraph includes: element head]]! !

!ArrowGraphMain methodsFor: 'testing' stamp: 'btr 6/13/2001 19:29'!
includes: anArrow 
	"Answers whether the argument is part of the receiver."
	"This method over-rides the set method to allow for intensional  
	description of graphs and their arrows, which will permit infinitary  
	graphs. The intensional query is performed after the cache is  
	searched. If intensional inclusion works, add it to the cache if it is weak (to avoid memory leaks in the strong case)."
	^ (cache isEmpty not
			and: [cache includes: anArrow])
		or: [self isIntensional
				and: [(self intensionallyIncludes: anArrow)
					ifTrue: [self holdsWeakly ifTrue: [cache add: anArrow]. true]
					ifFalse: [false]]]! !

!ArrowGraphMain methodsFor: 'testing' stamp: 'btr 4/12/2001 15:10'!
includesReferencesTo: anArrow 
	"Answers whether the receiver contains arrows which reference the  
	argument."
	"This method over-rides the set method to allow for intensional  
	description of graphs and their arrows, which will permit infinitary  
	graphs. The intensional query should be implemented after the internal 
	cache is searched."
	^ cache isEmpty not and: [cache
		anySatisfy: [:eachArrow | eachArrow references: anArrow]]! !

!ArrowGraphMain methodsFor: 'testing' stamp: 'btr 6/10/2001 10:07'!
treatsAsGround: anArrow 
	"An arrow is a ground arrow in a graph iff it is not a meta-information 
	arrow of one of the graph's arrows."
	^ (self includes: anArrow)
		and: [(self includes: anArrow head) not
				and: [(self includes: anArrow tail) not]]! !

!ArrowGraphMain methodsFor: 'testing' stamp: 'btr 6/10/2001 10:07'!
treatsAsGroundNode: anArrow 
	"Answers whether arrows leading from the argument exist in the  
	receiver."
	^ (self * anArrow) size = 0! !


!ApplicationGraph methodsFor: 'accessing' stamp: 'btr 3/18/2001 02:09'!
anyOne
	"Yield responsibility for consistency over to my argument graph."
	^ (self operator applyTo: self argument anyOne) anyOne! !

!ApplicationGraph methodsFor: 'accessing' stamp: 'btr 6/15/2001 07:00'!
argument
	^ self apex head! !

!ApplicationGraph methodsFor: 'accessing' stamp: 'btr 6/15/2001 07:00'!
operator
	^ self apex tail! !

!ApplicationGraph methodsFor: 'testing' stamp: 'btr 6/11/2001 16:13'!
intensionallyIncludes: anArrow 
	"There must be an arrow in the operator graph leading from an arrow  
	in the argument graph to my argument. This works by delegating to 
	the operator graph the responsibility to provide its inverse application, 
	which is the obvious major point of non-determinism in the general 
	case. The type-check against the argument graph also adds some 
	complexity."
	^ self argument includes: self operator inv * anArrow! !


!ApplyToGraph methodsFor: 'testing' stamp: 'btr 3/8/2001 16:41'!
intensionallyIncludes: anArrow 
	"For now, count any pair of a graph and an arrow as an element."
	^ (anArrow tail isKindOf: ArrowGraph)
		& (anArrow head isKindOf: Arrow)! !


!ArrowGraphMain class methodsFor: 'instance creation' stamp: 'btr 6/12/2001 09:07'!
new
	"Ensure all my sub-instances are initialized. This overrides ArrowGraph 
	class>>#new which coerces instantiations to be of ArrowGraphMain type."
	^ self basicNew initialize! !


!BaseToMetaGraph methodsFor: 'operations' stamp: 'btr 6/10/2001 14:43'!
applyTo: anArrowGraph 
	"Answer the meta-level representation of the argument."
	^ MetaGraph of: anArrowGraph! !

!BaseToMetaGraph methodsFor: 'operations' stamp: 'btr 3/18/2001 03:19'!
invertedApplyTo: anArrowGraph
	anArrowGraph class == MetaGraph
		ifTrue: [^ anArrowGraph graph].
	"^ anArrowGraph asMetaGraph graph"
	"The previous line is a correct intent, but the expression does not seem to have the right semantics."
	^ self notYetImplemented! !

!BaseToMetaGraph methodsFor: 'testing' stamp: 'btr 3/19/2001 19:49'!
intensionallyIncludes: anArrow 
	"All arrows leading from graphs to their meta-graphs are members."
	(anArrow domainElement isKindOf: ArrowGraph)
		ifFalse: [^ false].
	^ self intensionallyIncludes: anArrow using: #metaGraph! !

!BaseToMetaGraph methodsFor: 'testing' stamp: 'btr 3/8/2001 16:47'!
treatsAsNode: anArrow
	"All graphs, esp. meta-graphs, are the subject of this reflection mechanism."
	^ anArrow isKindOf: ArrowGraph! !


!CategoryGraph methodsFor: 'accessing' stamp: 'btr 6/10/2001 14:49'!
identities
	"The identity mappings over my nodes."
	^ identities! !

!CategoryGraph methodsFor: 'accessing' stamp: 'btr 6/10/2001 14:48'!
identityOf: anArrow 
	"Check for proper inclusion of the argument as a node of the category. 
	The answer should represent the unique-per-node identity mapping 
	over it, therefore 'identities' should not have arrows with duplicate 
	value."
	| temp |
	(nodes includes: anArrow)
		ifFalse: [^ nil].
	temp _ anArrow raiseIdentity.
	^ identities cache
		detect: [:each | each equals: temp]
		ifNone: [temp addToGraph: identities]! !

!CategoryGraph methodsFor: 'accessing' stamp: 'btr 6/10/2001 14:49'!
nodes
	"The arrows treated as nodes in this category."
	^ nodes! !

!CategoryGraph methodsFor: 'initialize' stamp: 'btr 6/13/2001 05:34'!
initialize
	super initialize.
	nodes _ ArrowGraph new holdStrongly.
	identities _ ArrowGraph new holdWeakly.
	compositions _ CompositionGraph new holdWeakly! !

!CategoryGraph methodsFor: 'initialize' stamp: 'btr 5/21/2001 11:30'!
nodes: anArrowGraph 
	"Protected mutator. This should also check for consistency against already added arrows."
	nodes
		ifNotNil: [^ self class over: anArrowGraph].
	nodes _ anArrowGraph! !

!CategoryGraph methodsFor: 'testing' stamp: 'btr 5/21/2001 11:32'!
includes: anArrow 
	"Check for normal inclusion, and scan for possible compositions that lead to the argument."
	(super includes: anArrow)
		ifTrue: [^ true].
	cache
		do: [:each | cache
				do: [:other | (each ++ other = anArrow
							or: [other ++ each = anArrow])
						ifTrue: [^ true]]].
	^ false! !

!CategoryGraph methodsFor: 'testing' stamp: 'btr 5/21/2001 11:33'!
intensionallyIncludes: anArrow
	"Ensure that the arrow is over my nodes graph's elements."
	^ (nodes includes: anArrow head)
			and: [nodes includes: anArrow tail]! !


!ConcreteArrow methodsFor: 'accessing' stamp: 'btr 5/15/2001 10:06'!
at: anIndex put: anArrow 
	"Changes the indexed reference to the argument. Type-checking and  
	mutation protection performed by head:tail:. Returns a new arrow."
	((super at: anIndex + 1) isKindOf: Reference)
		ifTrue: [^ self notYetImplemented].
	^ super
		at: anIndex + 1
		put: (Reference to: anArrow)! !

!ConcreteArrow methodsFor: 'accessing' stamp: 'btr 4/2/2001 12:30'!
head
	"Answers the second reference."
	^ head value! !

!ConcreteArrow methodsFor: 'accessing' stamp: 'btr 4/2/2001 12:30'!
tail
	"Answers the first reference."
	^ tail value! !

!ConcreteArrow methodsFor: 'accessing' stamp: 'btr 5/15/2001 09:56'!
world
	"This is a recursive method to determine what world an arrow is in  
	without having to perform searches throuh all frames and graphs."
	"For now, assume that constructed arrows have the same world as the  
	arrows they refer to. 
	WARNING: an arrow over two arrows that happen to be from different 
	worlds is ambiguous. Currently the implementation will return the tail's 
	world."
	(tail notNil
			and: [self tail world notNil])
		ifTrue: [^ self tail world].
	(head notNil
			and: [self head world notNil])
		ifTrue: [^ self head world].
	"Last resort: treat ArrowWorld as a lobby."
	^ ArrowWorld! !

!ConcreteArrow methodsFor: 'comparing' stamp: 'btr 4/2/2001 13:18'!
equals: anArrow 
	"Tests for extensional equality. That is, equality via comparing the  
	object's variables. Translates to Arrow system equality within square  
	and relativised square frames. Basically, two arrows are #equals: if 
	their references point to equal objects. Note that #= is the same as #==, object identity. "
	(anArrow isKindOf: self class)
		ifFalse: [^ false].
	^ self head = anArrow head
		and: [self tail = anArrow tail]! !

!ConcreteArrow methodsFor: 'converting' stamp: 'btr 5/26/2001 09:43'!
asAbstract
	"Conversion to abstract arrows takes the construction information  
	(the instance variables), and transmit / delegate that information to the 
	right head- and tail-graphs."
	self world heads add: self raiseHead.
	self world tails add: self raiseTail.
	^ self becomeForward: Arrow new! !

!ConcreteArrow methodsFor: 'converting' stamp: 'btr 6/10/2001 14:50'!
asConcrete
	"I am already concrete."
	^ self! !

!ConcreteArrow methodsFor: 'copying' stamp: 'btr 6/10/2001 09:45'!
deepCopy
	"Arrow structures will be cyclical at some point, so deep copies are 
	dangerous."
	self shouldNotImplement! !

!ConcreteArrow methodsFor: 'initialize' stamp: 'btr 4/2/2001 12:31'!
head: headArrow tail: tailArrow 
	"Sets both references. This supports immutability. Once both  
	head and tail are not nil, all calls to this method return a new arrow."
	| newArrow |
	self head isNil | self tail isNil
		ifTrue: [head _ Reference to: headArrow.
			tail _ Reference to: tailArrow.
			^ self].
	newArrow _ self class basicNew.
	"Allows adaptation to subclasses; #basicNew bypasses the current  
	disablement of #new in Arrow."
	self become: newArrow.
	head _ Reference to: headArrow.
	tail _ Reference to: tailArrow.
	self become: newArrow.
	^ newArrow! !

!ConcreteArrow methodsFor: 'initialize' stamp: 'btr 4/2/2001 12:33'!
initialize
	"Isolates use of assignment to prime areas. See Arrow>>head:tail:"
	super initialize.
	head _ Reference to: nil.
	tail _ Reference to: nil! !

!ConcreteArrow methodsFor: 'initialize' stamp: 'btr 4/7/2001 22:21'!
isInitialized
	"This does not catch Arrows like those produced by ArrowGraph>>anyOne 
	even though they reference nil."
	^ (head isKindOf: Reference)
			and: [tail isKindOf: Reference]! !

!ConcreteArrow methodsFor: 'operations' stamp: 'btr 5/29/2001 09:17'!
composeElements
	"Return the composition of my tail and head in that order."
	^ self source ++ self target! !

!ConcreteArrow methodsFor: 'reifications' stamp: 'btr 6/10/2001 14:50'!
raiseComposition
	"Answer the arrow leading to the composition of my elements."
	^ self -> self composeElements! !


!ConcreteArrow class methodsFor: 'instance creation' stamp: 'btr 4/2/2001 12:39'!
new
	"Don't let an un-initialized Arrow get made without some effort."
	^ super new initialize! !


!EquationalArrow methodsFor: 'accessing' stamp: 'btr 6/10/2001 12:17'!
headsTo
	^ headsTo! !

!EquationalArrow methodsFor: 'accessing' stamp: 'btr 6/10/2001 12:17'!
tailsTo
	^ tailsTo! !

!EquationalArrow methodsFor: 'initialize' stamp: 'btr 6/13/2001 05:36'!
initialize
	super initialize.
	headsTo _ ArrowGraph new holdWeakly.
	tailsTo _ ArrowGraph new holdWeakly! !


!FilteredObjectGraph methodsFor: 'accessing' stamp: 'btr 6/13/2001 13:47'!
anyOne
	"If my cache is empty, I would have to provide an example of an object satisfying my testBlock, which actually may have no answer."
	cache isEmpty
		ifTrue: [self notYetImplemented].
	^ cache anyOne! !

!FilteredObjectGraph methodsFor: 'accessing' stamp: 'btr 6/18/2001 01:25'!
arrowFor: anObject 
	"This performs the intended check for membership by using objectGraph  
	properly."
	^ self
		add: (Arrow wrapping: anObject in: self objectGraph)! !

!FilteredObjectGraph methodsFor: 'accessing' stamp: 'btr 6/13/2001 12:59'!
block
	^ testBlock! !

!FilteredObjectGraph methodsFor: 'accessing' stamp: 'btr 6/18/2001 00:10'!
cache
	"Accessing the cache directly bypasses this graph's checking against 
	testBlock."
	self shouldNotImplement! !

!FilteredObjectGraph methodsFor: 'accessing' stamp: 'btr 6/18/2001 13:28'!
graph
	"Polymorphism with FilteredGraph>>#graph. However, #objectGraph looks for the original objectGraph in the filter chain."
	^ objectGraph! !

!FilteredObjectGraph methodsFor: 'accessing' stamp: 'btr 6/18/2001 01:14'!
kernel
	"This allows FilteredObjectGraphs to be used for ObjectGraphs transparently. objectGraph is accessed indirectly because of the way successive filter applications work."
	^ self objectGraph kernel! !

!FilteredObjectGraph methodsFor: 'accessing' stamp: 'btr 6/13/2001 15:15'!
objectGraph
	"Polymorphism between ObjectGraphs and FilteredObjectGraphs is 
	supported here. See FilteredObjectGraph>>#over:."
	^ objectGraph class == ObjectGraph
		ifTrue: [objectGraph]
		ifFalse: [objectGraph objectGraph]! !

!FilteredObjectGraph methodsFor: 'accessing' stamp: 'btr 6/18/2001 01:37'!
operand
	"Ensure that other filteredObjectGraphs know what my direct argument 
	is, since #objectGraph bypasses all FilteredObjectGraphs for the original 
	ObjectGraph."
	^ objectGraph! !

!FilteredObjectGraph methodsFor: 'comparing' stamp: 'btr 6/13/2001 18:58'!
isSubGraphOf: anArrowGraph 
	"My objectGraph and its objectGraph(s) are super-graphs of me."
	^ (anArrowGraph == objectGraph
		or: [objectGraph isSubGraphOf: anArrowGraph])
		or: [super isSubGraphOf: anArrowGraph]! !

!FilteredObjectGraph methodsFor: 'initialize' stamp: 'btr 6/13/2001 19:11'!
block: aBlockContext 
	"I can't let my cache invalidate the block I set, so perform some checks  
	beforehand."
	(cache isNil not
			and: [cache isEmpty])
		ifTrue: [(cache
					select: [:each | (testBlock value: each object) not]) size > 0
				ifTrue: [self error: 'Some cache elements are invalid by this test.']].
	testBlock
		ifNotNil: [^ self class
				newFrom: cache
				over: objectGraph
				for: aBlockContext].
	testBlock _ aBlockContext!
]style[(7 13 3 88 3 5 20 5 23 5 15 6 3 9 8 4 22 1 14 4 8 47 5 9 16 4 20 5 11 11 10 13 4 9 3 13)f1b,f1cblack;b,f1,f1c148046000,f1,f1cblack;,f1,f1cblack;,f1,f1cblack;,f1,f1cblack;,f1,f1cblack;,f1,f1cblack;,f1,f1cblue;,f1,f1cblack;,f1,f1cblue;,f1,f1cblack;,f1,f1cblack;,f1,f1cblack;,f1,f1cblack;,f1,f1cblack;,f1,f1cblack;,f1,f1cblack;! !

!FilteredObjectGraph methodsFor: 'initialize' stamp: 'btr 6/21/2001 00:57'!
cache: aWrapperCollection 
	"Perform a few checks to ensure the cache's consistency."
	testBlock
		ifNil: [self error: 'Don''t set this graph''s cache before giving it a block to test against.'].
	objectGraph
		ifNil: [self error: 'Don''t set this graph''s cache before giving it an objectGraph to use.'].
	cache _ aWrapperCollection
		removeAllSuchThat: [:each | ((testBlock value: each object)
				and: [each objectGraph == objectGraph]) not]! !

!FilteredObjectGraph methodsFor: 'initialize' stamp: 'btr 6/18/2001 01:43'!
over: anObjectGraph 
	"Protected mutator. This also is polymorphic in allowing for composition  
	of filters (of FilteredObjectGraphs)."
	objectGraph
		ifNotNil: [^ self class
				newFrom: cache
				over: anObjectGraph
				for: testBlock].
	anObjectGraph class == FilteredObjectGraph
		ifTrue: [objectGraph _ anObjectGraph.
			testBlock _ [:value | (testBlock value: value)
						and: [anObjectGraph
								includes: (Arrow wrapping: value in: self objectGraph)]].
			^ self].
	anObjectGraph class == ObjectGraph
		ifFalse: [self error: 'I cannot take that as an argument of my filter.'].
	objectGraph _ anObjectGraph! !

!FilteredObjectGraph methodsFor: 'operations' stamp: 'btr 6/13/2001 16:01'!
>> aBlockContext
	"Sugaring. Polymorphic with ObjectGraph>>#>>."
	^ self filteredBy: aBlockContext! !

!FilteredObjectGraph methodsFor: 'operations' stamp: 'btr 6/15/2001 06:34'!
filteredBy: aBlockContext 
	"Provide for filtering of my object wrappers by a test block taking the  
	object as argument. In this generic case, my filtered cache is given.
	Note that the testBlock given is used for testing *after* testing with the 
	testBlocks of FilteredGraphs that I am based on, so that there is no need 
	to compose block filters manually."
	^ FilteredObjectGraph
		newFrom: (cache
				select: [:each | aBlockContext value: each object])
		over: self
		for: aBlockContext! !

!FilteredObjectGraph methodsFor: 'set operations' stamp: 'btr 6/18/2001 13:20'!
& anArrowGraph 
	"My intersection with my objectGraph returns myself."
	anArrowGraph = objectGraph
		ifTrue: [^ self].
	((anArrowGraph isKindOf: FilteredObjectGraph)
			and: [anArrowGraph objectGraph == self objectGraph])
		ifTrue: ["Taking the intersection of two filteredObjectGraphs which are  
			over the same objectGraph is handled to take the intersection of 
			the testBlock and caches."
			^ FilteredObjectGraph
				newFrom: (cache intersect: anArrowGraph cache)
				over: (self operand intersect: anArrowGraph operand)
				for: [:value | (testBlock value: value)
						and: [anArrowGraph block value: value]]].
	^ super & anArrowGraph! !

!FilteredObjectGraph methodsFor: 'set operations' stamp: 'btr 6/18/2001 13:20'!
| anArrowGraph 
	"My union with my objectGraph returns the objectGraph."
	anArrowGraph = objectGraph
		ifTrue: [^ anArrowGraph].
	((anArrowGraph isKindOf: FilteredObjectGraph)
			and: [anArrowGraph objectGraph == self objectGraph])
		ifTrue: ["Taking the union of two filteredObjectGraphs which are  
			over the same objectGraph is handled to take the union of  
			the testBlock and caches."
			^ FilteredObjectGraph
				newFrom: (cache union: anArrowGraph cache)
				over: (self operand union: anArrowGraph operand)
				for: [:value | (testBlock value: value)
						or: [anArrowGraph block value: value]]].
	^ super | anArrowGraph! !

!FilteredObjectGraph methodsFor: 'testing' stamp: 'btr 6/18/2001 01:25'!
intensionallyIncludes: anArrow 
	"testBlock determines membership. Of course I check that the arrow is  
	a wrapper in the first place, and also that it belongs to the same  
	objectGraph as mine."
	^ (anArrow isWrapper
			and: [anArrow objectGraph = self objectGraph])
		and: [testBlock value: anArrow object]! !

!FilteredObjectGraph methodsFor: 'testing' stamp: 'btr 6/18/2001 13:42'!
treatsAsCodomainElement: anArrow 
	"Since I filter objectGraphs, which are monoids, this test just delegates to 
	them."
	^ self objectGraph treatsAsCodomainElement: anArrow! !

!FilteredObjectGraph methodsFor: 'testing' stamp: 'btr 6/18/2001 13:42'!
treatsAsDomainElement: anArrow 
	"Since I filter objectGraphs, which are monoids, this test just delegates to  
	them."
	^ self objectGraph treatsAsDomainElement: anArrow! !

!FilteredObjectGraph methodsFor: 'adding' stamp: 'btr 6/18/2001 13:33'!
add: aWrapperArrow
	"Perform the usual method, but also ensure that my operand(s) and the original objectGraph get this added to their caches. The latter should not fail if the former doesn't."
	super add: aWrapperArrow.
	^ self operand add: aWrapperArrow! !


!FilteredObjectGraph class methodsFor: 'instance creation' stamp: 'btr 6/13/2001 12:24'!
newFrom: aCollection
	^ self notYetImplemented! !

!FilteredObjectGraph class methodsFor: 'instance creation' stamp: 'btr 6/13/2001 19:11'!
newFrom: aCollection over: anObjectGraph for: aBlockContext 
	"Create a new extensional graph with the contents of aCollection that  
	verifies aBlockContext. The order of message sends is critical."
	^ self new holdStrongly block: aBlockContext;
		 over: anObjectGraph;
		 cache: aCollection!
]style[(9 11 7 13 6 13 3 137 4 4 25 13 11 13 12 11)f1b,f1cblack;b,f1b,f1cblack;b,f1b,f1cblack;b,f1,f1c148046000,f1,f1cblack;,f1,f1cblack;,f1,f1cblack;,f1,f1cblack;! !

!FilteredObjectGraph class methodsFor: 'instance creation' stamp: 'btr 6/13/2001 22:11'!
over: anObjectGraph for: aBlockContext
	"Sugaring for when you don't have a cache to specify."
	^ self newFrom: {} over: anObjectGraph for: aBlockContext! !


!FilteredOverGraph methodsFor: 'accessing' stamp: 'btr 6/15/2001 07:01'!
argument
	^ self apex head! !

!FilteredOverGraph methodsFor: 'accessing' stamp: 'btr 6/15/2001 07:01'!
filter
	^ self apex tail! !

!FilteredOverGraph methodsFor: 'testing' stamp: 'btr 3/16/2001 13:30'!
intensionallyIncludes: anArrow
	(self filter includes: anArrow head) & (self filter includes: anArrow tail)
		ifFalse: [^ false.].
	^ self argument intensionallyIncludes: anArrow! !


!GraphCompositionGraph methodsFor: 'accessing' stamp: 'btr 6/9/2001 13:22'!
firstArg
	^ apex tail! !

!GraphCompositionGraph methodsFor: 'accessing' stamp: 'btr 6/9/2001 13:22'!
secondArg
	^ apex head! !

!GraphCompositionGraph methodsFor: 'operations' stamp: 'btr 6/10/2001 14:51'!
applyTo: anArrow 
	"Sequential composition. Of course the second composition must accept a 
	graph as argument, since graphs are relational in general."
	^ self secondArg
		applyToGraph: (self firstArg applyTo: anArrow)! !

!GraphCompositionGraph methodsFor: 'operations' stamp: 'btr 6/10/2001 14:52'!
applyToGraph: anArrowGraph 
	"Sequential application of my operands to the argument."
	^ self secondArg
		applyToGraph: (self firstArg applyToGraph: anArrowGraph)! !

!GraphCompositionGraph methodsFor: 'operations' stamp: 'btr 6/13/2001 23:17'!
invertedApplyTo: anArrow 
	"Sequential inverse application."
	^ self firstArg
		invertedApplyToGraph: (self secondArg invertedApplyTo: anArrow)! !

!GraphCompositionGraph methodsFor: 'operations' stamp: 'btr 6/10/2001 14:52'!
invertedApplyToGraph: anArrowGraph 
	"Sequential inverse application."
	^ self firstArg
		invertedApplyToGraph: (self secondArg invertedApplyToGraph: anArrowGraph)! !

!GraphCompositionGraph methodsFor: 'testing' stamp: 'btr 6/15/2001 07:02'!
includes: anArrow 
	"Recursively and exhaustively test for a pair of arrows in this category 
	which compose to yield my argument. TODO: use a type of cache to 
	short-circuit this if possible."
	self apex head
		do: [:firstArg | self apex tail
				do: [:secondArg | (anArrow isCompositionOf: firstArg with: secondArg)
						ifTrue: [^ true]]].
	^ false! !

!GraphCompositionGraph methodsFor: 'testing' stamp: 'btr 6/9/2001 12:45'!
treatsAsCodomainElement: anArrow 
	^ self secondArg treatsAsCodomainElement: anArrow! !

!GraphCompositionGraph methodsFor: 'testing' stamp: 'btr 6/9/2001 12:44'!
treatsAsDomainElement: anArrow
	^ self firstArg treatsAsDomainElement: anArrow! !


!InductionGraph methodsFor: 'accessing' stamp: 'btr 6/10/2001 14:56'!
at: aNatural 
	"Treat the induction graph as indexable."
	^ self fromNatural: aNatural! !

!InductionGraph methodsFor: 'converting' stamp: 'btr 5/31/2001 05:37'!
asNatural: anArrow 
	"Determines which, if any, natural number corresponds to the given 
	arrow in this graph representing formal induction."
	(anArrow object isKindOf: Integer)
		ifTrue: [^ anArrow object]! !

!InductionGraph methodsFor: 'converting' stamp: 'btr 5/31/2001 05:40'!
fromNatural: aNatural 
	"Instantiates an arrow representing the given natural number in 
	inductive terms."
	((aNatural isKindOf: Integer)
		and: [aNatural negative not])
		ifTrue: [^ nil].
	^ Arrow wrapping: aNatural in: monoid! !

!InductionGraph methodsFor: 'initialize' stamp: 'btr 6/18/2001 01:19'!
initialize
	"Set up an underlying monoid from my frame's reflective interface, and 
	set the kernel to wrap 0."
	super initialize.
	monoid _ self frame objects >> [:value | (value isKindOf: Integer) and: [value >= 0]].
	kernel _ Arrow wrapping: 0 in: monoid! !

!InductionGraph methodsFor: 'operations' stamp: 'btr 6/13/2001 23:14'!
applyTo: anArrow 
	"Successors should be unique per Arrow."
	(monoid includes: anArrow)
		ifFalse: [^ nil].
	anArrow isWrapper not
		ifTrue: [^ super * anArrow].
	^ (Arrow wrapping: anArrow object + 1 in: monoid) asGraph! !

!InductionGraph methodsFor: 'operations' stamp: 'btr 5/30/2001 10:43'!
identify: firstArrow with: secondArrow 
	"Here's a simple pattern-matching core. At least one of these must be a  
	variable. This is highly recursive."
	(self treatsAsVariable: firstArrow)
		ifTrue: ["Take all arrows connected to firstArrow and identify them with 
			the appropriate arrows connected to secondArrow. If both are  
			variables, turn them into the same object and let garbage  
			collection take care of the mess."
			secondArrow isWrapper not
				ifTrue: [firstArrow becomeForward: secondArrow.
					^ self].
			(self hasSuccOf: firstArrow)
				ifTrue: [self
						identify: (self successorOf: firstArrow)
						with: (self successorOf: secondArrow)].
			(self hasPredOf: firstArrow)
				ifTrue: [self
						identify: (self predecessorOf: firstArrow)
						with: (self predecessorOf: secondArrow)].
			firstArrow becomeForward: secondArrow.
			^ firstArrow].
	(self treatsAsVariable: secondArrow)
		ifTrue: [^ self identify: secondArrow with: firstArrow].
	^ self error: 'One of the arrows matched must be a variable.'! !

!InductionGraph methodsFor: 'operations' stamp: 'btr 6/13/2001 23:14'!
invertedApplyTo: anArrow 
	"Predecessors should be unique per Arrow, and respect successor usage.  
	NOTE: either anArrow is the result of 'monoid anyOne', in which case it 
	is treated as a variable, or it is the result of a successor construction,  
	which numbers converted to my elements produce on their own."
	((monoid includes: anArrow)
			and: [anArrow ~~ kernel])
		ifFalse: [^ nil].
	cache
		do: [:each | each codomainElement == anArrow
				ifTrue: [^ each domainElement]].
	^ (cache add: monoid anyOne -> anArrow) domainElement asGraph! !

!InductionGraph methodsFor: 'operations' stamp: 'btr 6/10/2001 14:55'!
predecessorOf: anArrow 
	"Induction is the successor relation. This is its inverse."
	^ self inv * anArrow! !

!InductionGraph methodsFor: 'operations' stamp: 'btr 6/10/2001 14:56'!
successorOf: anArrow 
	"The induction process is the successor relation itself."
	^ self * anArrow! !

!InductionGraph methodsFor: 'testing' stamp: 'btr 5/30/2001 10:20'!
hasPredOf: anArrow 
	"Basic unit test to see if anArrow's successor is resident in memory.  
	Don't use this if you simultaneously need the predecessor, to avoid  
	unnecessary doubling of the work of predecessorOf:."
	^ cache
		anySatisfy: [:each | each codomainElement == anArrow]! !

!InductionGraph methodsFor: 'testing' stamp: 'btr 5/30/2001 10:20'!
hasSuccOf: anArrow 
	"Basic unit test to see if anArrow's successor is resident in memory.  
	Don't use this if you simultaneously need the predecessor, to avoid  
	unnecessary doubling of the work of predecessorOf:."
	^ cache
		anySatisfy: [:each | each domainElement == anArrow]! !

!InductionGraph methodsFor: 'testing' stamp: 'btr 6/13/2001 14:54'!
intensionallyIncludes: anArrow 
	"All my arrows must be concrete and must not lead to a wrapper of 0, 
	since 0 has no predecessor."
	^ anArrow class ~~ Arrow
		and: [anArrow codomainElement object ~= 0]! !

!InductionGraph methodsFor: 'testing' stamp: 'btr 5/30/2001 10:12'!
treatsAsCodomainElement: anArrow 
	"This graph's arrows range exactly over its underlying monoid's arrows."
	^ monoid intensionallyIncludes: anArrow! !

!InductionGraph methodsFor: 'testing' stamp: 'btr 5/30/2001 10:11'!
treatsAsDomainElement: anArrow 
	"This graph's arrows range exactly over its underlying monoid's arrows."
	^ monoid intensionallyIncludes: anArrow! !

!InductionGraph methodsFor: 'testing' stamp: 'btr 5/30/2001 10:38'!
treatsAsVariable: anArrow 
	"Determine if anArrow or any of its predecessors do not have other  
	pre-existing predecessors, unless that predecessor is 0. First check to  
	make sure that you are not checking an arrow that already wraps  
	a value."
	anArrow isWrapper
		ifTrue: [^ false].
	cache
		do: [:each | each codomainElement == anArrow
				ifTrue: [| temp | 
					temp _ each domainElement.
					temp object = 0
						ifTrue: [^ false].
					^ self treatsAsVariable: temp]].
	^ true! !


!MappingGraph methodsFor: 'initialize' stamp: 'btr 6/12/2001 10:06'!
codomain: anArrowGraph 
	"Protected mutator."
	codomain
		ifNotNil: [^ self class from: domain to: anArrowGraph].
	codomain _ anArrowGraph! !

!MappingGraph methodsFor: 'initialize' stamp: 'btr 6/12/2001 10:06'!
domain: anArrowGraph 
	"Protected mutator."
	domain
		ifNotNil: [^ self class from: anArrowGraph to: codomain].
	domain _ anArrowGraph! !

!MappingGraph methodsFor: 'initialize' stamp: 'btr 6/12/2001 10:07'!
domain: firstGraph codomain: secondGraph 
	"Sugaring."
	^ (self domain: firstGraph)
		codomain: secondGraph! !

!MappingGraph methodsFor: 'testing' stamp: 'btr 6/12/2001 10:06'!
intensionallyIncludes: anArrow 
	"Simple type-check against domain and codomain."
	^ (domain includes: anArrow domainElement)
		and: [codomain includes: anArrow codomainElement]! !

!MappingGraph methodsFor: 'testing' stamp: 'btr 5/29/2001 05:17'!
treatsAsCodomainElement: anArrow 
	^ codomain includes: anArrow! !

!MappingGraph methodsFor: 'testing' stamp: 'btr 5/29/2001 05:17'!
treatsAsDomainElement: anArrow
	^ domain includes: anArrow! !


!MappingGraph class methodsFor: 'instance creation' stamp: 'btr 6/12/2001 10:07'!
from: anArrowGraph to: anotherArrowGraph 
	"Sugaring."
	^ (self new domain: anArrowGraph)
		codomain: anotherArrowGraph! !


!MetaFrameGraph methodsFor: 'accessing' stamp: 'btr 5/29/2001 16:53'!
anyOne
	"Relies on my subclasses defining #applyTo: over abstract arrows as  
	well as the ordinary concrete case. Check the cache first to avoid creating new arrows if possible."
	| temp |
	cache isEmpty
		ifFalse: [^ cache anyOne].
	temp _ frame arrows anyOne.
	^ temp -> self * temp! !

!MetaFrameGraph methodsFor: 'accessing' stamp: 'btr 5/8/2001 00:23'!
frame
	^ frame! !

!MetaFrameGraph methodsFor: 'accessing' stamp: 'btr 6/12/2001 10:08'!
world
	"Worlds and frames are implemented the same way for now."
	^ frame! !

!MetaFrameGraph methodsFor: 'comparing' stamp: 'btr 5/29/2001 16:55'!
= anArrowGraph 
	"All MetaFrameGraphs are equivalent which cover the same frame."
	^ self class = anArrowGraph class
		and: [frame = anArrowGraph frame]! !

!MetaFrameGraph methodsFor: 'comparing' stamp: 'btr 5/29/2001 09:02'!
isSubGraphOf: anArrowGraph 
	"A proper superclass of a meta-frame graph's values of something is equivalent to it, unless it is a powerset, which this is not."
	^ self = anArrowGraph! !

!MetaFrameGraph methodsFor: 'initialize' stamp: 'btr 6/12/2001 10:08'!
frame: anArrowFrame 
	"Protected mutator."
	frame
		ifNotNil: [^ self class over: anArrowFrame].
	name _ 'A ' , self class name , ' over ' , anArrowFrame name.
	frame _ anArrowFrame! !

!MetaFrameGraph methodsFor: 'initialize' stamp: 'btr 6/15/2001 19:38'!
initialize
	"Each class should have a default cache semantics and set it up before use."
	super initialize.
	self initializeCache! !

!MetaFrameGraph methodsFor: 'initialize' stamp: 'btr 6/15/2001 19:37'!
initializeCache
	"Graphs of relationships over frames by default should be weak."
	self holdWeakly! !

!MetaFrameGraph methodsFor: 'testing' stamp: 'btr 5/29/2001 16:41'!
treatsAsDomainElement: anArrow 
	"All arrows within meta-frame graphs are inductively defined over the 
	frame."
	^ frame includes: anArrow! !


!AssertionGraph methodsFor: 'initialize' stamp: 'btr 6/15/2001 19:40'!
initializeCache
	"Unlike most relationships over frame arrows, assertions are intended to drive the caching of those other more basic pieces of information; therefore I should hold my arrows strongly."
	self holdStrongly! !


!CompositionGraph methodsFor: 'operations' stamp: 'btr 5/29/2001 16:45'!
applyTo: anArrow
	"For pairs of concrete arrows, use the concrete method to handle composition. Otherwise, set up the pattern of information to match against later."
	((anArrow head class = Arrow) not and: [(anArrow tail class = Arrow) not])
		ifTrue: [^ anArrow composeElements].
	^ self notYetImplemented! !

!CompositionGraph methodsFor: 'testing' stamp: 'btr 5/29/2001 09:26'!
intensionallyIncludes: anArrow 
	"This currently only works for non-abstract arrows. Arrows in this  
	graph type lead from pairs of arrows in the frame composed to the result of their composition."
	anArrow class = Arrow
		ifFalse: [^ self notYetImplemented].
	((frame includes: self tail) not
			or: [frame includes: self head])
		ifFalse: [^ false].
	^ self intensionallyIncludes: anArrow using: #composeElements! !


!HeadGraph methodsFor: 'operations' stamp: 'btr 5/29/2001 05:42'!
applyTo: anArrow 
	"Reifies the head of the arrow as another (unique) arrow. Notice that  
	the answer provided is not unique by necessity."
	"TODO: Abstract arrows rely on this being a lazy promise, which it is 
	not."
	cache
		detect: [:each | each domainElement == anArrow]
		ifNone: [| newArrow | 
			"Only works on ConcreteArrows."
			newArrow _ anArrow raiseHead.
			^ cache
				detect: [:eachArrow | eachArrow = newArrow]
				ifNone: [^ self add: newArrow]]! !

!HeadGraph methodsFor: 'operations' stamp: 'btr 5/29/2001 05:42'!
invertedApplyTo: anArrow 
	"First check to make sure the argument is valid as a reified head arrow. 
	If so, return the arrow it would have been the result of."
	"TODO: Abstract arrows rely on this being a lazy promise, which it is 
	not."
	(self intensionallyIncludes: anArrow)
		ifFalse: [^ nil].
	^ anArrow domainElement! !

!HeadGraph methodsFor: 'testing' stamp: 'btr 5/15/2001 18:36'!
intensionallyIncludes: anArrow 
	"My arrows simply have to lead from one arrow in the frame to the  
	arrow that its head references (if there is one)."
	(frame includes: anArrow tail)
		ifFalse: [^ false].
	anArrow class == ConcreteArrow
		ifTrue: [^ self intensionallyIncludes: anArrow using: #head].
	^ false! !

!HeadGraph methodsFor: 'testing' stamp: 'btr 5/15/2001 18:36'!
treatsAsNode: anArrow 
	"All arrows in the frame can have their head references reified as 
	other arrows."
	^ frame includes: anArrow! !


!InversionGraph methodsFor: 'adding' stamp: 'btr 5/29/2001 09:14'!
add: anArrow 
	"Abstract arrows have to be handled with a pattern-matchin algorithm."
	anArrow class = Arrow
		ifFalse: [^ super add: anArrow].
	^ self notYetImplemented! !

!InversionGraph methodsFor: 'operations' stamp: 'btr 5/29/2001 06:06'!
applyTo: anArrow 
	"Abstract arrows have to be handled by the generic lazy case, looking for arrows leading from it to other arrows. Concrete arrows of any kind, however, are treated in the simplest way possible."
	anArrow class = Arrow ifTrue: [^ super applyTo: anArrow].
	^ anArrow inv! !

!InversionGraph methodsFor: 'testing' stamp: 'btr 6/12/2001 10:05'!
intensionallyIncludes: anArrow 
	"I represent the action of Arrow>>#inv."
	^ self intensionallyIncludes: anArrow using: #inv! !

!InversionGraph methodsFor: 'testing' stamp: 'btr 3/10/2001 13:12'!
treatsAsNode: anArrow
	"All arrows have inverses."
	^ true! !


!MetaFrameGraph class methodsFor: 'instance creation' stamp: 'btr 5/27/2001 14:21'!
over: anArrowFrame 
	"Make a new instance of one of my subclasses for a particular frame."
	^ self new initialize frame: anArrowFrame! !


!MetaGraphGraph methodsFor: 'accessing' stamp: 'btr 5/15/2001 11:08'!
graph
	"Return the graph that this meta-graph was instantiated for, or  
	instantiate a graph that satisfies the definition."
	self isInitialized
		ifFalse: [^ self notYetImplemented].
	^ graph! !

!MetaGraphGraph methodsFor: 'initialize' stamp: 'btr 5/15/2001 11:05'!
graph: anArrowGraph 
	"There should only be one meta-graph of my kind per graph."
	graph
		ifNotNil: [^ self class of: anArrowGraph].
	graph _ anArrowGraph! !


!FilteredGraph methodsFor: 'accessing' stamp: 'btr 6/13/2001 16:26'!
anyOne
	"If my cache is empty, I would have to provide an example of an object 
	satisfying my testBlock, which actually may have no answer."
	cache isEmpty
		ifTrue: [self notYetImplemented].
	^ cache anyOne! !

!FilteredGraph methodsFor: 'accessing' stamp: 'btr 6/13/2001 16:26'!
block
	^ testBlock! !

!FilteredGraph methodsFor: 'accessing' stamp: 'btr 6/13/2001 16:27'!
graph
	^ graph! !

!FilteredGraph methodsFor: 'comparing' stamp: 'btr 6/13/2001 18:59'!
isSubGraphOf: anArrowGraph 
	"My graph and its graph(s) are super-graphs of me."
	^ (anArrowGraph == graph
			or: [graph isSubGraphOf: anArrowGraph])
		or: [super isSubGraphOf: anArrowGraph]! !

!FilteredGraph methodsFor: 'initialize' stamp: 'btr 6/13/2001 16:28'!
block: aBlockContext 
	"I can't let my cache invalidate the block I set, so perform some checks  
	beforehand."
	(cache isNil not
			and: [cache isEmpty])
		ifFalse: [(cache
					select: [:each | (testBlock value: each) not]) size > 0
				ifTrue: [self error: 'Some cache elements are invalid by this test.']].
	testBlock
		ifNotNil: [^ self class
				newFrom: cache
				of: graph
				for: aBlockContext].
	testBlock _ aBlockContext! !

!FilteredGraph methodsFor: 'initialize' stamp: 'btr 6/13/2001 16:29'!
cache: aWrapperCollection 
	"Perform a few checks to ensure the cache's consistency."
	testBlock
		ifNil: [self error: 'Don''t set this graph''s cache before giving it a block to test against.'].
	graph
		ifNil: [self error: 'Don''t set this graph''s cache before giving it a graph to use.'].
	aWrapperCollection
		removeAllSuchThat: [:each | ((testBlock value: each)
				and: [each graph == graph]) not].
	cache _ aWrapperCollection! !

!FilteredGraph methodsFor: 'initialize' stamp: 'btr 6/13/2001 18:47'!
graph: anArrowGraph 
	"Protected mutator. This also is polymorphic in allowing for composition  
	of filters (of FilteredGraphs)."
	graph
		ifNotNil: [^ self class
				newFrom: cache
				of: anArrowGraph
				for: testBlock].
	anArrowGraph class == FilteredGraph
		ifTrue: [graph _ anArrowGraph.
			testBlock _ [:value | (testBlock value: value)
						and: [anArrowGraph includes: value]].
			^ self].
	(anArrowGraph isKindOf: ArrowGraph)
		ifFalse: [self error: 'I can only filter graphs.'].
	graph _ anArrowGraph! !

!FilteredGraph methodsFor: 'operations' stamp: 'btr 6/13/2001 18:49'!
>> aBlockContext 
	"Sugaring. Polymorphic with ObjectGraph>>#>> and FilteredObject>>#>>."
	^ self filteredBy: aBlockContext! !

!FilteredGraph methodsFor: 'operations' stamp: 'btr 6/15/2001 06:33'!
filteredBy: aBlockContext 
	"Provide for filtering of my object wrappers by a test block taking the  
	object as argument. In this generic case, my filtered cache is given. Note that the testBlock given is used for testing *after* testing with the testBlocks of FilteredGraphs that I am based on, so that there is no need to compose block filters manually."
	^ FilteredGraph
		newFrom: (cache
				select: [:each | aBlockContext value: each])
		of: self
		for: aBlockContext! !

!FilteredGraph methodsFor: 'set operations' stamp: 'btr 6/15/2001 06:24'!
& anArrowGraph 
	"My intersection with my graph returns myself."
	anArrowGraph = graph
		ifTrue: [^ self].
	((anArrowGraph isKindOf: FilteredGraph)
			and: [anArrowGraph graph == graph])
		ifTrue: [| temp | 
			"Taking the intersection of two filteredGraphs which are over  
			the same graph is handled to take the intersection of the  
			testBlock and caches."
			temp _ anArrowGraph block.
			^ FilteredGraph
				newFrom: (cache intersect: anArrowGraph cache)
				of: graph
				for: [:value | (testBlock value: value) and: [temp value: value]]].
	^ super & anArrowGraph! !

!FilteredGraph methodsFor: 'set operations' stamp: 'btr 6/15/2001 06:27'!
| anArrowGraph 
	"My union with my graph returns the graph."
	anArrowGraph = graph
		ifTrue: [^ anArrowGraph].
	((anArrowGraph isKindOf: FilteredGraph)
			and: [anArrowGraph graph == graph])
		ifTrue: [| temp | 
			"Taking the union of two filteredGraphs which are over  
			the same graph is handled to take the union of the  
			testBlock and caches."
			temp _ anArrowGraph block.
			^ FilteredGraph
				newFrom: (cache union: anArrowGraph cache)
				of: graph
				for: [:value | (testBlock value: value)
						or: [temp value: value]]].
	^ super & anArrowGraph! !

!FilteredGraph methodsFor: 'testing' stamp: 'btr 6/13/2001 18:56'!
intensionallyIncludes: anArrow 
	"testBlock determines membership. Of course I check that the arrow belongs to the same graph as mine."
	^ (graph includes: anArrow)
		and: [testBlock value: anArrow]! !


!IdentityGraph methodsFor: 'accessing' stamp: 'btr 6/18/2001 00:49'!
anyOne
	"Answer an identity over one of my graph's arrows."
	^ graph anyOne raiseIdentity! !

!IdentityGraph methodsFor: 'comparing' stamp: 'btr 6/18/2001 00:57'!
isSubGraphOf: anArrowGraph
	"Dispatch on my own type with a shortcut to check our arguments' inclusion."
	anArrowGraph class == self class
		ifTrue: [^ self graph isSubGraphOf: anArrowGraph graph].
	^ super isSubGraphOf: anArrowGraph! !

!IdentityGraph methodsFor: 'comparing' stamp: 'btr 6/18/2001 00:57'!
isSuperGraphOf: anArrowGraph 
	"Dispatch on my own type with a shortcut to check our arguments' 
	inclusion. "
	anArrowGraph class == self class
		ifTrue: [^ self graph isSuperGraphOf: anArrowGraph graph].
	^ super isSuperGraphOf: anArrowGraph! !

!IdentityGraph methodsFor: 'operations' stamp: 'btr 6/18/2001 01:00'!
applyTo: anArrow 
	"Answer the argument. I am the identity operation. Also ensure the 
	arrow is in my graph."
	^ (graph includes: anArrow)
		ifTrue: [anArrow]
		ifFalse: [nil]! !

!IdentityGraph methodsFor: 'operations' stamp: 'btr 6/18/2001 00:42'!
invert
	"Answer myself, since #applyTo: and #invertedApplyTo: are equivalent for identities."
	^ self! !

!IdentityGraph methodsFor: 'operations' stamp: 'btr 6/18/2001 01:02'!
invertedApplyTo: anArrow 
	"Answer the argument. I am the identity operation. Also ensure the  
	arrow is in my graph."
	^ (graph includes: anArrow)
		ifTrue: [anArrow]! !

!IdentityGraph methodsFor: 'testing' stamp: 'btr 6/18/2001 00:44'!
intensionallyIncludes: anArrow
	"The arrow must be an identity over one of my graph's elements."
	^ (graph includes: anArrow codomainElement)
		and: [anArrow isIdentity]! !


!InvertedGraph methodsFor: 'accessing' stamp: 'btr 6/10/2001 15:01'!
anyOne
	"Delegate to my kernel and invert the result."
	^ graph anyOne inv! !

!InvertedGraph methodsFor: 'accessing' stamp: 'btr 6/10/2001 15:03'!
cache
	"This should not be called since it answers a copy of the set that 
	actually gets manipulated. However, no cache should be manipulated directly, anyway."
	^ graph cache
		collect: [:eachArrow | eachArrow inv]! !

!InvertedGraph methodsFor: 'adding' stamp: 'btr 6/10/2001 15:01'!
add: anArrow 
	"Add the inverse to my kernel."
	^ graph add: anArrow inv! !

!InvertedGraph methodsFor: 'adding' stamp: 'btr 6/13/2001 14:16'!
addImmutable: anArrow 
	"For value semantics, return a new inverted graph of the immutable  
	addition of the (UN-)inverse of the arrow to my kernel graph."
	^ InvertedGraph
		of: (UnionGraph of: (SingletonGraph of: anArrow inv)
					with: graph)! !

!InvertedGraph methodsFor: 'initialize' stamp: 'btr 6/10/2001 15:00'!
cache: aSet 
	"My cache should never be used."
	^ self shouldNotImplement! !

!InvertedGraph methodsFor: 'operations' stamp: 'btr 6/10/2001 14:59'!
applyTo: anArrow 
	"Swap my graph's operations."
	^ graph invertedApplyTo: anArrow! !

!InvertedGraph methodsFor: 'operations' stamp: 'btr 6/10/2001 14:59'!
applyToGraph: anArrow 
	"Swap my graph's operations."
	^ graph invertedApplyToGraph: anArrow! !

!InvertedGraph methodsFor: 'operations' stamp: 'btr 3/18/2001 01:00'!
invert
	"This is the ultimate in lazy methods."
	^ graph! !

!InvertedGraph methodsFor: 'operations' stamp: 'btr 6/10/2001 15:03'!
invertedApplyTo: anArrow 
	"Swap my graph's operations."
	^ graph applyTo: anArrow! !

!InvertedGraph methodsFor: 'operations' stamp: 'btr 6/10/2001 15:03'!
invertedApplyToGraph: anArrow 
	"Swap my graph's operations."
	^ graph applyToGraph: anArrow! !

!InvertedGraph methodsFor: 'testing' stamp: 'btr 6/10/2001 15:01'!
includes: anArrow 
	"Test against the arrow's inverse."
	^ graph includes: anArrow inv! !

!InvertedGraph methodsFor: 'testing' stamp: 'btr 6/10/2001 15:00'!
intensionallyIncludes: anArrow 
	"Test against the arrow's inverse."
	^ graph intensionallyIncludes: anArrow inv! !


!MetaGraph methodsFor: 'accessing' stamp: 'btr 6/10/2001 15:57'!
apexNode
	"The apex of this graph is the base graph's apex arrow initialized when setting up the graph-to-metagraph relationship."
	^ apex! !

!MetaGraph methodsFor: 'accessing' stamp: 'btr 6/10/2001 15:12'!
baseArrowFor: anArrow 
	"Return the arrow in the base graph which the argument represents the set-inclusion of for me. The abstract case is not handled."
	(self includes: anArrow)
		ifFalse: [^ nil].
	^ self graph add: anArrow codomainElement! !

!MetaGraph methodsFor: 'accessing' stamp: 'btr 6/21/2001 00:40'!
metaArrowFor: anArrow 
	"Returns the first (and only?) arrow whose head references the  
	argument."
	(graph includes: anArrow)
		ifFalse: [^ nil].
	^ cache
		detect: [:eachArrow | eachArrow codomainElement == anArrow]
				ifNone: [self add: self apexNode -> anArrow]! !

!MetaGraph methodsFor: 'accessing' stamp: 'btr 6/10/2001 15:57'!
metaArrowFor: anArrow WRT: anArrowGraph 
	"Handles #metaArrowFor: for any graph's meta-graph by delegating to 
	it."
	anArrowGraph == graph
		ifTrue: [^ self metaArrowFor: anArrow].
	^ (MetaGraph of: anArrowGraph)
		metaArrowFor: anArrow! !

!MetaGraph methodsFor: 'adding' stamp: 'btr 6/15/2001 07:02'!
add: anArrow 
	"Provides a hook for using meta-graph protocol to actually instantiate  
	the base graph, in cases where the meta-graph is intended to drive the  
	definition instead of reifying an existing graph."
	graph
		ifNil: [super add: anArrow]
		ifNotNil: [graph apex == anArrow domainElement
				ifTrue: [graph add: anArrow codomainElement.
					super add: anArrow]].
	^ anArrow! !

!MetaGraph methodsFor: 'comparing' stamp: 'btr 3/7/2001 03:03'!
% anArrowGraph 
	"Sugaring."
	^ self isMetaGraphOf: anArrowGraph! !

!MetaGraph methodsFor: 'comparing' stamp: 'btr 5/15/2001 10:53'!
isMetaGraphOf: anArrowGraph 
	"Shortcut super's method with a quick check against the base graph."
	self isInitialized
		ifFalse: [^ false].
	^ anArrowGraph == graph! !

!MetaGraph methodsFor: 'initialize' stamp: 'btr 6/15/2001 07:02'!
graph: anArrowGraph 
	"Initializes me or returns a new (possibly non-unique) instance that  
	covers a certain ArrowGraph."
	graph
		ifNil: [graph _ anArrowGraph.
			apex _ graph apex.
			^ self].
	^ MetaGraph of: anArrowGraph! !

!MetaGraph methodsFor: 'initialize' stamp: 'btr 6/12/2001 10:09'!
isInitialized
	"Make sure I have a graph to represent."
	^ graph isKindOf: ArrowGraph! !

!MetaGraph methodsFor: 'operations' stamp: 'btr 5/15/2001 10:51'!
applyTo: anArrow 
	"The only arrow that a MetaGraph can be applied to effectively is the  
	apex node of the graph. Any other case is not handled yet."
	self apexNode == anArrow
		ifTrue: [^ graph].
	^ nil! !

!MetaGraph methodsFor: 'operations' stamp: 'btr 6/10/2001 15:09'!
applyToGraph: anArrowGraph
	"As in #invertedApplyToGraph:, error-handling is not proper here."
	((anArrowGraph isKindOf: SingletonGraph)
		and: [anArrowGraph singleton == self apexNode])
		ifTrue: [^ self graph].
	^ nil! !

!MetaGraph methodsFor: 'operations' stamp: 'btr 5/15/2001 10:52'!
invertedApplyTo: anArrow 
	"The only arrow that a MetaGraph can answer is the apex node of the  
	graph. Any arrow in the base graph results in it."
	(graph includes: anArrow)
		ifTrue: [^ self apexNode].
	^ nil! !

!MetaGraph methodsFor: 'operations' stamp: 'btr 6/10/2001 15:59'!
invertedApplyToGraph: anArrowGraph 
	"Perform a simple check before answering a graph of the apex node, 
	but the error case does not consider possible lazy concurrency of 
	evaluation. The more lenient case would produce an error in parallel 
	and allow any proper element of the argument to lead to the right 
	answer."
	(anArrowGraph isSubGraphOf: graph)
		ifFalse: [^ nil].
	^ SingletonGraph of: self apexNode! !

!MetaGraph methodsFor: 'testing' stamp: 'btr 6/10/2001 15:13'!
intensionallyIncludes: anArrow 
	self isInitialized
		ifTrue: [^ anArrow domainElement == self apexNode
				and: [graph intensionallyIncludes: anArrow codomainElement]].
	"The following works even though it doesn't iterate over all elements  
	because of the incremental nature of arrow addition and the fact that  
	add: itself checks against this method."
	^ cache anyOne domainElement == anArrow domainElement! !

!MetaGraph methodsFor: 'testing' stamp: 'btr 6/10/2001 16:01'!
treatsAsCodomainElement: anArrow 
	"My arrows lead from my graph's apex to its elements."
	^ graph includes: anArrow! !

!MetaGraph methodsFor: 'testing' stamp: 'btr 6/10/2001 16:01'!
treatsAsDomainElement: anArrow 
	"My arrows lead from my graph's apex to its elements."
	^ self apexNode == anArrow! !


!MetaGraphGraph class methodsFor: 'instance creation' stamp: 'btr 6/21/2001 00:42'!
of: anArrowGraph 
	"Ensures that only one meta-graph of each type exists per graph 
	instance."
	self
		allInstancesDo: [:eachMeta | anArrowGraph == eachMeta graph
				ifTrue: [^ eachMeta]].
	^ (self new initialize graph: anArrowGraph)
		name: 'A meta-graph of ' , anArrowGraph name! !


!FilteredGraph class methodsFor: 'instance creation' stamp: 'btr 6/13/2001 16:24'!
newFrom: aCollection of: anArrowGraph for: aBlockContext
	^ self new graph: anArrowGraph;
		block: aBlockContext;
		cache: aCollection! !

!FilteredGraph class methodsFor: 'instance creation' stamp: 'btr 6/13/2001 16:21'!
of: anArrowGraph
	self shouldNotImplement! !

!FilteredGraph class methodsFor: 'instance creation' stamp: 'btr 6/21/2001 00:48'!
of: anArrowGraph for: aBlockContext 
	"Implicitly use the argument graph's cache to initialize the new instance's cache."
	^ self new graph: anArrowGraph;
		 block: aBlockContext;
		 cache: anArrowGraph asSet! !


!MetaGraphSansBase methodsFor: 'accessing' stamp: 'btr 6/12/2001 10:10'!
apexNode
	"My graph's apex is potentially distinct from my apex."
	^ apexNode! !

!MetaGraphSansBase methodsFor: 'accessing' stamp: 'btr 4/12/2001 15:45'!
graph
	"Answer the graph that my arrows specify."
	^ ArrowGraph new
				cache: (cache
						collect: [:each | each codomainElement])! !

!MetaGraphSansBase methodsFor: 'adding' stamp: 'btr 3/29/2001 20:33'!
add: anArrow 
(	anArrow isKindOf: Arrow)
		ifFalse: [^ self error: 'Only arrows can be added to graphs.'].
	apexNode
		ifNil: [apexNode _ anArrow domainElement].
	^ super add: anArrow! !

!MetaGraphSansBase methodsFor: 'comparing' stamp: 'btr 6/12/2001 10:13'!
% anArrowGraph 
	"Sugaring."
	^ self isMetaGraphOf: anArrowGraph! !

!MetaGraphSansBase methodsFor: 'comparing' stamp: 'btr 6/11/2001 16:07'!
isMetaGraphOf: anArrowGraph 
	"The #graph method lazily generates but does not cache its argument, so this method's semantics are somewhat broken. TODO: fix this."
	^ self graph = anArrowGraph! !

!MetaGraphSansBase methodsFor: 'initialize' stamp: 'btr 6/12/2001 10:12'!
graph: anArrowGraph 
	"Deprecated? A protected mutator. If you have an actual graph to make a meta-graph from, this gives you a real meta-graph, not a pretender like MetaGraphSansBase."
	anArrowGraph = self graph
		ifTrue: [^ self].
	^ MetaGraph of: anArrowGraph! !

!MetaGraphSansBase methodsFor: 'initialize' stamp: 'btr 3/21/2001 09:00'!
isInitialized
	^ apexNode isNil! !

!MetaGraphSansBase methodsFor: 'operations' stamp: 'btr 4/12/2001 15:46'!
applyTo: anArrow 
	"If applied to my apexNode, return the graph that my arrows specify."
	anArrow == apexNode
		ifTrue: [^ self graph].
	^ nil! !

!MetaGraphSansBase methodsFor: 'operations' stamp: 'btr 6/12/2001 10:11'!
invertedApplyTo: anArrow 
	"All my arrows lead from my apexNode. This performs a simple check against the cache."
	cache
		do: [:each | each codomainElement == anArrow
				ifTrue: [^ SingletonGraph of: apexNode]].
	^ nil! !

!MetaGraphSansBase methodsFor: 'testing' stamp: 'btr 4/12/2001 15:49'!
intensionallyIncludes: anArrow 
	"All of my arrows should lead from the apexNode. This also initializes the apexNode if necessary. Note that this check is what protects the MetaGraph from inconsistent apexNodes, since you can't add: arrows without performing this check."
	self isInitialized
		ifTrue: [^ anArrow domainElement == apexNode].
	apexNode _ cache anyOne domainElement.
	^ apexNode == anArrow domainElement! !

!MetaGraphSansBase methodsFor: 'testing' stamp: 'btr 4/12/2001 15:52'!
treatsAsNode: anArrow 
	"Only my apexNode and the base graph's arrows are nodes to me."
	^ anArrow == apexNode
		or: [cache
				anySatisfy: [:each | each codomainElement == anArrow]]! !


!MetaObjectGraph methodsFor: 'accessing' stamp: 'btr 4/24/2001 19:01'!
objectGraph
	^ objectGraph! !

!MetaObjectGraph methodsFor: 'accessing' stamp: 'btr 6/12/2001 10:14'!
world
	"MetaObjectGraphs lie in the same world as their subject matter."
	^ objectGraph world! !

!MetaObjectGraph methodsFor: 'initialize' stamp: 'btr 6/10/2001 14:34'!
over: anObjectGraph 
	"First, ensure that the argument is the appropriate type. Then ensure  
	that the wrapperGraph is the only of its type managing the argument."
	(anObjectGraph isKindOf: ObjectGraph)
		ifFalse: [^ self error: 'MetaObjectGraphs must manage only graphs of type ObjectGraph.'].
	self class
		allInstancesDo: [:each | each objectGraph == anObjectGraph
				ifTrue: [^ each]].
	objectGraph _ anObjectGraph! !

!MetaObjectGraph methodsFor: 'testing' stamp: 'btr 6/12/2001 10:14'!
treatsAsCodomainElement: anArrow 
	"The default is to just add wrapper-checking to the generic case."
	^ (super treatsAsCodomainElement: anArrow)
		and: [anArrow isWrapper]! !

!MetaObjectGraph methodsFor: 'testing' stamp: 'btr 6/12/2001 10:14'!
treatsAsDomainElement: anArrow 
	"The default is to just add wrapper-checking to the generic case."
	^ (super treatsAsDomainElement: anArrow)
		and: [anArrow isWrapper]! !


!ClassInstanceGraph methodsFor: 'operations' stamp: 'btr 6/21/2001 01:03'!
applyTo: anArrow 
	"Answers a graph of wrappers of all the instances of the argument's  
	wrapped behavior."
	anArrow object isBehavior
		ifFalse: [^ nil].
	^ objectGraph >> [:value | value class = anArrow object]
			addAll: (anArrow object allInstances
				collect: [:each | Arrow wrapping: each in: objectGraph])! !

!ClassInstanceGraph methodsFor: 'operations' stamp: 'btr 6/21/2001 01:03'!
invertedApplyTo: anArrow 
	"Answer a wrapper for the class of the argument's wrapped object."
	^ objectGraph >> [:value | value == anArrow object class]
			add: (Arrow wrapping: anArrow object class in: objectGraph)! !

!ClassInstanceGraph methodsFor: 'testing' stamp: 'btr 5/29/2001 17:32'!
intensionallyIncludes: anArrow 
	"This includes all arrows leading between wrappers of objects and 
	wrappers of their classes."
	^ anArrow codomainElement object class == anArrow domainElement object! !

!ClassInstanceGraph methodsFor: 'testing' stamp: 'btr 5/29/2001 17:07'!
treatsAsDomainElement: anArrow
	"Any subclass of behavior can have instances, and non-wrapper arrows return themselves which are never behaviors themselves."
	^ anArrow object isKindOf: Behavior.! !


!ClassSubclassGraph methodsFor: 'operations' stamp: 'btr 6/21/2001 01:02'!
applyTo: anArrow 
	"Answers all wrapped subclasses of the argument's wrapped behavior."
	anArrow object isBehavior
		ifFalse: [^ nil].
	^ objectGraph
		>> [:value | value superclass == anArrow object]
		addAll: (anArrow object subclasses
				collect: [:each | Arrow wrapping: each in: objectGraph])! !

!ClassSubclassGraph methodsFor: 'operations' stamp: 'btr 6/21/2001 01:04'!
invertedApplyTo: anArrow 
	"Answer the superclass of the argument's wrapped behavior."
	(anArrow object isKindOf: Behavior)
		ifFalse: [^ nil].
	^ objectGraph
		>> [:value | anArrow object superclass == value] add: (Arrow wrapping: anArrow object superclass in: objectGraph)! !

!ClassSubclassGraph methodsFor: 'testing' stamp: 'btr 5/29/2001 17:21'!
intensionallyIncludes: anArrow 
	"This graph type includes all arrows between wrappers that inherit  
	directly from each other (in one specific direction)."
	^ (self treatsAsDomainElement: anArrow domainElement)
		and:
	[anArrow codomainElement object superclass == anArrow domainElement object]! !

!ClassSubclassGraph methodsFor: 'testing' stamp: 'btr 5/29/2001 17:51'!
treatsAsCodomainElement: anArrow 
	"All Behaviors can be superclassed except for nil (the superclass of 
	ProtoObject)."
	^ (self treatsAsDomainElement: anArrow)
		and: [anArrow object isNil not]! !

!ClassSubclassGraph methodsFor: 'testing' stamp: 'btr 5/29/2001 17:19'!
treatsAsDomainElement: anArrow
	"All Behaviors can be subclassed."
	^ anArrow object isKindOf: Behavior! !


!ClosureResultGraph methodsFor: 'operations' stamp: 'btr 6/21/2001 01:04'!
applyTo: anArrow 
	"Since this graph only represents completed closures, getting the result is 
	straightforward."
	^ objectGraph
		>> [:value | value = anArrow object value] add: (Arrow wrapping: anArrow object value in: objectGraph)! !

!ClosureResultGraph methodsFor: 'operations' stamp: 'btr 6/21/2001 00:54'!
invertedApplyTo: anArrow 
	"This is undecidable, since the class of closures returning a given value  
	is not well-defined. Instead I answer something that lazily filters for  
	such."
	^ objectGraph >> [:value | value value = anArrow]! !

!ClosureResultGraph methodsFor: 'testing' stamp: 'btr 5/29/2001 17:14'!
intensionallyIncludes: anArrow 
	"Sending #value to BlockContexts forces evaluation."
	^ (self treatsAsDomainElement: anArrow domainElement)
		and: [anArrow domainElement object value == anArrow codomainElement object]! !

!ClosureResultGraph methodsFor: 'testing' stamp: 'btr 5/29/2001 17:31'!
treatsAsDomainElement: anArrow 
	"BlockContexts are closures (this should change in future Squeaks and is 
	certainly not right in other Smalltalks, since they have proper 
	BlockClosures)."
	^ anArrow object isKindOf: BlockContext! !


!MetaObjectGraph class methodsFor: 'instance creation' stamp: 'btr 6/12/2001 05:22'!
newFrom: aCollection 
	"My objectGraph must be initialized before any objects can be added."
	self shouldNotImplement! !

!MetaObjectGraph class methodsFor: 'instance creation' stamp: 'btr 6/13/2001 05:34'!
newFrom: aCollection over: anObjectGraph 
	"Create a new extensional graph with the contents of aCollection."
	^ self new holdStrongly cache: aCollection;
		 over: anObjectGraph! !

!MetaObjectGraph class methodsFor: 'instance creation' stamp: 'btr 6/15/2001 07:03'!
newFromArrow: anArrow over: anObjectGraph 
	"Annotate the argument with an initialized empty graph."
	^ self new initialize apex: anArrow;
		 over: anObjectGraph! !

!MetaObjectGraph class methodsFor: 'instance creation' stamp: 'btr 6/15/2001 07:03'!
newFromArrow: anArrow wrapping: aCollection over: anObjectGraph 
	"Annotate the argument with a graph over a known collection of  
	objects."
	^ self new initialize apex: anArrow;
		 over: anObjectGraph;
		
		cache: (aCollection asSet
				collect: [:each | Arrow wrapping: each in: anObjectGraph])! !

!MetaObjectGraph class methodsFor: 'instance creation' stamp: 'btr 6/10/2001 14:33'!
newFromWrapping: aCollection over: anObjectGraph 
	"Wrap the elements of aCollection, using anObjectGraph as a base."
	^ self class new
		cache: (aCollection asSet
				collect: [:each | Arrow wrapping: each in: anObjectGraph]);
		 over: anObjectGraph! !

!MetaObjectGraph class methodsFor: 'instance creation' stamp: 'btr 6/10/2001 14:34'!
over: anObjectGraph 
	"Create a new instance for the given objectGraph. No duplication checks 
	are performed here, since it would require some odd parametrization on 
	my subclasses."
	^ self new initialize over: anObjectGraph! !


!MonoidArrow methodsFor: 'accessing' stamp: 'btr 4/26/2001 07:12'!
graph
	^ graph! !

!MonoidArrow methodsFor: 'accessing' stamp: 'btr 5/3/2001 15:25'!
head
	"I am an element of my MonoidGraph, so I am an identity over its 
	kernel."
	^ graph kernel! !

!MonoidArrow methodsFor: 'accessing' stamp: 'btr 5/3/2001 15:25'!
tail
	"I am an element of my MonoidGraph, so I am an identity over its 
	kernel. "
	^ graph kernel! !

!MonoidArrow methodsFor: 'accessing' stamp: 'btr 5/3/2001 15:38'!
world
	"This is a recursive method to determine what world an arrow is in 
	without having to perform searches throuh all frames and graphs."
	"For now, assume that the monoid knows its world."
	^ self graph world! !

!MonoidArrow methodsFor: 'converting' stamp: 'btr 4/27/2001 13:11'!
asConcrete
	"I already know my head and tail, and would lose information (namely my responsibility to my graph) by becoming a strictly concrete arrow."
	^ self! !

!MonoidArrow methodsFor: 'initialize' stamp: 'btr 5/30/2001 12:18'!
graph: aMonoidGraph 
	"This is a protected mutator. It initializes, but also can return a new  
	instance of the appropriate MonoidGraph membership if possible."
	graph
		ifNil: [graph _ aMonoidGraph. ^ self].
	(aMonoidGraph isKindOf: MonoidGraph)
		ifFalse: [^ self error: 'Monoid arrows can only meaningfully be owned by MonoidGraphs.'].
	^ self class new graph: aMonoidGraph!
]style[(7 12 3 139 2 5 11 5 3 20 5 12 11 11 16 4 8 63 6 4 18 12)f1b,f1cblack;b,f1,f1c146044000,f1,f1cblack;,f1,f1cblack;,f1,f1cblack;,f1,f1cblack;,f1,f1cblack;,f1,f1cblack;,f1,f1cblue;,f1,f1cblack;,f1,f1cblack;! !

!MonoidArrow methodsFor: 'testing' stamp: 'btr 5/29/2001 08:53'!
isIdentity
	"Shortcut the usual test since all arrows of this class are identities."
	^ true! !


!MonoidArrow class methodsFor: 'instance creation' stamp: 'btr 6/12/2001 10:14'!
newFor: aMonoidGraph 
	"Sugaring."
	^ self new initialize graph: aMonoidGraph! !


!MonoidGraph methodsFor: 'accessing' stamp: 'btr 5/30/2001 12:08'!
anyOne
	"Answer kernel -> kernel"
	^ self add: (MonoidArrow newFor: self)! !

!MonoidGraph methodsFor: 'accessing' stamp: 'btr 5/15/2001 18:13'!
kernel
	"Answers my kernel arrow."
	^ kernel! !

!MonoidGraph methodsFor: 'adding' stamp: 'btr 6/13/2001 14:09'!
add: anArrow 
	"I can be initialized by adding an identity arrow. Otherwise, perform the 
	intension check and add a MonoidArrow. All identity ConcreteArrows  
	are then converted to proper MonoidArrows."
	anArrow isIdentity
		ifFalse: [^ self error: 'The added arrow cannot be added to any monoid.'].
	kernel
		ifNil: [kernel _ anArrow head].
	(self intensionallyIncludes: anArrow)
		ifFalse: [^ self error: 'The added arrow does not belong in this monoid.'].
	anArrow
		becomeForward: (MonoidArrow newFor: self).
	cache isEmpty
		ifTrue: [cache _ cache class with: anArrow]
		ifFalse: [cache add: anArrow].
	^ anArrow! !

!MonoidGraph methodsFor: 'comparing' stamp: 'btr 5/15/2001 18:12'!
= anArrowGraph 
	^ kernel == anArrowGraph kernel! !

!MonoidGraph methodsFor: 'comparing' stamp: 'btr 3/19/2001 00:16'!
isSubGraphOf: anArrowGraph 
	"Monoids with the same kernel are all equal. Other graphs are not  
	comparable without a transformation on them."
	anArrowGraph class == MonoidGraph
		ifFalse: [^ self error: 'That graph cannot be compared with a monoid.'].
	^ self = anArrowGraph! !

!MonoidGraph methodsFor: 'initialize' stamp: 'btr 6/13/2001 14:00'!
initialize
	self holdWeakly! !

!MonoidGraph methodsFor: 'initialize' stamp: 'btr 6/13/2001 13:59'!
kernel: anArrow 
	"Protects the kernel arrow from modification after it is initialized."
	kernel
		ifNotNil: [^ MonoidGraph of: anArrow].
	kernel _ anArrow! !

!MonoidGraph methodsFor: 'operations' stamp: 'btr 5/15/2001 18:13'!
applyTo: anArrow 
	"All arrows in a monoid are identities over the kernel arrow."
	anArrow == kernel
		ifFalse: [^ nil].
	^ kernel! !

!MonoidGraph methodsFor: 'operations' stamp: 'btr 4/24/2001 18:27'!
invert
	"Don't even bother with an InvertedGraph layer.
	TODO: possibly remove this overriding method if the significance of keeping the syntactic structure intact is important. modify InversionGraph accordingly to keep the optimization."
	^ self! !

!MonoidGraph methodsFor: 'operations' stamp: 'btr 6/11/2001 10:06'!
invertedApplyTo: anArrow 
	"A monoid only consists of identity arrows, so its inversion applies identically as itself."
	^ self applyTo: anArrow! !

!MonoidGraph methodsFor: 'testing' stamp: 'btr 6/11/2001 10:09'!
includesReferencesTo: anArrow 
	"All my arrows are identities over my kernel."
	^ anArrow == kernel! !

!MonoidGraph methodsFor: 'testing' stamp: 'btr 5/30/2001 12:30'!
intensionallyIncludes: anArrow 
	^ (anArrow isKindOf: MonoidArrow)
		and: [anArrow graph = self]! !

!MonoidGraph methodsFor: 'testing' stamp: 'btr 6/11/2001 10:08'!
treatsAsCodomainElement: anArrow 
	"All my arrows are identities over my kernel."
	^ anArrow == kernel! !

!MonoidGraph methodsFor: 'testing' stamp: 'btr 6/11/2001 10:08'!
treatsAsDomainElement: anArrow 
	"All my arrows are identities over my kernel."
	^ anArrow == kernel! !

!MonoidGraph methodsFor: 'testing' stamp: 'btr 6/11/2001 10:08'!
treatsAsNode: anArrow 
	"All my arrows are identities over my kernel."
	^ anArrow == kernel! !


!MonoidGraph class methodsFor: 'instance creation' stamp: 'btr 6/13/2001 05:36'!
of: anArrow 
	^ self new holdWeakly kernel: anArrow! !


!ObjectGraph methodsFor: 'accessing' stamp: 'btr 4/25/2001 12:04'!
anyOne
	"Answer a random object wrapper and cache it. TODO: find a better 
	randomizer over objects, since this seems to depend on properties of the garbage collection migration mechanism."
	^ self
		add: (Arrow wrapping: self someObject in: self)! !

!ObjectGraph methodsFor: 'accessing' stamp: 'btr 6/12/2001 05:41'!
arrowFor: anObject 
	"Answer an arrow wrapping the given object for me; avoids duplicates."
	^ self
		add: (Arrow wrapping: anObject in: self)! !

!ObjectGraph methodsFor: 'accessing' stamp: 'btr 6/12/2001 06:39'!
closureTo
	^ closureTo! !

!ObjectGraph methodsFor: 'accessing' stamp: 'btr 6/12/2001 06:40'!
instanceOf
	^ instanceOf! !

!ObjectGraph methodsFor: 'accessing' stamp: 'btr 6/18/2001 00:02'!
literals
	"Answer all the literals. However, PointerFinders also count due to a poor hack of #isLiteral to fix a bug in that class."
	^ self >> [:value | value isLiteral and: [(value class == PointerFinder) not]]! !

!ObjectGraph methodsFor: 'accessing' stamp: 'btr 6/18/2001 00:00'!
numbers
	"Return everything that is a number. This does not provide for distinguishment of types."
	^ self >> [:value | value isKindOf: Number]! !

!ObjectGraph methodsFor: 'accessing' stamp: 'btr 6/13/2001 13:56'!
slotOf
	^ slotOf! !

!ObjectGraph methodsFor: 'accessing' stamp: 'btr 6/12/2001 06:40'!
subclassOf
	^ subclassOf! !

!ObjectGraph methodsFor: 'adding' stamp: 'btr 6/13/2001 19:22'!
add: aWrapperArrow 
	"This graph should only contain WrapperArrows. This may be confusing 
	if one wants to add a wrapper for a wrapper and so forth (which is  
	valid, but produces a confusing chain)."
	"TODO: This also could speculatively create arrows for the various  
	meaningful relations for the object wrapped."
	(self intensionallyIncludes: aWrapperArrow)
		ifFalse: [^ self error: 'ObjectGraphs can only meaningfully contain wrapper arrows.'].
	cache isEmpty
		ifTrue: [cache _ cache class with: aWrapperArrow].
	^ cache add: aWrapperArrow!
]style[(5 13 3 298 3 4 24 13 16 4 8 60 4 5 20 5 3 5 13 13 6 6 5 13)f1b,f1cblack;b,f1,f1c148046000,f1,f1cblack;,f1,f1cblack;,f1,f1cblack;,f1,f1cblue;,f1,f1cblack;,f1,f1cblack;,f1,f1cblack;,f1,f1cblack;,f1,f1cblack;,f1,f1cblack;! !

!ObjectGraph methodsFor: 'initialize' stamp: 'btr 6/13/2001 13:57'!
initialize
	super initialize.
	self beIntensional.
	"Don't enumerate through objectGraphs."
	infinitary _ true.
	kernel _ Arrow new.
	subclassOf _ ClassSubclassGraph over: self.
	slotOf _ ObjectInstVarGraph over: self.
	instanceOf _ ClassInstanceGraph over: self.
	closureTo _ ClosureResultGraph over: self! !

!ObjectGraph methodsFor: 'operations' stamp: 'btr 6/13/2001 15:59'!
>> aBlockContext
	"Sugaring."
	^ self filteredBy: aBlockContext! !

!ObjectGraph methodsFor: 'operations' stamp: 'btr 6/13/2001 15:24'!
filteredBy: aBlockContext
	"Provide for filtering of my object wrappers by a test block taking the object as argument. In this generic case, no cache or set of example values is given."
	^ FilteredObjectGraph
		newFrom: {}
		over: self
		for: aBlockContext! !

!ObjectGraph methodsFor: 'operations' stamp: 'btr 6/13/2001 15:35'!
filteredBy: aBlockContext caching: anArrowGraph
	"Provide for filtering of my object wrappers by a test block taking the  
	object as argument and an example graph of wrappers satisfying the  
	test."
	^ FilteredObjectGraph
		newFrom: anArrowGraph asSet
		over: self
		for: aBlockContext! !

!ObjectGraph methodsFor: 'testing' stamp: 'btr 6/13/2001 13:52'!
intensionallyIncludes: aWrapperArrow 
	"Every wrapped Smalltalk object counts as an element, unless it is 
	initialized for another objectGraph already."
	^ (aWrapperArrow isWrapper)
		and: [aWrapperArrow objectGraph = self
				or: [aWrapperArrow objectGraph isNil]]! !


!ObjectGraph class methodsFor: 'instance creation' stamp: 'btr 4/11/2001 20:25'!
of: anArrow
	"Initialization takes over for this, since it's meaningless what arrow is the kernel in this case."
	^ self shouldNotImplement! !


!ObjectInstVarGraph methodsFor: 'operations' stamp: 'btr 6/21/2001 01:05'!
applyTo: anArrow 
	"This answers a graph of wrapper arrows for all the objects used in the  
	argument's slots."
	^ objectGraph >> [:value | anArrow object pointsTo: value]
			addAll: (anArrow object class allInstVarNames
				collect: [:each | Arrow
						wrapping: (self instVarNamed: each)
						in: objectGraph])! !

!ObjectInstVarGraph methodsFor: 'operations' stamp: 'btr 6/21/2001 01:06'!
invertedApplyTo: anArrow 
	"This collects all objects having slots pointing to the argument slot,  
	answering a graph of arrow-wrappers for them."
	^ objectGraph >> [:value | value pointsTo: anArrow object]
			addAll: ((Smalltalk pointersTo: anArrow except: #()) asSet
				collect: [:each | Arrow wrapping: each in: objectGraph])! !

!ObjectInstVarGraph methodsFor: 'testing' stamp: 'btr 5/29/2001 17:16'!
intensionallyIncludes: anArrow 
	"This graph includes arrows from objects to all the objects in their slots."
	^ anArrow domainElement object pointsTo: anArrow codomainElement object! !

!ObjectInstVarGraph methodsFor: 'testing' stamp: 'btr 5/31/2001 06:12'!
treatsAsCodomainElement: anArrow
	"If an object is wrapped, it is obviously pointed-to, hence not GC'd, so it must be a slot of another object and therefore the codomainElement of this graph type's instances."
	^ anArrow isWrapper! !

!ObjectInstVarGraph methodsFor: 'testing' stamp: 'btr 5/31/2001 06:10'!
treatsAsDomainElement: anArrow
	^ (super treatsAsDomainElement: anArrow)
		and: [anArrow object size > 0]! !


!PluggableGraph methodsFor: 'initialize' stamp: 'btr 5/30/2001 09:45'!
block: aBlockContext 
	"Protected mutator. Graphs' intensions must be immutable."
	block
		ifNotNil: [^ self class for: aBlockContext].
	block _ aBlockContext! !

!PluggableGraph methodsFor: 'initialize' stamp: 'btr 5/30/2001 09:42'!
selector: aSelector args: anArray 
	"Protected mutator. Graphs' intensions must be immutable."
	selector
		ifNotNil: [^ self class
				using: aSelector
				args: anArray].
	"Test to ensure that the symbol aSelector is a valid selector."
	aSelector numArgs < 0
		ifTrue: [^ self error: aSelector asString , ' is not a valid selector.'].
	selector _ aSelector.
	"Coerce anArray to an array."
	args _ anArray asArray.
	block
		ifNotNil: [self
				block: [:anArrow | (anArrow domainElement perform: selector withArguments: args)
						= anArrow codomainElement]]! !

!PluggableGraph methodsFor: 'operations' stamp: 'btr 6/13/2001 22:56'!
applyTo: anArrow 
	"If selector is defined, make a MessageSend that will apply to the  
	given arrow and answer its result."
	selector
		ifNil: [^ self notYetImplemented].
	^ FilteredGraph
		newFrom: {(MessageSend
			receiver: anArrow
			selector: selector
			arguments: args) value}
		of: ArrowGraph top
		for: [:value | (anArrow perform: selector withArguments: args) = value]! !

!PluggableGraph methodsFor: 'testing' stamp: 'btr 5/30/2001 04:32'!
intensionallyIncludes: anArrow 
	"The block verifies the input-output pair."
	^ block value: anArrow! !

!PluggableGraph methodsFor: 'testing' stamp: 'btr 6/6/2001 11:23'!
treatsAsDomainElement: anArrow 
	"Checks that the arrow actually understands the selector. Since #ifNotNil: returns the receiver if it's nil, the logic contains a short-circuit."
	^ (super treatsAsDomainElement: anArrow)
		and: [selector
				ifNotNil: [^ anArrow respondsTo: selector].
			true]! !


!PluggableGraph class methodsFor: 'instance creation' stamp: 'btr 5/30/2001 09:45'!
for: aBlockContext 
	"Return a new instance of me for the given block closure. Notice that 
	this is never guaranteed to be unique by the class."
	^ self new block: aBlockContext! !

!PluggableGraph class methodsFor: 'instance creation' stamp: 'btr 5/30/2001 09:44'!
using: aSelector args: anArray 
	^ self new initialize
		selector: aSelector
		args: anArray! !


!PluggableObjectGraph methodsFor: 'initialize' stamp: 'btr 6/1/2001 14:02'!
block: aBlockContext 
	"Protected mutator. Graphs' intensions must be immutable."
	objectGraph
		ifNil: [^ self error: 'The objectGraph must be known.'].
	block
		ifNotNil: [
			^ self class over: objectGraph for: aBlockContext].
	block _ aBlockContext! !

!PluggableObjectGraph methodsFor: 'initialize' stamp: 'btr 6/10/2001 14:34'!
over: anObjectGraph block: aBlockContext 
	"Coupled initializers for sugaring."
	^ (self over: anObjectGraph)
		block: aBlockContext! !

!PluggableObjectGraph methodsFor: 'initialize' stamp: 'btr 6/10/2001 14:35'!
over: anObjectGraph selector: aSelector args: anArray 
	"Coupled initializers for sugaring."
	^ (self over: anObjectGraph)
		selector: aSelector
		args: anArray! !

!PluggableObjectGraph methodsFor: 'initialize' stamp: 'btr 5/30/2001 09:17'!
selector: aSelector 
	"Protected mutator. Graphs' intensions must be immutable."
	^ self selector: aSelector args: #()! !

!PluggableObjectGraph methodsFor: 'initialize' stamp: 'btr 6/1/2001 14:02'!
selector: aSelector args: anArray 
	"Protected mutator. Graphs' intensions must be immutable."
	objectGraph
		ifNil: [^ self error: 'The objectGraph must be known.'].
	selector
		ifNotNil: [^ self class
				over: objectGraph
				using: aSelector
				args: anArray].
	"Test to ensure that the symbol aSelector is a valid selector."
	aSelector numArgs < 0
		ifTrue: [^ self error: aSelector asString , ' is not a valid selector.'].
	selector _ aSelector.
	"Coerce anArray to an array."
	args _ anArray asArray.
	block
		ifNotNil: [self
				block: [:anArrow | (anArrow domainElement object perform: selector withArguments: args)
						= anArrow codomainElement object]]! !

!PluggableObjectGraph methodsFor: 'operations' stamp: 'btr 6/21/2001 01:09'!
applyTo: anArrow 
	"If selector or block is defined, apply it to the given arrow's object and  
	answer its wrapped result."
	| a |
	selector
		ifNil: [block
				ifNil: [^ nil]
				ifNotNil: [a _ block value: anArrow object.
					^ objectGraph
						>> [:value | a = value]
						add: (Arrow wrapping: a in: objectGraph)]].
	(self treatsAsDomainElement: anArrow)
		ifFalse: [^ nil].
	a _ anArrow object perform: selector withArguments: args.
	^ objectGraph
		>> [:value | a = value] add: (Arrow wrapping: a in: objectGraph)! !

!PluggableObjectGraph methodsFor: 'operations' stamp: 'btr 6/21/2001 01:10'!
invertedApplyTo: anArrow 
	"If selector or block is defined, answer a graph which lazily filters  
	results."
	selector
		ifNil: [block
				ifNil: [^ nil]
				ifNotNil: [^ objectGraph >> [:value | (block value: value)
								= anArrow object]]].
	(self treatsAsDomainElement: anArrow)
		ifFalse: [^ nil].
	^ objectGraph
		>> [:value | (value perform: selector withArguments: args)
				= anArrow object]! !

!PluggableObjectGraph methodsFor: 'testing' stamp: 'btr 5/30/2001 05:58'!
intensionallyIncludes: anArrow 
	"The block verifies the input-output pair."
	^ block value: anArrow! !

!PluggableObjectGraph methodsFor: 'testing' stamp: 'btr 5/31/2001 06:07'!
treatsAsDomainElement: anArrow 
	"Checks that the arrow's wrapped object actually understands the selector. Since #ifNotNil: returns the receiver if it's nil, the logic contains a short-circuit."
	^ (super treatsAsDomainElement: anArrow)
		and: [selector
				ifNotNil: [^ anArrow object respondsTo: selector].
			true]! !


!PluggableObjectGraph class methodsFor: 'instance creation' stamp: 'btr 5/30/2001 06:07'!
over: anObjectGraph
	"This class needs a parameter block closure to complete its semantics. See #over:for:."
	^ self over: anObjectGraph for: []! !

!PluggableObjectGraph class methodsFor: 'instance creation' stamp: 'btr 6/10/2001 14:35'!
over: anObjectGraph for: aBlockContext 
	"Answer a new instance with the given arguments completing the  
	semantics."
	^ self new initialize over: anObjectGraph block: aBlockContext! !

!PluggableObjectGraph class methodsFor: 'instance creation' stamp: 'btr 5/30/2001 09:20'!
over: anObjectGraph using: aSelector 
	^ self
		over: anObjectGraph
		using: aSelector
		args: #()! !

!PluggableObjectGraph class methodsFor: 'instance creation' stamp: 'btr 6/10/2001 14:35'!
over: anObjectGraph using: aSelector args: anArray 
	^ self new initialize
		over: anObjectGraph
		selector: aSelector
		args: anArray! !


!Reference methodsFor: 'accessing' stamp: 'btr 3/4/2001 21:20'!
value
	^ value! !

!Reference methodsFor: 'accessing' stamp: 'btr 3/28/2001 10:14'!
value: anObject 
	"Proper use of the Reference class will ensure that this abstract method never gets called."
	self subclassResponsibility! !

!Reference methodsFor: 'copying' stamp: 'btr 3/2/2001 20:15'!
clone
	"Answer with the receiver, because References are unique per object."
	^ self! !

!Reference methodsFor: 'copying' stamp: 'btr 3/2/2001 20:15'!
copy
	"Answer with the receiver, because References are unique per object."
	^ self! !

!Reference methodsFor: 'copying' stamp: 'btr 3/2/2001 20:30'!
deepCopy
	"Objects using the Reference class are obviously concerned with circularity or meta-circularity of reference, and so should not be trying to do this."
	^ self shouldNotImplement! !

!Reference methodsFor: 'copying' stamp: 'btr 3/2/2001 20:15'!
shallowCopy
	"Answer with the receiver, because References are unique per object."
	^ self! !

!Reference methodsFor: 'copying' stamp: 'btr 2/27/2001 22:14'!
veryDeepCopyWith: deepCopier 
	"Return self. I am immutable in the Morphic world. Do not record me."
	^ self! !

!Reference methodsFor: 'testing' stamp: 'btr 3/21/2001 15:20'!
isTo: anObject 
	"I could also answer by an #= comparison vice #==."
	^ value == anObject! !


!Reference class methodsFor: 'instance creation' stamp: 'btr 3/6/2001 17:52'!
for: aBlock 
	^ SuspendedReference for: aBlock! !

!Reference class methodsFor: 'instance creation' stamp: 'btr 3/6/2001 17:52'!
futureOf: aBlock 
	^ SuspendedReference for: aBlock! !

!Reference class methodsFor: 'instance creation' stamp: 'btr 3/6/2001 17:52'!
to: anObject 
	^ ValueReference to: anObject! !

!Reference class methodsFor: 'instance variables' stamp: 'btr 5/15/2001 10:18'!
removeDuplicates
	"There MUST be a better way to do this. This is O(n squared) at the very  
	least."
	self
		allSubInstancesDo: [:each | self class
				allSubInstancesDo: [:other | other = each
						ifTrue: [other becomeForward: each]]]! !


!SafeMessageSend methodsFor: 'accessing' stamp: 'btr 6/9/2001 12:59'!
arguments: anArray
	^ self shouldNotImplement! !

!SafeMessageSend methodsFor: 'accessing' stamp: 'btr 6/9/2001 12:55'!
receiver
	"Attempts to access my receiver could mutate it, resulting in unsafe semantics. Keep in mind that #receiver: always makes a local clone to prevent other outside manipulations."
	^ self shouldNotImplement! !

!SafeMessageSend methodsFor: 'accessing' stamp: 'btr 6/9/2001 12:58'!
receiver: anObject
	^ self shouldNotImplement! !

!SafeMessageSend methodsFor: 'accessing' stamp: 'btr 6/9/2001 12:59'!
selector: aSymbol 
	^ self shouldNotImplement! !

!SafeMessageSend methodsFor: 'initialize' stamp: 'btr 6/9/2001 13:06'!
receiver: anObject selector: aSymbol arguments: anArray
	((aSymbol isKindOf: Symbol)
		and: [aSymbol numArgs >= 0])
		ifFalse: [^ aSymbol asString , ' is not a proper selector.'].
	(selector isNil & arguments isNil)
		ifFalse: [^ self error: 'I am already initialized.'].
	receiver _ anObject clone.
	selector _ aSymbol.
	arguments _ anArray asArray! !


!SetOpsGraph methodsFor: 'accessing' stamp: 'btr 6/13/2001 13:20'!
firstArg
	^ apex tail! !

!SetOpsGraph methodsFor: 'accessing' stamp: 'btr 6/13/2001 13:20'!
secondArg
	^ apex head! !


!IntersectionGraph methodsFor: 'accessing' stamp: 'btr 6/10/2001 10:18'!
anyOne
	"Scan through arrows in my smaller argument until one shows up in  
	the larger. If the cache doesn't have it, suppose that one exists and  
	return that."
	self orientTailSmaller.
	"First check the smaller's cache."
	self firstArg cache
		do: [:each | (self secondArg includes: each)
				ifTrue: [^ each]].
	"No cached arrows from the smaller worked, so now we check the  
	larger's cache against the smaller's intension."
	self secondArg cache
		do: [:each | (self firstArg intensionallyIncludes: each)
				ifTrue: [^ self firstArg add: each]].
	"Nothing in the caches works. Now just suppose that there's an answer  
	and return that."
	"TODO: fix the semantics of this."
	^ self secondArg add: self firstArg anyOne! !

!IntersectionGraph methodsFor: 'adding' stamp: 'btr 6/10/2001 10:19'!
add: anArrow 
	"If someone wants to add an arrow, obviously it belongs in both  
	arguments of the intersection operation."
	self firstArg add: anArrow.
	self secondArg add: anArrow.
	^ anArrow! !

!IntersectionGraph methodsFor: 'comparing' stamp: 'btr 6/10/2001 14:11'!
isSubGraphOf: anArrowGraph 
	"The smaller argument restricted to the larger is equivalent and an  
	optimal handling for this relatively ambiguous case. However the case where the intersection is a subgraph, but neither of the intersection operands are subgraphs, is not handled in the generic intensional case."
	self orientTailSmaller.
	^ ((self firstArg isSubGraphOf: anArrowGraph)
		and: [self secondArg isSubGraphOf: anArrowGraph])
		or: [((self firstArg cache intersection: self secondArg cache)
			anySatisfy: [:each | (anArrowGraph includes: each) not]) not]! !

!IntersectionGraph methodsFor: 'comparing' stamp: 'btr 6/10/2001 14:14'!
isSuperGraphOf: anArrowGraph 
	"The generic intensional case is not handled."
	^ ((self firstArg isSuperGraphOf: anArrowGraph)
			and: [self secondArg isSuperGraphOf: anArrowGraph])
		and: [((self firstArg cache intersect: self secondArg cache)
				anySatisfy: [:each | (anArrowGraph includes: each) not]) not]! !

!IntersectionGraph methodsFor: 'initialize' stamp: 'btr 6/13/2001 13:31'!
initialize
	"My operands must be known before initializing. Use SetOpsGraph 
	class>>#of:with:."
	infinitary _ self firstArg isFinite
				or: [self secondArg isFinite].
	self beIntensional! !

!IntersectionGraph methodsFor: 'operations' stamp: 'btr 6/10/2001 10:19'!
doesNotUnderstand: aMessage 
	"Many of the messages of this class just delegate to its arguments with  
	the very same combination operator."
	"e.g. applyTo: invertedApplyTo: includes: intensionallyIncludes: and all  
	the protocol that relies upon them."
	^ (aMessage sentTo: self firstArg)
		& (aMessage sentTo: self secondArg)! !


!SetOpsGraph class methodsFor: 'instance creation' stamp: 'btr 6/15/2001 19:42'!
new
	"Override the odd hack in ArrowGraph class>>#new."
	^ self basicNew initialize! !

!SetOpsGraph class methodsFor: 'instance creation' stamp: 'btr 6/13/2001 13:19'!
of: firstGraph and: secondGraph 
	"Sugaring."
	^ self of: firstGraph with: secondGraph ! !

!SetOpsGraph class methodsFor: 'instance creation' stamp: 'btr 6/15/2001 07:03'!
of: firstGraph with: secondGraph 
	^ self new apex: firstGraph -> secondGraph;
		 initialize! !


!SingletonGraph methodsFor: 'accessing' stamp: 'btr 5/22/2001 06:03'!
anyOne
	"An accessor that implicitly initializes the singleton arrow if necessary."
	self isInitialized
		ifFalse: [^ (self singleton: Arrow new) anyOne].
	^ singleton! !

!SingletonGraph methodsFor: 'accessing' stamp: 'btr 6/10/2001 12:27'!
cache
	^ singleton
		ifNil: [{}]
		ifNotNil: [WeakSet with: singleton]! !

!SingletonGraph methodsFor: 'accessing' stamp: 'btr 3/19/2001 18:36'!
singleton
	^ singleton! !

!SingletonGraph methodsFor: 'adding' stamp: 'btr 6/15/2001 06:46'!
add: anArrow 
	(self isInitialized
			and: [(anArrow == singleton) not])
		ifTrue: [^ self error: 'Singletons can only contain one element.'].
	self singleton: anArrow.
	^ anArrow! !

!SingletonGraph methodsFor: 'comparing' stamp: 'btr 3/19/2001 18:29'!
isSubGraphOf: anArrowGraph
	^ anArrowGraph includes: singleton! !

!SingletonGraph methodsFor: 'comparing' stamp: 'btr 6/11/2001 16:21'!
isSuperGraphOf: anArrowGraph
	"Only an empty graph could have fewer elements."
	^ anArrowGraph class = EmptyGraph
		or: [anArrowGraph isExtensional
			and: [anArrowGraph cache size = 0]]! !

!SingletonGraph methodsFor: 'initialize' stamp: 'btr 5/8/2001 10:03'!
initialize
	"I am intensional but my cache is not used. Don't re-send this message."
	infinitary _ true.
	cache _ nil! !

!SingletonGraph methodsFor: 'initialize' stamp: 'btr 6/10/2001 12:28'!
isInitialized
	^ singleton isNil not! !

!SingletonGraph methodsFor: 'initialize' stamp: 'btr 6/10/2001 12:24'!
singleton: anArrow 
	"Protected mutator. The cache isn't used by this graph type."
	self isInitialized
		ifFalse: [singleton _ anArrow.
			^ self].
	singleton = anArrow
		ifTrue: [^ self].
	^ SingletonGraph of: anArrow! !

!SingletonGraph methodsFor: 'operations' stamp: 'btr 6/11/2001 16:11'!
applyTo: anArrow 
	"My singleton is the only arrow to check against."
	anArrow == singleton domainElement
		ifTrue: [^ singleton codomainElement].
	^ nil! !

!SingletonGraph methodsFor: 'operations' stamp: 'btr 6/11/2001 16:15'!
applyToGraph: anArrowGraph 
	"My singleton is the only arrow to check against."
	(anArrowGraph includes: singleton domainElement)
		ifTrue: [^ singleton codomainElement].
	^ nil! !

!SingletonGraph methodsFor: 'operations' stamp: 'btr 6/11/2001 16:11'!
invertedApplyTo: anArrow 
	"My singleton is the only arrow to check against."
	anArrow == singleton codomainElement
		ifTrue: [^ singleton domainElement].
	^ nil! !

!SingletonGraph methodsFor: 'operations' stamp: 'btr 6/11/2001 16:16'!
invertedApplyToGraph: anArrowGraph 
	"My singleton is the only arrow to check against."
	(anArrowGraph includes: singleton codomainElement)
		ifTrue: [^ singleton domainElement].
	^ nil! !

!SingletonGraph methodsFor: 'set operations' stamp: 'btr 6/11/2001 15:58'!
& anArrowGraph
	"An intersection of a singleton and another graph returns either the singleton or an empty graph."
	^ (anArrowGraph includes: singleton)
		ifTrue: [self]
		ifFalse: [ArrowGraph bottom]! !

!SingletonGraph methodsFor: 'testing' stamp: 'btr 3/19/2001 18:27'!
includes: anArrow
	^ anArrow == singleton! !

!SingletonGraph methodsFor: 'testing' stamp: 'btr 3/28/2001 10:13'!
intensionallyIncludes: anArrow 
	"This graph type has no logical condition to satisfy."
	^ false! !


!SingletonGraph class methodsFor: 'instance creation' stamp: 'btr 3/19/2001 18:38'!
of: anArrow
	^ self new initialize singleton: anArrow! !


!SquareGraph methodsFor: 'accessing' stamp: 'btr 6/10/2001 09:51'!
anyOne
	"Try not to create new arrows if possible. Just return something that  
	works."
	cache isEmpty
		ifTrue: [^ frame arrows anyOne -> frame arrows anyOne addToGraph: self].
	^ cache anyOne! !

!SquareGraph methodsFor: 'accessing' stamp: 'btr 5/29/2001 05:57'!
valueOf: anArrow 
	"Ensure that we get a unique instance with the same value."
	(self treatsAsNode: anArrow)
		ifFalse: [^ anArrow world valueOf: anArrow].
	anArrow class == Arrow
		ifTrue: [^ self error: 'Value-representation of abstract arrows is not yet implemented.'].
	^ self
		add: (cache
				detect: [:each | each equals: anArrow]
				ifNone: [^ self add: anArrow clone])! !

!SquareGraph methodsFor: 'adding' stamp: 'btr 5/27/2001 20:45'!
add: anArrow 
	"Don't allow duplicate values, and don't check for intensionallyIncludes:, 
	because any arrow is a legal value as long as the SquareGraph has no 
	duplicate instances for the same value."
	^ cache
		detect: [:each | each equals: anArrow]
		ifNone: [(cache isNil
			or: [cache size = 0])
		ifTrue: [^ cache _ WeakSet with: anArrow].
	^ cache add: anArrow]! !

!SquareGraph methodsFor: 'operations' stamp: 'btr 6/11/2001 10:04'!
applyTo: anArrow 
	"Return all possible arrows. Arrow allInstances will not do in this case."
	^ ArrowGraph top! !

!SquareGraph methodsFor: 'operations' stamp: 'btr 5/8/2001 00:59'!
invertedApplyTo: anArrow 
	"All values belong, and inverses of values have values, so the inversion is identical to the original."
	^ self applyTo: anArrow! !

!SquareGraph methodsFor: 'testing' stamp: 'btr 3/23/2001 14:41'!
intensionallyIncludes: anArrow 
	"Answer false because only arrows that are in my cache already can be 
	guaranteed unique from all other arrow instances with the same value. This relies on SquareGraph overriding add: to not check for intensional inclusion."
	^ false! !

!SquareGraph methodsFor: 'testing' stamp: 'btr 5/16/2001 06:19'!
treatsAsNode: anArrow 
	"All arrows in the frame have values. (Notice that if they are value arrows then their values are themselves.)"
	^ frame includes: anArrow! !


!SuspendedReference methodsFor: 'accessing' stamp: 'btr 3/6/2001 18:37'!
suspension
	^ suspension! !

!SuspendedReference methodsFor: 'accessing' stamp: 'btr 3/6/2001 18:40'!
suspension: aBlockContext 
	suspension
		ifNil: [(aBlockContext isKindOf: BlockContext)
				ifTrue: 
					[suspension _ aBlockContext.
					^ self]
				ifFalse: [^ self error: 'You must pass a block for a lazy reference to use.']].
	suspension = aBlockContext
		ifTrue: [^ self]
		ifFalse: [^ self class new suspension: aBlockContext]! !

!SuspendedReference methodsFor: 'accessing' stamp: 'btr 3/6/2001 18:42'!
value
	"When the value of the reference is not already calculated and cached,  
	the suspension should be executed to render and cache the value. This  
	is what makes a SuspendedReference a Lazy object wrapping. Notice 
	that this returns a ValueReference."
	value
		ifNil: 
			[suspension ifNil: [^ self error: 'No evaluation possible on un-initialized lazy references.'].
			value _ suspension value].
	^ Reference to: value! !

!SuspendedReference methodsFor: 'accessing' stamp: 'btr 3/6/2001 17:53'!
value: anObject 
	"Break the lazy evaluation rule to make sure we aren't duplicating  
	references. This doesn't seem a good way to handle it. Maybe I should 
	answer with a promise instead of a direct answer."
	anObject == self value ifTrue: [^ self].
	^ ValueReference to: anObject! !

!SuspendedReference methodsFor: 'comparing' stamp: 'btr 3/21/2001 15:22'!
= aReference 
	"This forces evaluation."
	^ self value == aReference value! !


!SuspendedReference class methodsFor: 'instance creation' stamp: 'btr 3/6/2001 18:39'!
for: aBlock 
	"This checks to return any existing Reference instance to the argument  
	before allocating a new one."
	"TODO: Re-implement using a weak collection as a class variable to track 
	all reference instances."
	self
		allInstancesDo: [:eachReference | eachReference suspension = aBlock ifTrue: [^ eachReference]].
	^ Reference new suspension: aBlock! !

!SuspendedReference class methodsFor: 'instance creation' stamp: 'btr 3/4/2001 22:23'!
futureOf: aBlock
	^ self for: aBlock! !

!SuspendedReference class methodsFor: 'instance creation' stamp: 'btr 3/4/2001 22:22'!
to: aBlock 
	"Lazy references should only be instantiated for things with future values, not to the values themselves as such (as values)."
	^ self shouldNotImplement! !


!TailGraph methodsFor: 'operations' stamp: 'btr 5/8/2001 10:28'!
applyTo: anArrow 
	"Reifies the tail of the arrow as another arrow. Notice that  
	the answer provided is not unique by necessity."
	cache
		detect: [:each | each domainElement == anArrow]
		ifNone: [| newArrow | 
			"Only works on ConcreteArrows."
	newArrow _ anArrow raiseTail.
	^ cache
		detect: [:eachArrow | eachArrow = newArrow]
		ifNone: [self add: newArrow]]! !

!TailGraph methodsFor: 'operations' stamp: 'btr 5/8/2001 10:29'!
invertedApplyTo: anArrow 
	"First check to make sure the argument is valid as a reified head 
	reference. If so, return the arrow it would have been the result of."
	(self intensionallyIncludes: anArrow)
		ifFalse: [^ nil].
	^ anArrow domainElement! !

!TailGraph methodsFor: 'testing' stamp: 'btr 5/8/2001 14:22'!
intensionallyIncludes: anArrow 
	"My arrows simply have to lead from one arrow in the frame to the  
	arrow that its head references (if there is one). Also note that since all  
	arrows in the graph are in the frame automatically, it must also be  
	searched. TODO: implement this."
	(frame includes: anArrow tail)
		ifFalse: [^ false].
	anArrow class == ConcreteArrow
		ifTrue: [^ self intensionallyIncludes: anArrow using: #tail].
	^ false! !

!TailGraph methodsFor: 'testing' stamp: 'btr 5/15/2001 18:36'!
treatsAsNode: anArrow 
	"All arrows in the frame can have their tail references reified as other  
	arrows."
	^ frame includes: anArrow! !


!TopOrBottomGraph methodsFor: 'accessing' stamp: 'btr 6/10/2001 16:45'!
cache
	"Caches are useless for graphs of this kind. Don't implement unless it will prevent an error."
	self shouldNotImplement! !

!TopOrBottomGraph methodsFor: 'comparing' stamp: 'btr 6/10/2001 16:05'!
= anArrowGraph 
	"All graphs of this type are equal."
	^ anArrowGraph class == self class! !

!TopOrBottomGraph methodsFor: 'comparing' stamp: 'btr 6/10/2001 16:05'!
isSubGraphOf: anArrowGraph
	^ self = anArrowGraph! !

!TopOrBottomGraph methodsFor: 'initialize' stamp: 'btr 6/10/2001 16:10'!
cache: aSet 
	"Don't allow this to happen for now. Ideally this would be equivalent to muting the world or worlds, which would be ridiculously complex."
	^ self shouldNotImplement! !


!EmptyGraph methodsFor: 'accessing' stamp: 'btr 6/10/2001 16:44'!
anyOne
	"I am empty."
	^ nil! !

!EmptyGraph methodsFor: 'accessing' stamp: 'btr 6/10/2001 16:08'!
cache
	"I am empty."
	^ {}! !

!EmptyGraph methodsFor: 'adding' stamp: 'btr 6/10/2001 16:09'!
add: anArrow 
	"My intension is to be empty."
	^ self error: 'This graph is intended to be empty.'! !

!EmptyGraph methodsFor: 'adding' stamp: 'btr 6/10/2001 16:47'!
addImmutable: anArrow
	"Answer a graph containing just that arrow, since I have none."
	^ SingletonGraph of: anArrow! !

!EmptyGraph methodsFor: 'comparing' stamp: 'btr 6/13/2001 12:11'!
isSubGraphOf: anArrowGraph 
	"I am a subgraph of any non-empty graph or intensional graph."
	^ (anArrowGraph class = self class) not
		and: [anArrowGraph cache size > 0
				or: [anArrowGraph isIntensional]]! !

!EmptyGraph methodsFor: 'comparing' stamp: 'btr 6/10/2001 16:17'!
isSuperGraphOf: anArrowGraph 
	"I am only a superclass of other empty graphs, and even then only  
	improperly."
	^ anArrowGraph class == self class! !

!EmptyGraph methodsFor: 'operations' stamp: 'btr 6/10/2001 16:07'!
applyTo: anArrow 
	"I am empty."
	^ nil! !

!EmptyGraph methodsFor: 'operations' stamp: 'btr 6/10/2001 16:07'!
applyToGraph: anArrowGraph 
	"I am empty."
	^ nil! !

!EmptyGraph methodsFor: 'operations' stamp: 'btr 6/10/2001 16:07'!
invertedApplyTo: anArrow 
	"I am empty."
	^ nil! !

!EmptyGraph methodsFor: 'operations' stamp: 'btr 6/10/2001 16:06'!
invertedApplyToGraph: anArrowGraph 
	"I am empty."
	^ nil! !

!EmptyGraph methodsFor: 'set operations' stamp: 'btr 6/10/2001 16:23'!
& anArrowGraph
	"Intersections with empty sets produce empty sets."
	(anArrowGraph isKindOf: ArrowGraph)
		ifFalse: [^ nil].
	^ self! !

!EmptyGraph methodsFor: 'set operations' stamp: 'btr 6/10/2001 16:24'!
| anArrowGraph 
	"Unions with empty sets produce the identical input."
	(anArrowGraph isKindOf: ArrowGraph)
		ifFalse: [^ nil].
	^ anArrowGraph! !

!EmptyGraph methodsFor: 'testing' stamp: 'btr 6/10/2001 16:08'!
includes: anArrow 
	"I am empty."
	^ false! !

!EmptyGraph methodsFor: 'testing' stamp: 'btr 6/10/2001 16:07'!
intensionallyIncludes: anArrow
	"I am empty."
	^ false! !

!EmptyGraph methodsFor: 'testing' stamp: 'btr 6/10/2001 16:08'!
treatsAsCodomainElement: anArrow 
	"I am empty."
	^ false! !

!EmptyGraph methodsFor: 'testing' stamp: 'btr 6/10/2001 16:08'!
treatsAsDomainElement: anArrow 
	"I am empty."
	^ false! !


!TopGraph methodsFor: 'accessing' stamp: 'btr 6/10/2001 16:45'!
anyOne
	"I contain everything. So I just answer with something."
	^ Arrow new! !

!TopGraph methodsFor: 'adding' stamp: 'btr 5/8/2001 09:58'!
add: anArrow 
	"Do nothing. A cache is useless in this case."
	^ anArrow! !

!TopGraph methodsFor: 'adding' stamp: 'btr 6/10/2001 16:10'!
addImmutable: anArrow 
	"Do nothing, since this graph already includes every possible arrow."
	^ self! !

!TopGraph methodsFor: 'comparing' stamp: 'btr 6/10/2001 16:18'!
isSubGraphOf: anArrowGraph
	"I am only a subgraph of other all-inclusive graphs, and even then only improperly."
	^ anArrowGraph class == self class! !

!TopGraph methodsFor: 'comparing' stamp: 'btr 6/13/2001 14:56'!
isSuperGraphOf: anArrowGraph 
	"Any graph not of my type is a proper subclass."
	^ self class ~~ anArrowGraph class! !

!TopGraph methodsFor: 'operations' stamp: 'btr 6/10/2001 16:41'!
applyTo: anArrow 
	"I answer everything."
	^ self! !

!TopGraph methodsFor: 'operations' stamp: 'btr 6/10/2001 16:41'!
applyToGraph: anArrowGraph 
	"I answer everything."
	^ self! !

!TopGraph methodsFor: 'operations' stamp: 'btr 6/10/2001 16:41'!
invertedApplyTo: anArrow 
	"I answer everything."
	^ self! !

!TopGraph methodsFor: 'operations' stamp: 'btr 6/10/2001 16:41'!
invertedApplyToGraph: anArrowGraph 
	"I answer everything."
	^ self! !

!TopGraph methodsFor: 'set operations' stamp: 'btr 6/10/2001 16:26'!
& anArrowGraph 
	"Intersections with top sets produce the identical input."
	(anArrowGraph isKindOf: ArrowGraph)
		ifFalse: [^ nil].
	^ anArrowGraph! !

!TopGraph methodsFor: 'set operations' stamp: 'btr 6/10/2001 16:25'!
| anArrowGraph 
	"Unions with top sets produce top sets."
	(anArrowGraph isKindOf: ArrowGraph)
		ifFalse: [^ nil]! !

!TopGraph methodsFor: 'testing' stamp: 'btr 6/10/2001 16:43'!
includes: anArrow 
	"I contain everything."
	^ anArrow isKindOf: Arrow! !

!TopGraph methodsFor: 'testing' stamp: 'btr 6/10/2001 16:43'!
intensionallyIncludes: anArrow 
	"I contain everything."
	^ anArrow isKindOf: Arrow! !

!TopGraph methodsFor: 'testing' stamp: 'btr 6/10/2001 16:43'!
treatsAsCodomainElement: anArrow 
	"I contain everything."
	^ anArrow isKindOf: Arrow! !

!TopGraph methodsFor: 'testing' stamp: 'btr 6/10/2001 16:43'!
treatsAsDomainElement: anArrow 
	"I contain everything."
	^ anArrow isKindOf: Arrow! !


!UnionGraph methodsFor: 'accessing' stamp: 'btr 6/9/2001 13:24'!
anyOne
	"Answers an arrow included in either graph. This should be  
	non-deterministic between the arguments.  
	NOTE: such a simple randomizer means that this does not extend  
	properly beyond two arguments in the union. I.E. the union of a union 
	will favor the first argument over the second and third individually."
	^ (apex at: 2 atRandom - 1) anyOne! !

!UnionGraph methodsFor: 'adding' stamp: 'btr 6/13/2001 13:25'!
add: anArrow 
	"Delegate addition to the constituents which contain them. TODO: fix the leak that exists for where the arrow belongs to neither operand."
	(self firstArg includes: anArrow)
		ifTrue: [self firstArg add: anArrow].
	(self secondArg includes: anArrow)
		ifTrue: [self secondArg add: anArrow].
	^ anArrow! !

!UnionGraph methodsFor: 'comparing' stamp: 'btr 6/10/2001 10:21'!
isSubGraphOf: anArrowGraph 
	"Both of a union's arguments must satisfy the same <= relationship.  
	Check the smaller first; check the larger lazily on failure of the former 
	condition."
	self orientTailSmaller.
	^ (self firstArg isSubGraphOf: anArrowGraph)
		and: [self secondArg isSubGraphOf: anArrowGraph]! !

!UnionGraph methodsFor: 'comparing' stamp: 'btr 6/10/2001 14:04'!
isSuperGraphOf: anArrowGraph 
	"Perform quick checks on the argument against my firstArg and  
	secondArg since they are encoded as subgraphs of me."
	^ (self firstArg = anArrowGraph
			or: [self secondArg = anArrowGraph])
		or: [(anArrowGraph cache
				anySatisfy: [:eachArrow | (self firstArg includes: eachArrow) not
						and: [(self secondArg includes: eachArrow) not]]) not]! !

!UnionGraph methodsFor: 'initialize' stamp: 'btr 6/13/2001 13:31'!
initialize
	"My operands must be known before initializing. Use SetOpsGraph 
	class>>#of:with:. "
	infinitary _ self firstArg isFinite not
				or: [self secondArg isFinite not].
	self beIntensional! !

!UnionGraph methodsFor: 'operations' stamp: 'btr 6/10/2001 10:22'!
doesNotUnderstand: aMessage 
	"Many of the messages of this class just delegate to its arguments with  
	the very same combination operator."
	"e.g. applyTo: invertedApplyTo: includes: intensionallyIncludes:"
	^ (aMessage sentTo: self firstArg)
		| (aMessage sentTo: self secondArg)! !


!ValueReference methodsFor: 'accessing' stamp: 'btr 3/4/2001 21:21'!
value
	^ value! !

!ValueReference methodsFor: 'accessing' stamp: 'btr 5/15/2001 10:14'!
value: anObject 
	"Protected mutation; use for initialization or creating new instances. 
	NOTE: Reference>>to: calls me."
	value
		ifNil: [value _ anObject.
			^ self].
	value == anObject
		ifTrue: [^ self].
	^ Reference to: anObject! !

!ValueReference methodsFor: 'comparing' stamp: 'btr 3/5/2001 15:42'!
= aReference 
	"References should be unique per object, so #= should do the same as 
	#==, but this supports debugging."
	^ value hash = aReference value hash! !

!ValueReference methodsFor: 'comparing' stamp: 'btr 3/21/2001 11:50'!
deprecatedHash
	"Hash is re-implemented because #= is implemented. This is also to allow 
	for more efficient searching of References for duplicates."
	^ value hash! !


!ValueReference class methodsFor: 'instance creation' stamp: 'btr 3/21/2001 15:18'!
to: anObject 
	"This checks to return any existing Reference instance to the argument  
	before allocating a new one."
	"TODO: Re-implement using a weak collection (a heap or hashtable?) as a 
	class variable to track all reference instances."
	self
		allInstancesDo: [:each | (each value == anObject)
				ifTrue: [^ each]].
	^ self new value: anObject!
]style[(4 8 3 228 2 4 20 6 3 4 10 8 17 4 7 4 12 8)f1b,f1cblack;b,f1,f1c134032000,f1,f1cblack;,f1,f1cblack;,f1,f1cblack;,f1,f1cblack;,f1,f1cblack;,f1,f1cblack;,f1,f1cblack;! !


!WrapperArrow methodsFor: 'accessing' stamp: 'btr 4/25/2001 11:52'!
object
	"Answer the object I wrap/reify/represent."
	^ object! !

!WrapperArrow methodsFor: 'accessing' stamp: 'btr 6/21/2001 00:24'!
object: anObject graph: anObjectGraph 
	"This is a protected mutator. It initializes, but also can return a new  
	instance of the appropriate ObjectGraph membership if possible. Also  
	ensures that only one wrapper exists for every (object, objectGraph) 
	pair. "
	(anObjectGraph isKindOf: ObjectGraph)
		ifFalse: [^ self error: 'Wrapper arrows can only meaningfully be owned by ObjectGraphs.'].
	graph
		ifNil: [graph _ anObjectGraph]
		ifNotNil: [graph = anObjectGraph
				ifFalse: [^ Arrow wrapping: anObject in: anObjectGraph]].
	"At this point, 'graph' must be initialized."
	object
		ifNotNil: [^ Arrow wrapping: anObject in: graph].
	object _ anObject.
	^ graph cache
		detect: [:each | each object = object]
		ifNone: [self addToGraph: graph]! !

!WrapperArrow methodsFor: 'accessing' stamp: 'btr 4/26/2001 06:59'!
objectGraph
	"Answer the graph responsible for me."
	^ graph! !

!WrapperArrow methodsFor: 'initialize' stamp: 'btr 6/12/2001 09:44'!
graph: anObjectGraph
	self shouldNotImplement! !

!WrapperArrow methodsFor: 'initialize' stamp: 'btr 6/12/2001 09:42'!
object: anObject objectGraph: anObjectGraph 
	^ self object: anObject graph: anObjectGraph! !


!WrapperArrow class methodsFor: 'instance creation' stamp: 'btr 6/12/2001 09:43'!
for: anObject in: anObjectGraph 
	"Keep only one wrapper arrow per object per objectGraph."
	^ super new object: anObject graph: anObjectGraph! !

!WrapperArrow class methodsFor: 'instance creation' stamp: 'btr 4/24/2001 18:40'!
new
	"Ensure I don't answer a duplicate wrapper for an object."
	"The following has the unfortunate side-effect of putting it in a random ObjectGraph.
	^ self for: self someObject in: ObjectGraph someInstance"
	^ self shouldNotImplement! !

!WrapperArrow class methodsFor: 'instance creation' stamp: 'btr 6/12/2001 09:45'!
newFor: anObjectGraph
	"Use #for:in: instead."
	self shouldNotImplement! !


!IdentityGraph reorganize!
('accessing' anyOne)
('comparing' isSubGraphOf: isSuperGraphOf:)
('operations' applyTo: invert invertedApplyTo:)
('testing' intensionallyIncludes:)
!

ArrowFrame initialize!

!ArrowFrame class reorganize!
('accessing instances and variables' lobby)
('class initialization' initialize)
('instance creation' for: for:named:)
!


!Arrow class reorganize!
('accessing' null unspecified)
('instance creation' from: from:to: head:tail: to: wrapping:in:)
!

"Postscript:
Leave the line above, and replace the rest of this comment by a useful one.
Executable statements should follow this comment, and should
be separated by periods, with no exclamation points (!!).
Be sure to put any further comments in double-quotes, like this one."
!