'From Objectworks for Smalltalk-80(tm), Version 2.5 of 29 July 1989 on 10 April 1999 at 6:46:24 pm'! ((CxxSystemOrganization tree childNamed: 'spaces') ~= nil) ifTrue: [ (CxxSystemOrganization tree childNamed: 'spaces') destroyFiles]! Heaper subclass: #Arrangement instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Xanadu-arrange'! Arrangement comment: 'Generally represents a pair of an OrderSpec and a Region. Arrangements map between regions and primArrays.'! (Arrangement getOrMakeCxxClassDescription) attributes: ((Set new) add: #DEFERRED; add: #COPY; yourself)! !Arrangement methodsFor: 'accessing'! {void} copyElements: toArray {PrimArray} with: toDsp {Dsp} with: fromArray {PrimArray} with: fromArrange {Arrangement} with: fromRegion {XnRegion} "Copy elements into toArray arranged according to the receiver. Copy them from fromArray arranged according to fromArrange. The source region is fromRegion. It gets tranformed by toDsp into the toArray." fromRegion stepper forEach: [:key {Position} | toArray at: (self indexOf: (toDsp of: key)) DOTasLong storeValue: (fromArray fetchValue: (fromArrange indexOf: key) DOTasLong)]! {IntegerVar} indexOf: position {Position unused} "Return the index of position into my Region according to my OrderSpec." self subclassResponsibility! {IntegerRegion} indicesOf: region {XnRegion} "Return the region of all the indices corresponding to positions in region." self subclassResponsibility! {XnRegion} keysOf: start {Int32} with: stop {Int32} "Return the region that corresponds to a range of indices." self subclassResponsibility! {XnRegion} region "The region of positions in the arrangement" self subclassResponsibility! ! !Arrangement methodsFor: 'testing'! {UInt32} actualHashForEqual ^Heaper takeOop! ! !Arrangement methodsFor: 'generated:'! create.Rcvr: receiver {Rcvr} super create.Rcvr: receiver.! {void} sendSelfTo: xmtr {Xmtr} super sendSelfTo: xmtr.! !Arrangement subclass: #ExplicitArrangement instanceVariableNames: 'myPositions {PtrArray of: Position}' classVariableNames: '' poolDictionaries: '' category: 'Xanadu-tumbler'! (ExplicitArrangement getOrMakeCxxClassDescription) attributes: ((Set new) add: #CONCRETE; add: #COPY; add: #NOT.A.TYPE; yourself)! !ExplicitArrangement methodsFor: 'create'! create: positions {PtrArray of: Position} super create. myPositions := positions.! ! !ExplicitArrangement methodsFor: 'accessing'! {IntegerVar} indexOf: position {Position} Int32Zero almostTo: myPositions count do: [ :i {Int32} | (position isEqual: (myPositions fetch: i)) ifTrue: [^i]]. Heaper BLAST: #NotFound. ^ -1 "compiler fodder"! {IntegerRegion} indicesOf: region {XnRegion} | result {IntegerRegion} | result := IntegerRegion make. Int32Zero almostTo: myPositions count do: [ :i {Int32} | (region hasMember: ((myPositions fetch: i) cast: Position)) ifTrue: [result := (result with: i integer) cast: IntegerRegion]]. ^result! {XnRegion} keysOf: start {Int32} with: stop {Int32} | result {XnRegion} | result := NULL. start almostTo: stop do: [ :i {Int32} | result == NULL ifTrue: [result := ((myPositions fetch: i) cast: Position) asRegion] ifFalse: [result := result with: ((myPositions fetch: i) cast: Position)]]. result == NULL ifTrue: [Heaper BLAST: #IndexOutOfBounds]. ^result! {XnRegion} region | result {XnRegion} | result := (myPositions get: Int32Zero) cast: XnRegion. 1 almostTo: myPositions count do: [ :i {Int32} | result := result with: ((myPositions get: i) cast: Position)]. ^result! ! !ExplicitArrangement methodsFor: 'testing'! {UInt32} actualHashForEqual ^ myPositions contentsHash! {UInt32} hashForEqual ^ myPositions contentsHash! {BooleanVar} isEqual: other {Heaper} other cast: ExplicitArrangement into: [:o {ExplicitArrangement} | ^ myPositions contentsEqual: o positions] others: [^ false ]. ^ false "fodder"! ! !ExplicitArrangement methodsFor: 'private: accessing'! {PtrArray} positions ^ myPositions! ! !ExplicitArrangement methodsFor: 'generated:'! create.Rcvr: receiver {Rcvr} super create.Rcvr: receiver. myPositions _ receiver receiveHeaper.! {void} sendSelfTo: xmtr {Xmtr} super sendSelfTo: xmtr. xmtr sendHeaper: myPositions.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ExplicitArrangement class instanceVariableNames: ''! (ExplicitArrangement getOrMakeCxxClassDescription) attributes: ((Set new) add: #CONCRETE; add: #COPY; add: #NOT.A.TYPE; yourself)! !ExplicitArrangement class methodsFor: 'create'! {Arrangement} make: positions {PtrArray of: Position} ^self create: positions! !Arrangement subclass: #IntegerArrangement instanceVariableNames: ' myOrdering {OrderSpec} myRegion {IntegerRegion}' classVariableNames: '' poolDictionaries: '' category: 'Xanadu-Spaces-Integers'! (IntegerArrangement getOrMakeCxxClassDescription) attributes: ((Set new) add: #CONCRETE; add: #COPY; yourself)! !IntegerArrangement methodsFor: 'accessing'! {void} copyElements: toArray {PrimArray} with: toDsp {Dsp} with: fromArray {PrimArray} with: fromArrange {Arrangement} with: fromRegion {XnRegion} | other {IntegerArrangement} start {Int32} stop {Int32} toStart {Int32} | other _ fromArrange cast: IntegerArrangement. (myOrdering isEqual: other ordering) ifFalse: [self unimplemented]. (myRegion isSimple and: [other region isSimple and: [fromRegion isSimple]]) ifFalse: [self unimplemented]. self knownBug. "Assume ascending for the moment." start _ (fromArrange indexOf: (fromRegion chooseOne: myOrdering)) DOTasLong. stop _ (fromArrange indexOf: (fromRegion chooseOne: myOrdering reversed)) DOTasLong. toStart _ (self indexOf: (toDsp of: (fromRegion chooseOne: myOrdering))) DOTasLong. "stop < start ifTrue: [| tmp {Int32} | tmp _ start. start _ stop. stop _ tmp]." toArray at: toStart storeMany: fromArray with: stop + 1 - start with: start! {IntegerVar} indexOf: position {Position} "Return the index of position into my Region according to my OrderSpec." | sum {IntegerVar} intPos {IntegerVar} | sum _ IntegerVar0. intPos _ (position cast: IntegerPos) asIntegerVar. (myRegion simpleRegions: myOrdering) forEach: [:region {IntegerRegion} | (region hasIntMember: intPos) ifTrue: [^sum + (intPos - ((region chooseOne: myOrdering) cast: IntegerPos) asIntegerVar) abs] ifFalse: [sum _ sum + region count]]. Heaper BLAST: #NotInTable. ^ -1 "compiler fodder"! {IntegerRegion} indicesOf: region {XnRegion} "Return the region of all the indices corresponding to positions in region." Someone shouldImplement. ^NULL "fodder"! {XnRegion} keysOf: start {Int32} with: stop {Int32} "Return the region that corresponds to a range of indices." | offset {Int32} left {Int32} right {Int32} | offset _ start. left _ -1. (myRegion simpleRegions: myOrdering) forEach: [:region {XnRegion} | region count <= offset ifTrue: [offset _ offset - region count DOTasLong] ifFalse: [left == -1 ifTrue: [left _ ((region chooseOne: myOrdering) cast: IntegerPos) asIntegerVar DOTasLong + offset. offset _ stop - (start - offset). offset <= region count DOTasLong ifTrue: [^IntegerRegion make: left with: (((region chooseOne: myOrdering) cast: IntegerPos) asIntegerVar + offset)]] ifFalse: [right _ ((region chooseOne: myOrdering) cast: IntegerPos) asIntegerVar DOTasLong + offset. ^IntegerRegion make: left with: right]]]. Heaper BLAST: #NotInTable. ^ NULL "compiler fodder"! {OrderSpec} ordering ^myOrdering! {XnRegion} region ^myRegion! ! !IntegerArrangement methodsFor: 'printing'! {void} printOn: oo {ostream reference} oo << self getCategory name << '(' << myRegion << ', ' << myOrdering << ')'! ! !IntegerArrangement methodsFor: 'protected: creation'! create: region {XnRegion} with: ordering {OrderSpec} super create. region isFinite ifFalse: [Heaper BLAST: #MustBeFinite]. myRegion _ region cast: IntegerRegion. myOrdering _ ordering! ! !IntegerArrangement methodsFor: 'testing'! {UInt32} actualHashForEqual ^ myOrdering hashForEqual + myRegion hashForEqual! {UInt32} hashForEqual ^ myOrdering hashForEqual + myRegion hashForEqual! {BooleanVar} isEqual: other {Heaper} other cast: IntegerArrangement into: [:o {IntegerArrangement} | ^ (myOrdering isEqual: o ordering) and: [myRegion isEqual: o region]] others: [^ false]. ^ false "fodder"! ! !IntegerArrangement methodsFor: 'generated:'! create.Rcvr: receiver {Rcvr} super create.Rcvr: receiver. myOrdering _ receiver receiveHeaper. myRegion _ receiver receiveHeaper.! {void} sendSelfTo: xmtr {Xmtr} super sendSelfTo: xmtr. xmtr sendHeaper: myOrdering. xmtr sendHeaper: myRegion.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! IntegerArrangement class instanceVariableNames: ''! (IntegerArrangement getOrMakeCxxClassDescription) attributes: ((Set new) add: #CONCRETE; add: #COPY; yourself)! !IntegerArrangement class methodsFor: 'creation'! make: region {XnRegion} with: ordering {OrderSpec} ^self create: region with: ordering! !Stepper subclass: #AscendingIntegerStepper instanceVariableNames: ' myEdges {IntegerVarArray} myIndex {UInt32} myCount {UInt32} myPosition {IntegerVar}' classVariableNames: 'SomeSteppers {InstanceCache} ' poolDictionaries: '' category: 'Xanadu-Spaces-Integers'! (AscendingIntegerStepper getOrMakeCxxClassDescription) attributes: ((Set new) add: #CONCRETE; add: #NOT.A.TYPE; yourself)! !AscendingIntegerStepper methodsFor: 'protected: creation'! create: edges {IntegerVarArray} with: count {UInt32} super create. myEdges _ edges. myIndex _ 1. myCount _ count. myCount > Int32Zero ifTrue: [myPosition _ myEdges integerVarAt: Int32Zero] ifFalse: [myPosition _ IntegerVar0]! create: edges {IntegerVarArray} with: index {UInt32} with: count {UInt32} with: position {IntegerVar} super create. myEdges _ edges. myIndex _ index. myCount _ count. myPosition _ position! ! !AscendingIntegerStepper methodsFor: 'creation'! {Stepper} copy | result {Heaper} | result := SomeSteppers fetch. result == NULL ifTrue: [^AscendingIntegerStepper create: myEdges with: myIndex with: myCount with: myPosition] ifFalse:[^(AscendingIntegerStepper new.Become: result) create: myEdges with: myIndex with: myCount with: myPosition]! {void} destroy (SomeSteppers store: self) ifFalse: [super destroy]! ! !AscendingIntegerStepper methodsFor: 'accessing'! {Heaper wimpy} fetch self hasValue ifTrue: [^myPosition integer] ifFalse: [^NULL]! {BooleanVar} hasValue ^myIndex <= myCount! {void} step myPosition _ myPosition + 1. (myIndex < myCount and: [myPosition = (myEdges integerVarAt: myIndex)]) ifTrue: [myIndex _ myIndex + 2. myIndex <= myCount ifTrue: [myPosition _ myEdges integerVarAt: myIndex - 1]]! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! AscendingIntegerStepper class instanceVariableNames: ''! (AscendingIntegerStepper getOrMakeCxxClassDescription) attributes: ((Set new) add: #CONCRETE; add: #NOT.A.TYPE; yourself)! !AscendingIntegerStepper class methodsFor: 'smalltalk: init'! initTimeNonInherited SomeSteppers := InstanceCache make: 16! linkTimeNonInherited SomeSteppers := NULL! ! !AscendingIntegerStepper class methodsFor: 'creation'! {Stepper} make: edges {IntegerVarArray} with: count {UInt32} | result {Heaper} | result := SomeSteppers fetch. result == NULL ifTrue: [^ self create: edges with: count] ifFalse: [^ (self new.Become: result) create: edges with: count]! !Accumulator subclass: #BoxAccumulator instanceVariableNames: ' mySpace {CrossSpace} myRegions {PtrArray of: XnRegion} myIndex {Int32}' classVariableNames: 'SomeAccumulators {InstanceCache} ' poolDictionaries: '' category: 'Xanadu-cross'! BoxAccumulator comment: 'was NOT.A.TYPE but this prevented compilation '! (BoxAccumulator getOrMakeCxxClassDescription) attributes: ((Set new) add: #CONCRETE; yourself)! !BoxAccumulator methodsFor: 'creation'! {Accumulator} copy | result {Heaper} | result := SomeAccumulators fetch. result == NULL ifTrue: [^BoxAccumulator create: mySpace with: (myRegions copy cast: PtrArray) with: myIndex] ifFalse: [^(BoxAccumulator new.Become: result) create: mySpace with: (myRegions copy cast: PtrArray) with: myIndex]! ! !BoxAccumulator methodsFor: 'protected: creation'! create: region {GenericCrossRegion} super create. mySpace := region crossSpace. myRegions := region secretRegions copy cast: PtrArray. myIndex := region boxCount.! create: space {CrossSpace} with: expectedBoxCount {Int32} super create. mySpace := space. myRegions := PtrArray nulls: space axisCount * expectedBoxCount. myIndex := Int32Zero.! create: space {CrossSpace} with: regions {PtrArray unused of: XnRegion} with: expectedBoxCount {Int32} super create. mySpace := space. myRegions := PtrArray nulls: space axisCount * expectedBoxCount. myIndex := Int32Zero. Ravi shouldImplement. "shouldn't we be doing something with the 'regios' argument?"! ! !BoxAccumulator methodsFor: 'private:'! {void} aboutToAdd "Make sure there is room to add a box" myIndex * mySpace axisCount < myRegions count ifFalse: [myRegions := (myRegions copyGrow: (myIndex + 1) * mySpace axisCount) cast: PtrArray].! {Int32} addSubstitutedBox: current {Int32} with: dimension {Int32} with: newRegion {XnRegion} "Add a new box which is just like a current one except for the projection on one dimension. Return its index" self aboutToAdd. myRegions at: myIndex * mySpace axisCount storeMany: myRegions with: mySpace axisCount with: current * mySpace axisCount. myRegions at: myIndex * mySpace axisCount + dimension store: newRegion. myIndex := myIndex + 1. ^myIndex - 1! {Int32} boxCount self knownBug. "includes deleted boxes" ^myIndex! {XnRegion} boxProjection: box {Int32} with: dimension {Int32} "Change a projection of a box" ^(myRegions fetch: box * mySpace axisCount + dimension) cast: XnRegion! {void} deleteBox: box {Int32} "Mark a box as deleted" myRegions at: box * mySpace axisCount store: NULL! {BooleanVar} distributeUnion: added {Int32} with: start {Int32} with: stop {Int32} "Take my box at added and distribute it over my existing boxes from start to stop - 1 meanwhile taking pieces out of my box at remainder and delete it if it becomes empty Return true if there is still something left in the remainder" start almostTo: stop do: [ :index {Int32} | (self splitUnion: added with: index with: stop) ifFalse: [^false]]. ^true! {Int32} index ^myIndex! {BooleanVar} isDeleted: box {Int32} "Whether the box has been deleted" ^(myRegions fetch: box * mySpace axisCount) == NULL! {PtrArray of: XnRegion} secretRegions ^myRegions! {BooleanVar} splitUnion: added {Int32} with: current {Int32} with: stop {Int32} "Take my box at added and union it with my box at current delete it if it becomes empty Return true if there is still something left in the added box" | dimension {Int32} addedRegion {XnRegion} currentRegion {XnRegion} common {XnRegion} newAdded {Int32} extraCurrent {XnRegion} extraAdded {XnRegion} | (self isDeleted: current) ifTrue: [^true]. dimension := Int32Zero. [dimension + 1 < mySpace axisCount] whileTrue: ["see if the added intersects the current in this dimension" addedRegion := self boxProjection: added with: dimension. currentRegion := self boxProjection: current with: dimension. self thingToDo. "Add protocol for tri-delta: gives triple (a-b, a&b, b-a)" common := addedRegion intersect: currentRegion. common isEmpty ifTrue: [^true]. "split out the part of current that doesn't intersect" extraCurrent := currentRegion minus: common. extraCurrent isEmpty ifFalse: [self addSubstitutedBox: current with: dimension with: extraCurrent. self storeBoxProjection: current with: dimension with: common]. "split out the part of the added that doesn't intersect" extraAdded := addedRegion minus: common. extraAdded isEmpty ifFalse: [newAdded := self addSubstitutedBox: added with: dimension with: extraAdded. self distributeUnion: newAdded with: current + 1 with: stop. self storeBoxProjection: added with: dimension with: common]. dimension := dimension + 1]. "union the added into the last dimension of the current box" addedRegion := self boxProjection: added with: dimension. currentRegion := self boxProjection: current with: dimension. self storeBoxProjection: current with: dimension with: (currentRegion unionWith: addedRegion). self deleteBox: added. ^false! {void} storeBoxProjection: box {Int32} with: dimension {Int32} with: region {XnRegion} "Change a projection of a box" myRegions at: box * mySpace axisCount + dimension store: region! {void} tryMergeBoxes: i {Int32} with: j {Int32} "If two boxes differ by only one projection, union the second into the first and delete the second" | unequal {Int32} | unequal := -1. Int32Zero almostTo: mySpace axisCount do: [ :dim {Int32} | ((self boxProjection: i with: dim) isEqual: (self boxProjection: j with: dim)) ifFalse: [unequal >= Int32Zero ifTrue: [^VOID]. unequal := dim]]. self storeBoxProjection: i with: unequal with: ((self boxProjection: i with: unequal) unionWith: (self boxProjection: j with: unequal)). self deleteBox: j.! ! !BoxAccumulator methodsFor: 'operations'! {void} addAccumulatedBoxes: other {BoxAccumulator} "Add in all the boxes in another accumulator" Int32Zero almostTo: other index do: [ :box {Int32} | (other isDeleted: box) ifFalse: [self aboutToAdd. myRegions at: myIndex * mySpace axisCount storeMany: other secretRegions with: mySpace axisCount with: box * mySpace axisCount. myIndex := myIndex + 1]]! {Int32} addBox: box {BoxStepper} "Add the current box to the end of the array" ^self addProjections: box region secretRegions with: box boxIndex! {void} addInverseTransformedBox: box {BoxStepper} with: dsp {GenericCrossDsp} "Add the current box, transformed by the inverse of the dsp" | base {Int32} | self aboutToAdd. base := mySpace axisCount * myIndex. Int32Zero almostTo: mySpace axisCount do: [ :dimension {Int32} | myRegions at: base + dimension store: ((dsp subMapping: dimension) inverseOfAll: (box projection: dimension))]. myIndex := myIndex + 1.! {Int32} addProjections: projections {PtrArray of: XnRegion} with: boxIndex {Int32} "Add a box to the end of the array" self aboutToAdd. myRegions at: myIndex * mySpace axisCount storeMany: projections with: mySpace axisCount with: boxIndex * mySpace axisCount. myIndex := myIndex + 1. ^myIndex - 1! {void} addTransformedBox: box {BoxStepper} with: dsp {GenericCrossDsp} "Add the current box, transformed by the dsp" | base {Int32} | self aboutToAdd. base := myIndex * mySpace axisCount. Int32Zero almostTo: mySpace axisCount do: [ :dimension {Int32} | myRegions at: base + dimension store: ((dsp subMapping: dimension) ofAll: (box projection: dimension))]. myIndex := myIndex + 1.! {void} intersectWithBox: box {BoxStepper} "Intersect the current region with a box. May leave the result uncanonicalized" Int32Zero almostTo: myIndex do: [ :i {Int32} | (box intersectBoxInto: myRegions with: i) ifFalse: [self deleteBox: i]].! {void} mergeBoxes "merge boxes which differ in only one projection" Ravi thingToDo. "hash lookup" Int32Zero almostTo: myIndex do: [ :i {Int32} | (self isDeleted: i) ifFalse: [Int32Zero almostTo: myIndex do: [ :j {Int32} | (i == j or: [self isDeleted: j]) ifFalse: [self tryMergeBoxes: i with: j]]]]! {XnRegion} region "The current region in the accumulator. CLIENT MUST KNOW THAT IT IS CANONICAL" ^GenericCrossRegion make: mySpace with: myIndex with: ((myRegions copy: myIndex * mySpace axisCount) cast: PtrArray)! {void} removeDeleted "Remove boxes which have been deleted" | to {Int32} from {Int32} | from := to := Int32Zero. [from < myIndex] whileTrue: [(self isDeleted: from) ifFalse: [from > to ifTrue: [myRegions at: to * mySpace axisCount storeMany: myRegions with: mySpace axisCount with: from * mySpace axisCount]. to := to + 1]. from := from + 1]. myIndex := to! {void} step: someObj {Heaper} self unionWithBoxes: (someObj cast: GenericCrossRegion) boxStepper! {void} unionWithBox: box {BoxStepper} "Add the current box to the accumulator" | initialIndex {Int32} addedIndex {Int32} | initialIndex := myIndex. addedIndex := self addBox: box. self distributeUnion: addedIndex with: Int32Zero with: initialIndex.! {void} unionWithBoxes: boxes {BoxStepper} "Add a sequence of disjoint boxes to the accumulator" myIndex = Int32Zero ifTrue: [[boxes hasValue] whileTrue: [self addBox: boxes. boxes step]] ifFalse: [[boxes hasValue] whileTrue: [self unionWithBox: boxes. boxes step]]! {Heaper} value ^self region! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! BoxAccumulator class instanceVariableNames: ''! (BoxAccumulator getOrMakeCxxClassDescription) attributes: ((Set new) add: #CONCRETE; yourself)! !BoxAccumulator class methodsFor: 'smalltalk: init'! initTimeNonInherited SomeAccumulators := InstanceCache make: 8! linkTimeNonInherited SomeAccumulators := NULL! ! !BoxAccumulator class methodsFor: 'creation'! make: region {GenericCrossRegion} | result {Heaper} | result := SomeAccumulators fetch. result == NULL ifTrue: [^ self create: region] ifFalse: [^ (self new.Become: result) create: region]! make: space {CrossSpace} with: expectedBoxCount {Int32} | result {Heaper} | result := SomeAccumulators fetch. result == NULL ifTrue: [^ self create: space with: expectedBoxCount] ifFalse: [^ (self new.Become: result) create: space with: expectedBoxCount]! !Stepper subclass: #BoxProjectionStepper instanceVariableNames: ' myRegion {GenericCrossRegion} myBoxIndex {Int32} myBoxLimit {Int32} myDimension {Int32}' classVariableNames: 'SomeSteppers {InstanceCache} ' poolDictionaries: '' category: 'Xanadu-Spaces-Cross'! BoxProjectionStepper comment: 'Steps over all projections of some boxes. was not.a.type but this prevented compilation'! (BoxProjectionStepper getOrMakeCxxClassDescription) attributes: ((Set new) add: #CONCRETE; yourself)! !BoxProjectionStepper methodsFor: 'create'! {Stepper} copy "Return a new stepper which steps independently of me, but whose current value is the same as mine, and which must produce a future history of values which satisfies the same obligation that my contract obligates me to produce now. Typically, this will mean that he must produce the same future history that I'm going to produce. However, let's say that I am enumerating the elements of a partial order in some full order which is consistent with the partial order. If a copy of me is made after I'm part way through, then me and my copy may produce any future history compatable both with the partial order and the elements I've already produced by the time of the copy. Of course, a subclass or a Stepper creating message (like IntegerRegion::stepper()) may specify the more stringent requirement (that a copy must produce the same sequence). To prevent aliasing, Steppers should typically be passed by copy. See class comment." Someone shouldImplement. ^NULL "fodder"! {void} destroy (SomeSteppers store: self) ifFalse: [super destroy]! ! !BoxProjectionStepper methodsFor: 'protected: create'! create: region {GenericCrossRegion} super create. myRegion := region. myBoxIndex := Int32Zero. myBoxLimit := region boxCount. myDimension := Int32Zero.! create: region {GenericCrossRegion} with: boxIndex {Int32} with: boxLimit {Int32} super create. myRegion := region. myBoxIndex := boxIndex. myBoxLimit := boxLimit. myDimension := Int32Zero.! create: region {GenericCrossRegion} with: boxIndex {Int32} with: boxLimit {Int32} with: dimension {Int32} super create. myRegion := region. myBoxIndex := boxIndex. myBoxLimit := boxLimit. myDimension := dimension.! ! !BoxProjectionStepper methodsFor: 'operations'! {Heaper wimpy} fetch myBoxIndex < myBoxLimit ifFalse: [^NULL]. ^self projection! {BooleanVar} hasValue ^myBoxIndex < myBoxLimit! {void} step myBoxIndex < myBoxLimit ifTrue: [myDimension := myDimension + 1. myDimension < myRegion crossSpace axisCount ifFalse: [myBoxIndex := myBoxIndex + 1. myDimension := Int32Zero]].! ! !BoxProjectionStepper methodsFor: 'accessing'! {Int32} dimension ^myDimension! {XnRegion} projection ^myRegion boxProjection: myBoxIndex with: myDimension! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! BoxProjectionStepper class instanceVariableNames: ''! (BoxProjectionStepper getOrMakeCxxClassDescription) attributes: ((Set new) add: #CONCRETE; yourself)! !BoxProjectionStepper class methodsFor: 'create'! make: region {GenericCrossRegion} | result {Heaper} | result := SomeSteppers fetch. result == NULL ifTrue: [^ self create: region] ifFalse: [^ (self new.Become: result) create: region]! make: region {GenericCrossRegion} with: boxIndex {Int32} with: boxLimit {Int32} | result {Heaper} | result := SomeSteppers fetch. result == NULL ifTrue: [^ self create: region with: boxIndex with: boxLimit] ifFalse: [^ (self new.Become: result) create: region with: boxIndex with: boxLimit]! ! !BoxProjectionStepper class methodsFor: 'smalltalk: init'! initTimeNonInherited SomeSteppers := InstanceCache make: 8! linkTimeNonInherited SomeSteppers := NULL! !Stepper subclass: #BoxStepper instanceVariableNames: ' myRegion {GenericCrossRegion} myIndex {Int32} myValue {XnRegion | NULL}' classVariableNames: 'SomeSteppers {InstanceCache} ' poolDictionaries: '' category: 'Xanadu-Spaces-Cross'! BoxStepper comment: 'Steps over all boxes. was NOT.A.TYPE but this prevented compilation'! (BoxStepper getOrMakeCxxClassDescription) attributes: ((Set new) add: #CONCRETE; yourself)! !BoxStepper methodsFor: 'operations'! {Heaper wimpy} fetch myIndex >= myRegion boxCount ifTrue: [^NULL]. myValue == NULL ifTrue: [myValue := GenericCrossRegion make: myRegion crossSpace with: 1 with: ((myRegion secretRegions copy: myRegion crossSpace axisCount with: myIndex * myRegion crossSpace axisCount) cast: PtrArray)]. ^myValue! {BooleanVar} hasValue ^myIndex < myRegion boxCount! {void} step myIndex < myRegion boxCount ifTrue: [myIndex := myIndex + 1. myValue := NULL]! ! !BoxStepper methodsFor: 'create'! {Stepper} copy | result {Heaper} | result := SomeSteppers fetch. result == NULL ifTrue: [^BoxStepper create: myRegion with: myIndex with: myValue] ifFalse: [^(BoxStepper new.Become: result) create: myRegion with: myIndex with: myValue]! {void} destroy (SomeSteppers store: self) ifFalse: [super destroy]! ! !BoxStepper methodsFor: 'protected: create'! create: region {GenericCrossRegion} super create. myRegion := region. myIndex := Int32Zero. myValue := NULL.! create: region {GenericCrossRegion} with: index {Int32} with: value {XnRegion | NULL} super create. myRegion := region. myIndex := index. myValue := value.! ! !BoxStepper methodsFor: 'accessing'! {GenericCrossRegion} boxComplement "The complement of this box" | result {BoxAccumulator} extrusion {PtrArray of: XnRegion} | result := BoxAccumulator make: myRegion crossSpace with: myRegion crossSpace axisCount. Int32Zero almostTo: myRegion crossSpace axisCount do: [ :dimension {Int32} | | special {XnRegion} | extrusion := PtrArray nulls: myRegion crossSpace axisCount. Int32Zero almostTo: dimension do: [ :i {Int32} | extrusion at: i store: (self projection: i)]. special := (self projection: dimension) complement. special isEmpty ifFalse: [extrusion at: dimension store: special. dimension + 1 almostTo: myRegion crossSpace axisCount do: [ :i {Int32} | extrusion at: i store: (myRegion crossSpace axis: i) fullRegion]. result addProjections: extrusion with: Int32Zero]]. ^result region cast: GenericCrossRegion! {BoxAccumulator} boxComplementAccumulator "The complement of this box" | result {BoxAccumulator} extrusion {PtrArray of: XnRegion} | result := BoxAccumulator make: myRegion crossSpace with: myRegion crossSpace axisCount. Int32Zero almostTo: myRegion crossSpace axisCount do: [ :dimension {Int32} | extrusion := PtrArray nulls: myRegion crossSpace axisCount. Int32Zero almostTo: dimension do: [ :i {Int32} | extrusion at: i store: (self projection: i)]. extrusion at: dimension store: (self projection: dimension) complement. dimension + 1 almostTo: myRegion crossSpace axisCount do: [ :i {Int32} | extrusion at: i store: (myRegion crossSpace axis: i) fullRegion]. result addProjections: extrusion with: Int32Zero]. ^result! {UInt32} boxHash | result {UInt32} | result := UInt32Zero. self projectionStepper forEach: [ :sub {XnRegion} | result := result bitXor: sub hashForEqual]. ^result! {BooleanVar} boxHasMember: tuple {ActualTuple} "Whether my current box contains a position" | mine {BoxProjectionStepper} | mine := self projectionStepper. [mine hasValue] whileTrue: [(mine projection hasMember: (tuple positionAt: mine dimension)) ifFalse: [^false]. mine step]. mine destroy. ^true! {Int32} boxIndex ^myIndex! {BooleanVar} boxIntersects: other {BoxStepper} "Whether my current box intersects others current box" | mine {BoxProjectionStepper} others {BoxProjectionStepper} | mine := self projectionStepper. others := other projectionStepper. [mine hasValue] whileTrue: [(mine projection intersects: others projection) ifFalse: [^false]. mine step. others step]. mine destroy. others destroy. ^true! {BooleanVar} boxIsEqual: other {BoxStepper} "Whether my current box isEqual others current box" | mine {BoxProjectionStepper} others {BoxProjectionStepper} | mine := self projectionStepper. others := other projectionStepper. [mine hasValue] whileTrue: [(mine projection isEqual: others projection) ifFalse: [^false]. mine step. others step]. mine destroy. others destroy. ^true! {BooleanVar} boxIsSubsetOf: other {BoxStepper} "Whether my current box isSubsetOf others current box" | mine {BoxProjectionStepper} others {BoxProjectionStepper} | mine := self projectionStepper. others := other projectionStepper. [mine hasValue] whileTrue: [(mine projection isSubsetOf: others projection) ifFalse: [^false]. mine step. others step]. mine destroy. others destroy. ^true! {BooleanVar} intersectBoxInto: result {PtrArray of: XnRegion} with: boxIndex {Int32} "Intersect each projection in the box into the array. Return false if the result is empty, stopping at the first dimension for which the intersection is empty." | mine {BoxProjectionStepper} proj {XnRegion} base {Int32} | base := myRegion crossSpace axisCount * boxIndex. mine := self projectionStepper. [mine hasValue] whileTrue: [result at: base + mine dimension store: (proj := ((result fetch: base + mine dimension) cast: XnRegion) intersect: mine projection). proj isEmpty ifTrue: [^false]. mine step]. mine destroy. ^true! {BooleanVar} isBoxOf: other {GenericCrossRegion} "Whether my box is also a box in the other region" | others {BoxStepper} | others := other boxStepper. [others hasValue] whileTrue: [(self boxIsEqual: others) ifTrue: [^true]. others step]. ^false! {XnRegion} projection: dimension {Int32} "The projection of my current box into one dimension" ^myRegion boxProjection: myIndex with: dimension! {BoxProjectionStepper} projectionStepper "A stepper over all the projections in the current box" ^BoxProjectionStepper make: myRegion with: myIndex with: myIndex + 1! {GenericCrossRegion} region ^myRegion! {void} unionBoxInto: result {PtrArray of: XnRegion} with: boxIndex {Int32} "Union each projection in the box into the array" | mine {BoxProjectionStepper} base {Int32} | base := myRegion crossSpace axisCount * boxIndex. mine := self projectionStepper. [mine hasValue] whileTrue: [result at: base + mine dimension store: (((result fetch: base + mine dimension) cast: XnRegion) unionWith: mine projection). mine step]. mine destroy.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! BoxStepper class instanceVariableNames: ''! (BoxStepper getOrMakeCxxClassDescription) attributes: ((Set new) add: #CONCRETE; yourself)! !BoxStepper class methodsFor: 'smalltalk: init'! initTimeNonInherited SomeSteppers := InstanceCache make: 8! linkTimeNonInherited SomeSteppers := NULL! ! !BoxStepper class methodsFor: 'create'! make: region {GenericCrossRegion} | result {Heaper} | result := SomeSteppers fetch. result == NULL ifTrue: [^ self create: region] ifFalse: [^ (self new.Become: result) create: region]! !Heaper subclass: #CoordinateSpace instanceVariableNames: ' myEmptyRegion {XnRegion} myFullRegion {XnRegion} myIdentityDsp {Dsp} myAscending {OrderSpec | NULL} myDescending {OrderSpec | NULL}' classVariableNames: '' poolDictionaries: '' category: 'Xanadu-Spaces-Basic'! CoordinateSpace comment: 'A coordinate space represents (among other things) the domain space of a table. Corresponding to each coordinate space will be a set of objects of the following kinds: Position -- The elements of the coordinate space. Mapping -- (Add a description.) OrderSpec -- The ways of specifying partial orders of this coordinate space''s Positions. XuRegion -- An XuRegion represents a set of Positions. The domain of a table is an XuRegion. When defining a new coordinate space class, one generally defines new corresponing subclasses of each of the above classes. A kind of any of the above classes knows what coordinate space it is a part of (the "coordinateSpace()" message will yield an appropriate kind of CoordinateSpace). CoordinateSpace objects exist mostly just to represent this commonality. Coordinate spaces are disjoint--it is an error to use any of the generic protocol of any of the above classes if the objects in question are of two different coordinate spaces. For example, "dsp->of (pos)" is not an error iff "dsp->coordinateSpace()->isEqual (pos->coordinateSpace())". Note that this class is not COPY or even PSEUDO_COPY. All of the instance variables for CoordinateSpace are basically cached quantities that require vary little actual state from the derived classes in order to be constructed. This realization allows a knot to be untangled when reading these objects from external storage.'! (CoordinateSpace getOrMakeCxxClassDescription) attributes: ((Set new) add: #ON.CLIENT; add: #DEFERRED; yourself)! !CoordinateSpace methodsFor: 'accessing'! {UInt32} actualHashForEqual ^Heaper takeOop! {OrderSpec CLIENT INLINE} ascending "Essential. The natural full-ordering of the coordinate space." ^self getAscending! {Mapping CLIENT INLINE} completeMapping: range {XnRegion} "Essential. A Mapping which maps each position in this space to every position in the range region. The region can be from any CoordinateSpace." ^Mapping make.CoordinateSpace: self with.Region: range! {OrderSpec CLIENT INLINE} descending "The mirror image of the partial order returned by 'CoordinateSpace::ascending'." ^self getDescending! {XnRegion CLIENT INLINE} emptyRegion "Essential. An empty region in this coordinate space" ^myEmptyRegion! {(OrderSpec | NULL) INLINE} fetchAscending "The natural full-ordering of the coordinate space." ^myAscending! {(OrderSpec | NULL) INLINE} fetchDescending "The mirror image of the partial order returned by 'CoordinateSpace::fetchAscending'." ^myDescending! {XnRegion CLIENT INLINE} fullRegion "A full region in this coordinate space" ^myFullRegion! {OrderSpec} getAscending "Essential. The natural full-ordering of the coordinate space." | result {OrderSpec | NULL} | result := self fetchAscending. result == NULL ifTrue: [Heaper BLAST: #NoFullOrder]. ^result! {OrderSpec} getDescending "The mirror image of the partial order returned by 'CoordinateSpace::getAscending'." | result {OrderSpec | NULL} | result := self fetchDescending. result == NULL ifTrue: [Heaper BLAST: #NoFullOrder]. ^result! {Dsp INLINE} identityDsp "A Dsp which maps all positions in the coordinate space onto themselves" ^myIdentityDsp! {Mapping CLIENT INLINE} identityMapping "Essential. A Mapping which maps all positions in the coordinate space onto themselves" ^self identityDsp! {BooleanVar} isEqual: other{Heaper} self subclassResponsibility! {BooleanVar} verify: thing {Heaper} "tell whether this is a valid Position/XuRegion/Dsp/OrderSpec for this space" thing cast: (Position | XnRegion | Dsp | OrderSpec) into: [:t | ^self isEqual: t coordinateSpace]. "cast into blasts here." ^false! ! !CoordinateSpace methodsFor: 'smalltalk: defaults'! create: emptyRegion {XnRegion} with: fullRegion {XnRegion} with: identityDsp {Dsp} self create: emptyRegion with: fullRegion with: identityDsp with: NULL with: NULL! create: emptyRegion {XnRegion} with: fullRegion {XnRegion} with: identityDsp {Dsp} with: ascending {OrderSpec default: NULL} self create: emptyRegion with: fullRegion with: identityDsp with: ascending with: NULL! ! !CoordinateSpace methodsFor: 'protected: create followup'! {void} finishCreate: emptyRegion {XnRegion} with: fullRegion {XnRegion} with: identityDsp {Dsp} with: ascending {OrderSpec default: NULL} with: descending {OrderSpec default: NULL} myEmptyRegion := emptyRegion. myFullRegion := fullRegion. myIdentityDsp := identityDsp. myAscending := ascending. (descending == NULL and: [ascending ~~ NULL]) ifTrue: [myDescending := ascending reversed] ifFalse: [myDescending := descending].! ! !CoordinateSpace methodsFor: 'create'! create super create. myEmptyRegion := NULL. myFullRegion := NULL. myIdentityDsp := NULL. myAscending := NULL. myDescending := NULL.! create: emptyRegion {XnRegion} with: fullRegion {XnRegion} with: identityDsp {Dsp} with: ascending {OrderSpec default: NULL} with: descending {OrderSpec default: NULL} super create. myEmptyRegion := emptyRegion. myFullRegion := fullRegion. myIdentityDsp := identityDsp. myAscending := ascending. (descending == NULL and: [ascending ~~ NULL]) ifTrue: [myDescending := ascending reversed] ifFalse: [myDescending := descending].! ! !CoordinateSpace methodsFor: 'smalltalk: passe'! {Mapping} importMapping: data {PrimArray} with: rangeSpace {CoordinateSpace default: NULL} self passe! {OrderSpec} importOrderSpec: data {PrimArray} self passe! {XnRegion} importRegion: data {PrimArray} self passe! {Mapping} mapping: data {PrimArray} self passe! {Mapping} mapping: data {PrimArray} with: rangeSpace {CoordinateSpace default: NULL} self passe! {OrderSpec} orderSpec: data {PrimArray} self passe! {XnRegion} region: data {PrimArray} self passe! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! CoordinateSpace class instanceVariableNames: ''! (CoordinateSpace getOrMakeCxxClassDescription) attributes: ((Set new) add: #ON.CLIENT; add: #DEFERRED; yourself)! !CoordinateSpace class methodsFor: 'smalltalk: system'! info.stProtocol "{OrderSpec CLIENT} ascending {Mapping CLIENT} completeMapping: range {XuRegion} {OrderSpec CLIENT} descending {XuRegion CLIENT} emptyRegion {XuRegion CLIENT} fullRegion {Mapping CLIENT} identityMapping "! !CoordinateSpace subclass: #BasicSpace instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Xanadu-Spaces-Basic'! BasicSpace comment: 'BasicSpace versus CoordinateSpace is not a type distinction in that there is no difference in contract with the client. BasicSpace exists as a convenience to the definer of new CoordinateSpaces. A new subclass of CoordinateSpace should be a subclass of BasicSpace iff there is only one coordinateSpace that corresponds to the new class. I.e., that the instances are not parameterized to yield different coordinate spaces. BasicSpace provides some conveniences (especially in Smalltalk) for defining a single canonical instance at dynamic initialization time, and always using it. As this class is irrelevent to CoordinateSpace clients, but is useful to those defining other kinds of coordinate spaces, it is an exellent example of something that would be classified as a "protected" class--something to be persued if we try to make modules more like classes.'! (BasicSpace getOrMakeCxxClassDescription) attributes: ((Set new) add: #OBSOLETE; add: #SMALLTALK.ONLY; add: #CONCRETE; add: #NOT.A.TYPE; yourself)! !BasicSpace methodsFor: 'testing'! {UInt32} actualHashForEqual "is equal to any basic space on the same category of positions" ^self getCategory hashForEqual + 1! {BooleanVar} isEqual: anObject {Heaper} "is equal to any basic space on the same category of positions" ^anObject getCategory == self getCategory! ! !BasicSpace methodsFor: 'creation'! create: emptyRegion {XnRegion} with: fullRegion {XnRegion} with: identityDsp {Dsp} with: ascending {OrderSpec default: NULL} with: descending {OrderSpec default: NULL} super create: emptyRegion with: fullRegion with: identityDsp with: ascending with: descending.! ! !BasicSpace methodsFor: 'smalltalk: defaults'! create: emptyRegion {XnRegion} with: fullRegion {XnRegion} with: identityDsp {Dsp} self create: emptyRegion with: fullRegion with: identityDsp with: NULL with: NULL! create: emptyRegion {XnRegion} with: fullRegion {XnRegion} with: identityDsp {Dsp} with: ascending {OrderSpec default: NULL} self create: emptyRegion with: fullRegion with: identityDsp with: ascending with: NULL! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! BasicSpace class instanceVariableNames: 'theSpace {BasicSpace star} '! (BasicSpace getOrMakeCxxClassDescription) attributes: ((Set new) add: #OBSOLETE; add: #SMALLTALK.ONLY; add: #CONCRETE; add: #NOT.A.TYPE; yourself)! !BasicSpace class methodsFor: 'smalltalk: initialization'! initTimeInherited self REQUIRES: PrimSpec. theSpace _ (self new.AllocType: #PERSISTENT) create.! linkTimeInherited theSpace _ NULL.! suppressInitTimeInherited! suppressLinkTimeInherited! !CoordinateSpace subclass: #CrossSpace instanceVariableNames: 'mySubSpaces {PtrArray of: CoordinateSpace}' classVariableNames: '' poolDictionaries: '' category: 'Xanadu-Spaces-Cross'! CrossSpace comment: 'Represents the cross of several coordinate spaces. '! (CrossSpace getOrMakeCxxClassDescription) friends: 'friend class BoxAccumulator; friend class BoxStepper; friend class GenericCrossSpace; friend class GenericCrossRegion; friend class BoxProjectionStepper;'; attributes: ((Set new) add: #ON.CLIENT; add: #DEFERRED; yourself)! !CrossSpace methodsFor: 'accessing'! {PtrArray CLIENT of: CoordinateSpace} axes "Essential. The base spaces that I am a cross of." ^mySubSpaces copy cast: PtrArray! {CoordinateSpace CLIENT} axis: dimension {Int32} "The sub coordinate space on the given axis" ^(mySubSpaces fetch: dimension) cast: CoordinateSpace! {Int32 CLIENT INLINE} axisCount "The number of dimensions in this space" ^mySubSpaces count! ! !CrossSpace methodsFor: 'testing'! {UInt32} actualHashForEqual ^mySubSpaces contentsHash bitXor: #cat.U.CrossSpace hashForEqual! {BooleanVar} isEqual: other {Heaper} other cast: CrossSpace into: [:cross | ^cross secretSubSpaces contentsEqual: mySubSpaces] others: [^false]. ^ false "compiler fodder"! ! !CrossSpace methodsFor: 'making'! {Mapping CLIENT} crossOfMappings: subMappings {(PtrArray of: Mapping | NULL) default: NULL} "Essential. Map each coordinate according to the mapping from its space. NULLs mean 'use the identity mapping'" self subclassResponsibility! {CrossOrderSpec CLIENT} crossOfOrderSpecs: subOrderings {(PtrArray of: OrderSpec | NULL) default: NULL} with: subSpaceOrdering {PrimIntArray default: NULL} "Essential. Make a lexical ordering of all elements in the space, using the given ordering for each sub space. If no sub space ordering is given, then it is in the order they are in the array. subSpaceOrdering lists the lexicographic order in which each dimension should be processed. Every dimension should be listed exactly one, from most significant (at index 0) to least significant. subOrderings are indexed by *dimension*, not by lexicographic order. In order to index by lex order, look up the dimension in subSpaceOrdering, and then look up the resulting dimension number in subOrderings." self subclassResponsibility! {Tuple CLIENT} crossOfPositions: coordinates {PtrArray of: Position} "Essential. Make an individual position" self subclassResponsibility! {CrossRegion CLIENT} crossOfRegions: subRegions {PtrArray of: XnRegion | NULL} "Essential. Make a 'rectangular' region as a cross of all the given regions" self subclassResponsibility! {CrossRegion CLIENT} extrusion: dimension {Int32} with: subRegion {XnRegion} "Return a region whose projection is 'subRegion' along 'dimension', but is full on all other dimensions" self subclassResponsibility! ! !CrossSpace methodsFor: 'smalltalk: passe'! {IntegerVar} count self passe "axisCount"! {Int32} intCount self passe "axisCount"! {CrossMapping} makeCrossMapping: subMappings {PtrArray of: Mapping} self passe! {CrossOrderSpec} makeCrossOrderSpec: subOrderings {PtrArray of: OrderSpec | NULL} with: subSpaceOrdering {Int32Array default: NULL} "Make a lexical ordering of all elements in the space, using the given ordering for each sub space. If no sub space ordering is given, then it is in the order they are in the array" self passe! {CrossRegion} makeCrossRegion: subRegions {PtrArray of: XnRegion | NULL} "Make a 'rectangular' region as a cross of all the given regions" self passe! {Tuple} makeTuple: coordinates {PtrArray of: Position} "Make an individual position" self passe! {CoordinateSpace} subSpace: dimension {Int32} self passe "axis"! {PtrArray of: CoordinateSpace} subSpaces self passe "axes"! ! !CrossSpace methodsFor: 'smalltalk: defaults'! {Mapping CLIENT} crossOfMappings ^self crossOfMappings: NULL! {CrossOrderSpec CLIENT} crossOfOrderSpecs ^self crossOfOrderSpecs: NULL with: NULL! {CrossOrderSpec CLIENT} crossOfOrderSpecs: subOrderings {(PtrArray of: OrderSpec | NULL) default: NULL} ^self crossOfOrderSpecs: subOrderings with: NULL! ! !CrossSpace methodsFor: 'protected: accessing'! {PtrArray INLINE of: CoordinateSpace} secretSubSpaces "The actual array of sub spaces. DO NOT MODIFY" ^mySubSpaces! ! !CrossSpace methodsFor: 'protected: creation'! create super create. mySubSpaces := NULL.! create: subSpaces {PtrArray of: CoordinateSpace} super create. mySubSpaces := subSpaces.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! CrossSpace class instanceVariableNames: ''! (CrossSpace getOrMakeCxxClassDescription) friends: 'friend class BoxAccumulator; friend class BoxStepper; friend class GenericCrossSpace; friend class GenericCrossRegion; friend class BoxProjectionStepper;'; attributes: ((Set new) add: #ON.CLIENT; add: #DEFERRED; yourself)! !CrossSpace class methodsFor: 'creation'! {CrossSpace CLIENT} make: subSpaces {PtrArray of: CoordinateSpace} "Make a cross space with the given list of subspaces" "Should use middlemen. Just hard code special cases for now" ^GenericCrossSpace make: (subSpaces copy cast: PtrArray)! make: zeroSpace {CoordinateSpace} with: oneSpace {CoordinateSpace} "Cross two sub spaces" ^GenericCrossSpace create: ((PrimSpec pointer arrayWithTwo: zeroSpace with: oneSpace) cast: PtrArray)! ! !CrossSpace class methodsFor: 'smalltalk: system'! info.stProtocol "{PtrArray CLIENT of: CoordinateSpace} axes {CoordinateSpace CLIENT} axis: dimension {Int32} {Int32 CLIENT} axisCount {Mapping CLIENT} crossOfMappings {Mapping CLIENT} crossOfMappings: subMappings {(PtrArray of: Mapping | NULL) default: NULL} {CrossOrderSpec CLIENT} crossOfOrderSpecs {CrossOrderSpec CLIENT} crossOfOrderSpecs: subOrderings {(PtrArray of: OrderSpec | NULL) default: NULL} {CrossOrderSpec CLIENT} crossOfOrderSpecs: subOrderings {(PtrArray of: OrderSpec | NULL) default: NULL} with: subSpaceOrdering {Int32Array default: NULL} {Tuple CLIENT} crossOfPositions: coordinates {PtrArray of: Position} {CrossRegion CLIENT} crossOfRegions: subRegions {PtrArray of: XuRegion | NULL} {CrossRegion CLIENT} extrusion: dimension {Int32} with: subRegion {XuRegion} "! !CrossSpace subclass: #GenericCrossSpace instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Xanadu-Spaces-Cross'! GenericCrossSpace comment: 'Default implementation of cross coordinate space. was NOT.A.TYPE but that prevented compilation'! (GenericCrossSpace getOrMakeCxxClassDescription) attributes: ((Set new) add: #CONCRETE; add: #PSEUDO.COPY; yourself)! !GenericCrossSpace methodsFor: 'making'! {Mapping} crossOfMappings: subMappings {(PtrArray of: Mapping | NULL) default: NULL} subMappings == NULL ifTrue: [^CrossMapping make: self]. Int32Zero almostTo: subMappings count do: [:i {Int32} | | subM {Mapping | NULL} | subM := (subMappings fetch: i) cast: Mapping. (subM ~~ NULL and: [(subM isKindOf: Dsp) not]) ifTrue: [MarkM shouldImplement]]. ^CrossMapping make: self with: subMappings! {CrossOrderSpec} crossOfOrderSpecs: subOrderings {(PtrArray of: OrderSpec | NULL) default: NULL} with: subSpaceOrdering {PrimIntArray default: NULL} ^CrossOrderSpec make: self with: subOrderings with: subSpaceOrdering! {Tuple} crossOfPositions: coordinates {PtrArray of: Position} ^ActualTuple make: coordinates! {CrossRegion} crossOfRegions: subRegions {PtrArray of: XnRegion | NULL} | result {PtrArray of: XnRegion} | result := subRegions copy cast: PtrArray. Int32Zero almostTo: result count do: [ :dimension {Int32} | (result fetch: dimension) == NULL ifTrue: [result at: dimension store: (self axis: dimension) fullRegion] ifFalse: [((result fetch: dimension) cast: XnRegion) isEmpty ifTrue: [^self emptyRegion cast: CrossRegion]]]. ^GenericCrossRegion make: self with: 1 with: result! {CrossRegion} extrusion: dimension {Int32} with: subRegion {XnRegion} | projs {PtrArray of: XnRegion} | subRegion isEmpty ifTrue: [^self emptyRegion cast: CrossRegion]. projs := PtrArray nulls: mySubSpaces count. Int32Zero almostTo: mySubSpaces count do: [ :i {Int32} | i = dimension ifTrue: [projs at: i store: subRegion] ifFalse: [projs at: i store: ((mySubSpaces fetch: i) cast: CoordinateSpace) fullRegion]]. ^GenericCrossRegion make: self with: 1 with: projs! ! !GenericCrossSpace methodsFor: 'private: creation'! create: subSpaces {PtrArray of: CoordinateSpace} super create: subSpaces. self finishCreate: (GenericCrossRegion empty: self) with: (GenericCrossRegion full: self with: subSpaces) with: (GenericCrossDsp identity: self with: subSpaces) with: (CrossOrderSpec fetchAscending: self with: subSpaces) with: (CrossOrderSpec fetchDescending: self with: subSpaces).! ! !GenericCrossSpace methodsFor: 'printing'! {void} printOn: oo {ostream reference} oo << '<'. Int32Zero almostTo: mySubSpaces count do: [ :i {Int32} | i > Int32Zero ifTrue: [oo << ' x ']. oo << (mySubSpaces fetch: i)]. oo << '>'! ! !GenericCrossSpace methodsFor: 'hooks:'! {void SEND.HOOK} sendGenericCrossSpaceTo: xmtr {Xmtr} xmtr sendHeaper: mySubSpaces.! ! !GenericCrossSpace methodsFor: 'generated:'! {void} sendSelfTo: xmtr {Xmtr} self sendGenericCrossSpaceTo: xmtr.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! GenericCrossSpace class instanceVariableNames: ''! (GenericCrossSpace getOrMakeCxxClassDescription) attributes: ((Set new) add: #CONCRETE; add: #PSEUDO.COPY; yourself)! !GenericCrossSpace class methodsFor: 'rcvr pseudoconstructors'! {Heaper} make.Rcvr: rcvr {Rcvr} ^(GenericCrossSpace new.Become: ((rcvr cast: SpecialistRcvr) makeIbid: GenericCrossSpace)) create: (rcvr receiveHeaper cast: PtrArray)! ! !GenericCrossSpace class methodsFor: 'pseudoconstructors'! {CrossSpace} make: subSpaces {PtrArray of: CoordinateSpace} ^GenericCrossSpace create: subSpaces! !CoordinateSpace subclass: #FilterSpace instanceVariableNames: 'myBaseSpace {CoordinateSpace}' classVariableNames: '' poolDictionaries: '' category: 'Xanadu-Filter'! FilterSpace comment: 'A FilterSpace can be described mathematically as a power space of its baseSpace, i.e. the set of all subsets of the baseSpace. Each position in a FilterSpace is a Region in the baseSpace, and each Filter is a set of Regions taken from the baseSpace. See Filter for more detail.'! (FilterSpace getOrMakeCxxClassDescription) attributes: ((Set new) add: #PSEUDO.COPY; add: #CONCRETE; add: #ON.CLIENT; yourself)! !FilterSpace methodsFor: 'creation'! create: base {CoordinateSpace} super create. self finishCreate: (ClosedFilter make: self) with: (OpenFilter make: self) with: (FilterDsp make: self) with: NULL with: NULL. myBaseSpace := base! ! !FilterSpace methodsFor: 'testing'! {UInt32} actualHashForEqual ^myBaseSpace hashForEqual + 1! {BooleanVar} isEqual: other {Heaper} other cast: FilterSpace into: [:fs | ^fs baseSpace isEqual: myBaseSpace] others: [^false]. ^false "fodder"! ! !FilterSpace methodsFor: 'accessing'! {CoordinateSpace CLIENT INLINE} baseSpace "Essential. The CoordinateSpace of the Regions that are the input to Filters in this FilterSpace." ^myBaseSpace! ! !FilterSpace methodsFor: 'printing'! {void} printOn: oo {ostream reference} oo << self getCategory name << '(' << myBaseSpace << ')'! ! !FilterSpace methodsFor: 'making'! {Filter CLIENT INLINE} allFilter: region {XnRegion} "Essential. A region that matches any region that contains all the Positions in, i.e. is a superset of, the given region." ^Filter supersetFilter: self with: region! {Filter CLIENT INLINE} anyFilter: baseRegion {XnRegion} "Essential. A filter that matches any region that intersects the given region." ^Filter intersectionFilter: self with: baseRegion! {Filter INLINE} intersectionFilter: region {XnRegion} "Essential. A filter that matches any region that intersects the given region." ^Filter intersectionFilter: self with: region! {Filter INLINE} notSubsetFilter: region {XnRegion} "A filter matching any regions that is not a subset of the given region." ^Filter notSubsetFilter: self with: region! {Filter INLINE} notSupersetFilter: region {XnRegion} "A filter that matches any region that is not a superset of the given region." ^Filter notSupersetFilter: self with: region! {Filter INLINE} orFilter: subs {ScruSet of: Filter} "A filter that matches any region that any of the filters in the set would have matched." ^Filter orFilter: self with: subs! {FilterPosition CLIENT INLINE} position: baseRegion {XnRegion} "Essential. Given a Region in the baseSpace, make a Position which corresponds to it, so that filter->hasMember (this->position (baseRegion)) iff filter->match (baseRegion)" ^FilterPosition make: baseRegion! {Filter INLINE} subsetFilter: region {XnRegion} "A filter that matches any region that is a subset of the given region." ^Filter subsetFilter: self with: region! {Filter INLINE} supersetFilter: region {XnRegion} "Essential. A region that matches any region that is a superset of the given region." ^Filter supersetFilter: self with: region! ! !FilterSpace methodsFor: 'hooks:'! {void SEND.HOOK} sendFilterSpaceTo: xmtr {Xmtr} xmtr sendHeaper: myBaseSpace.! ! !FilterSpace methodsFor: 'generated:'! {void} sendSelfTo: xmtr {Xmtr} self sendFilterSpaceTo: xmtr.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! FilterSpace class instanceVariableNames: ''! (FilterSpace getOrMakeCxxClassDescription) attributes: ((Set new) add: #PSEUDO.COPY; add: #CONCRETE; add: #ON.CLIENT; yourself)! !FilterSpace class methodsFor: 'creation'! {FilterSpace CLIENT} make: base {CoordinateSpace} "A FilterSpace on the given base space." ^FilterSpace create: base! ! !FilterSpace class methodsFor: 'smalltalk: system'! info.stProtocol "{Filter CLIENT} andFilter: baseRegion {XnRegion} {Filter CLIENT} anyFilter: baseRegion {XnRegion} {CoordinateSpace CLIENT} baseSpace {FilterPosition CLIENT} position: baseRegion {XnRegion} "! ! !FilterSpace class methodsFor: 'rcvr pseudo constructors'! {Heaper} make.Rcvr: rcvr {Rcvr} ^(FilterSpace new.Become: ((rcvr cast: SpecialistRcvr) makeIbid: FilterSpace)) create: (rcvr receiveHeaper cast: CoordinateSpace)! !CoordinateSpace subclass: #HeaperSpace instanceVariableNames: '' classVariableNames: 'TheHeaperSpace {HeaperSpace} ' poolDictionaries: '' category: 'Xanadu-Spaces-Unordered'! HeaperSpace comment: 'A HeaperSpace is one whose positions represent the identity of individual Heapers. Identity of a Heaper is determined according by its response to "isEqual" and "hashForEqual" (see "The Equality of Decisions" for a bunch of surprising issues regarding Heaper equality). A region is a HeaperSpace is a SetRegion (see SetRegion). As a result of having HeaperSpaces, one can use the identity of Heapers to index into hash tables, and still obey the convention that a table maps from positions in some coordinate space. HeaperSpaces cannot (yet?) be used as the domain space for Xanadu Stamps, and therefore also not as the domain space of an IndexedWaldo. In order to do this, the Heapers in question would have to persist in a way that Xanadu doesn''t provide for. As is typical for an unordered space, the only Dsp for this space is the identity Dsp. No type or pseudo-constructor is exported however--the Dsp is gotten by converting a HeaperSpace to a Dsp. Similarly, no heaper-specific type or pseudo-constructor is exported for my regions. The conversions are sufficient. The resulting regions are guaranteed to be SetRegions.'! (HeaperSpace getOrMakeCxxClassDescription) attributes: ((Set new) add: #CONCRETE; add: #PSEUDO.COPY; yourself)! !HeaperSpace methodsFor: 'creation'! create super create: HeaperRegion make with: HeaperRegion make complement with: HeaperDsp make with: NULL with: NULL! ! !HeaperSpace methodsFor: 'testing'! {UInt32} actualHashForEqual "is equal to any basic space on the same category of positions" ^self getCategory hashForEqual + 1! {BooleanVar} isEqual: anObject {Heaper} "is equal to any basic space on the same category of positions" ^anObject getCategory == self getCategory! ! !HeaperSpace methodsFor: 'generated:'! {void} sendSelfTo: xmtr {Xmtr}! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! HeaperSpace class instanceVariableNames: ''! (HeaperSpace getOrMakeCxxClassDescription) attributes: ((Set new) add: #CONCRETE; add: #PSEUDO.COPY; yourself)! !HeaperSpace class methodsFor: 'smalltalk: init'! initTimeNonInherited TheHeaperSpace := self create! linkTimeNonInherited TheHeaperSpace := NULL! ! !HeaperSpace class methodsFor: 'pseudo constructors'! {HeaperSpace INLINE} make "Return the one instance of HeaperSpace" ^TheHeaperSpace! ! !HeaperSpace class methodsFor: 'rcvr pseudo constructor'! {Heaper} make.Rcvr: rcvr {Rcvr} (rcvr cast: SpecialistRcvr) registerIbid: TheHeaperSpace. ^TheHeaperSpace! !CoordinateSpace subclass: #IntegerSpace instanceVariableNames: '' classVariableNames: 'TheIntegerSpace {IntegerSpace} ' poolDictionaries: '' category: 'Xanadu-Spaces-Integers'! IntegerSpace comment: 'The space of all integers. See the class comments in IntegerRegion, XuInteger, and IntegerDsp for interesting properties of this space. Especially IntegerRegion. IntegerSpaces are the most frequently used of the coordinate spaces. XuArrays are an efficient data structure which we provide as a table whose domain space is an integer space. In so doing, the notion of an array is made to be simply a particular case of a table indexed by the positions of a coordinate space. However, IntegerSpaces and XuArrays are both expected to be more efficient than other spaces and tables built on other spaces. See XuArray'! (IntegerSpace getOrMakeCxxClassDescription) friends: '/* friends for class IntegerSpace */ friend class IntegerRegion; friend class IntegerDsp; '; attributes: ((Set new) add: #PSEUDO.COPY; add: #CONCRETE; add: #ON.CLIENT; yourself)! !IntegerSpace methodsFor: 'creation'! create super create: (IntegerRegion usingx: false with: Int32Zero with: (IntegerVarArray zeros: Int32Zero)) with: (IntegerRegion usingx: true with: Int32Zero with: (IntegerVarArray zeros: Int32Zero)) with: IntegerMapping identity with: IntegerUpOrder make! ! !IntegerSpace methodsFor: 'making'! {IntegerRegion CLIENT} above: start {IntegerPos} with: inclusive {BooleanVar} "Essential. Make a region that contains all integers greater than (or equal if inclusive is true) to start." | after {IntegerVar} | after _ start asIntegerVar. inclusive ifFalse: [after _ after + 1]. ^IntegerRegion after: after! {IntegerRegion CLIENT} below: stop {IntegerPos} with: inclusive {BooleanVar} "Make a region that contains all integers less than (or equal if inclusive is true) to stop." | after {IntegerVar} | after _ stop asIntegerVar. inclusive ifTrue: [after _ after + 1]. ^IntegerRegion before: after! {IntegerRegion CLIENT} interval: start {IntegerPos} with: stop {IntegerPos} "Make a region that contains all integers greater than or equal to start and less than stop." ^IntegerRegion make: start asIntegerVar with: stop asIntegerVar! {IntegerPos CLIENT INLINE} position: value {IntegerVar} "Essential. Make an integer Position object" ^value integer! {IntegerMapping CLIENT} translation: value {IntegerVar} "Essential. Make a Mapping which adds a fixed amount to any value. Should this just be supplanted by CoordinateSpace::mapping ()?" value = IntegerVarZero ifTrue: [^self identityDsp cast: IntegerMapping]. ^IntegerMapping make: value! ! !IntegerSpace methodsFor: 'testing'! {UInt32} actualHashForEqual "is equal to any basic space on the same category of positions" ^self getCategory hashForEqual + 1! {BooleanVar} isEqual: anObject {Heaper} "is equal to any basic space on the same category of positions" ^anObject getCategory == self getCategory! ! !IntegerSpace methodsFor: 'smalltalk: passe'! {IntegerPos} integer: value {IntegerVar} self passe "position"! ! !IntegerSpace methodsFor: 'generated:'! {void} sendSelfTo: xmtr {Xmtr}! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! IntegerSpace class instanceVariableNames: ''! (IntegerSpace getOrMakeCxxClassDescription) friends: '/* friends for class IntegerSpace */ friend class IntegerRegion; friend class IntegerDsp; '; attributes: ((Set new) add: #PSEUDO.COPY; add: #CONCRETE; add: #ON.CLIENT; yourself)! !IntegerSpace class methodsFor: 'creation'! {IntegerSpace INLINE} implicitReceiver "Get the receievr for wire requests." ^TheIntegerSpace! {IntegerSpace CLIENT INLINE} make "return the one integer space" ^TheIntegerSpace! ! !IntegerSpace class methodsFor: 'rcvr pseudo constructor'! {Heaper} make.Rcvr: rcvr {Rcvr} (rcvr cast: SpecialistRcvr) registerIbid: TheIntegerSpace. ^TheIntegerSpace! ! !IntegerSpace class methodsFor: 'smalltalk: init'! initTimeNonInherited TheIntegerSpace := self create! linkTimeNonInherited TheIntegerSpace := NULL! ! !IntegerSpace class methodsFor: 'smalltalk: system'! info.stProtocol "{IntegerRegion CLIENT} above: start {IntegerVar} with: inclusive {BooleanVar} {IntegerRegion CLIENT} below: start {IntegerVar} with: inclusive {BooleanVar} {IntegerRegion CLIENT} interval: start {IntegerVar} with: stop {IntegerVar} {XuInteger CLIENT} position: value {IntegerVar} {IntegerMapping CLIENT} translation: value {IntegerVar} "! !CoordinateSpace subclass: #RealSpace instanceVariableNames: '' classVariableNames: 'TheRealSpace {RealSpace} ' poolDictionaries: '' category: 'Xanadu-tumbler'! RealSpace comment: 'Non-arithmetic space of real numbers in which only certain positions are explicitly representable. In this release, the only exactly representable numbers are those real numbers which can be represented in IEEE64 (double precision) format. Future releases may make more real numbers representable.'! (RealSpace getOrMakeCxxClassDescription) attributes: ((Set new) add: #PSEUDO.COPY; add: #CONCRETE; add: #ON.CLIENT; yourself)! !RealSpace methodsFor: 'create'! create super create: (RealRegion make: false with: PtrArray empty) with: (RealRegion make: true with: PtrArray empty) with: RealDsp make with: RealUpOrder make! ! !RealSpace methodsFor: 'making'! {RealRegion CLIENT} above: val {RealPos} with: inclusive {BooleanVar} "The region consisting of all positions >= val if inclusive, or all > val if not inclusive." inclusive ifTrue: [^RealRegion make: false with: (PrimSpec pointer arrayWith: (BeforeReal make: val))] ifFalse: [^RealRegion make: false with: (PrimSpec pointer arrayWith: (AfterReal make: val))]! {RealRegion CLIENT} below: val {RealPos} with: inclusive {BooleanVar} "The region consisting of all positions <= val if inclusive, or all < val if not inclusive." inclusive ifTrue: [^RealRegion make: true with: (PrimSpec pointer arrayWith: (AfterReal make: val))] ifFalse: [^RealRegion make: true with: (PrimSpec pointer arrayWith: (BeforeReal make: val))]! {RealRegion CLIENT} interval: start {RealPos} with: stop {RealPos} "Return a region of all numbers >= lower and < upper." MarkM thingToDo. "use a single constructor" ^((self above: start with: true) intersect: (self below: stop with: false)) cast: RealRegion! {RealPos CLIENT INLINE} position: val {IEEE64} "The XuReal representing the same real number as that exactly represented by 'val'. If 'val' doesn't represent a real number (i.e., it is an infinity or a NAN), then this message BLASTs. If 'val' is a negative zero, it is silently converted to a positive zero" ^RealPos make: val! ! !RealSpace methodsFor: 'obsolete:'! {RealRegion} after: val {IEEE64} "The region consisting of all position >= val. Should this just be supplanted by CoordinateSpace::region ()?" self thingToDo. "update clients" ^RealRegion make: false with: (PrimSpec pointer arrayWith: (BeforeReal make: (RealPos make: val)))! {RealRegion} before: val {IEEE64} "The region consisting of all position <= val Should this just be supplanted by CoordinateSpace::region ()?" self thingToDo. "update clients" ^RealRegion make: true with: (PrimSpec pointer arrayWith: (AfterReal make: (RealPos make: val)))! {RealRegion} strictlyAfter: val {IEEE64} "The region consisting of all position > val Should this just be supplanted by CoordinateSpace::region ()? Add Boolean to after to say whether its inclusive?" self thingToDo. "update clients" ^RealRegion make: false with: (PrimSpec pointer arrayWith: (AfterReal make: (RealPos make: val)))! {RealRegion} strictlyBefore: val {IEEE64} "The region consisting of all position < val Should this just be supplanted by CoordinateSpace::region ()? Add Boolean to before to say whether its inclusive?" self thingToDo. "update clients" ^RealRegion make: true with: (PrimSpec pointer arrayWith: (AfterReal make: (RealPos make: val)))! ! !RealSpace methodsFor: 'testing'! {UInt32} actualHashForEqual "is equal to any basic space on the same category of positions" ^self getCategory hashForEqual + 1! {BooleanVar} isEqual: anObject {Heaper} "is equal to any basic space on the same category of positions" ^anObject getCategory == self getCategory! ! !RealSpace methodsFor: 'generated:'! {void} sendSelfTo: xmtr {Xmtr}! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! RealSpace class instanceVariableNames: ''! (RealSpace getOrMakeCxxClassDescription) attributes: ((Set new) add: #PSEUDO.COPY; add: #CONCRETE; add: #ON.CLIENT; yourself)! !RealSpace class methodsFor: 'creation'! {RealSpace CLIENT INLINE} make ^TheRealSpace! ! !RealSpace class methodsFor: 'rcvr pseudo constructors'! {Heaper} make.Rcvr: rcvr {Rcvr} (rcvr cast: SpecialistRcvr) registerIbid: TheRealSpace. ^TheRealSpace! ! !RealSpace class methodsFor: 'smalltalk: init'! initTimeNonInherited self REQUIRES: PrimSpec. TheRealSpace := self create! linkTimeNonInherited TheRealSpace := NULL! ! !RealSpace class methodsFor: 'smalltalk: system'! info.stProtocol "{RealRegion CLIENT} above: val {IEEE64} with: inclusive {BooleanVar} {RealRegion CLIENT} below: val {IEEE64} with: inclusive {BooleanVar} {RealRegion CLIENT} interval: lower {XuRegion} with: upper {XuReal} {XuReal CLIENT} position: val {IEEE64} "! !CoordinateSpace subclass: #SequenceSpace instanceVariableNames: '' classVariableNames: 'TheSequenceSpace {SequenceSpace} ' poolDictionaries: '' category: 'Xanadu-tumbler'! SequenceSpace comment: 'The space of all Sequences'! (SequenceSpace getOrMakeCxxClassDescription) friends: '/* friends for class SequenceSpace */ friend class Sequence; '; attributes: ((Set new) add: #PSEUDO.COPY; add: #CONCRETE; add: #ON.CLIENT; yourself)! !SequenceSpace methodsFor: 'create'! create super create: (SequenceRegion usingx: false with: PtrArray empty) with: (SequenceRegion usingx: true with: PtrArray empty) with: (SequenceMapping make: IntegerVarZero with: Sequence zero) with: SequenceUpOrder make! ! !SequenceSpace methodsFor: 'temporary'! {Sequence CLIENT login INLINE} position: numbers {PrimArray} ^self position: numbers with: IntegerVarZero! ! !SequenceSpace methodsFor: 'making'! {SequenceRegion CLIENT} above: sequence {Sequence} with: inclusive {BooleanVar} "Essential. All sequences >= sequence if inclusive, > sequence if not." inclusive ifTrue: [^SequenceRegion usingx: false with: ((PrimSpec pointer arrayWith: (BeforeSequence make: sequence)) cast: PtrArray)] ifFalse: [^SequenceRegion usingx: false with: ((PrimSpec pointer arrayWith: (AfterSequence make: sequence)) cast: PtrArray)]! {SequenceRegion CLIENT} below: sequence {Sequence} with: inclusive {BooleanVar} "Essential. All sequences <= sequence if inclusive, < sequence if not." inclusive ifTrue: [^SequenceRegion usingx: true with: ((PrimSpec pointer arrayWith: (AfterSequence make: sequence)) cast: PtrArray)] ifFalse: [^SequenceRegion usingx: true with: ((PrimSpec pointer arrayWith: (BeforeSequence make: sequence)) cast: PtrArray)]! {SequenceRegion CLIENT} interval: start {Sequence} with: stop {Sequence} "Return a region of all sequence >= lower and < upper." "Ravi thingToDo." "use a single constructor" "Performance" ^((self above: start with: true) intersect: (self below: stop with: false)) cast: SequenceRegion! {SequenceMapping CLIENT} mapping: shift {IntegerVar} with: translation {Sequence default: NULL} "A transformation which shifts a value by some number of places and then adds a translation to it." self thingToDo. "better name for this method" translation == NULL ifTrue: [^SequenceMapping make: shift with: Sequence zero]. ^SequenceMapping make: shift with: translation! {Sequence CLIENT login} position: arg {PrimArray} with: shift {IntegerVar} "Essential. A sequence using the given numbers and shift. Leading and trailing zeros will be stripped, and a copy will be made so that noone modifies it" "IntegerVars cannot have default arguments" | numbers {PrimIntegerArray} | numbers _ arg cast: PrimIntegerArray. numbers == NULL ifTrue: [^Sequence usingx: shift with: (IntegerVarArray zeros: Int32Zero)]. ^Sequence usingx: shift with: (numbers copy cast: PrimIntegerArray)! {SequenceRegion CLIENT} prefixedBy: sequence {Sequence} with: limit {IntegerVar} "Essential. All sequences which match the given one up to and including the given index." ^SequenceRegion usingx: false with: ((PrimSpec pointer arrayWithTwo: (BeforeSequencePrefix below: sequence with: limit) with: (BeforeSequencePrefix above: sequence with: limit)) cast: PtrArray)! ! !SequenceSpace methodsFor: 'smalltalk: passe'! {Sequence} sequence: numbers {PrimIntegerArray | NULL} with: shift {IntegerVar | IntegerVarZero} self passe "position"! {SequenceRegion} sequencesAfter: sequence {Sequence} "Essential. All sequences greater than or equal to the given sequence. Should this just be supplanted by CoordinateSpace::region ()?" self passe. ^SequenceRegion usingx: false with: (PrimSpec pointer arrayWith: (BeforeSequence make: sequence))! {SequenceRegion} sequencesBefore: sequence {Sequence} "Essential. All sequences less than or equal to the given sequence. Should this just be supplanted by CoordinateSpace::region ()?" self passe. ^SequenceRegion usingx: true with: (PrimSpec pointer arrayWith: (AfterSequence make: sequence))! {SequenceRegion} sequencesPrefixedBy: sequence {Sequence} with: limit {IntegerVar} "Essential. All sequences which match the given one up to and including the given index. Should this just be supplanted by CoordinateSpace::region ()?" self passe. ^SequenceRegion usingx: false with: (PrimSpec pointer arrayWithTwo: (BeforeSequencePrefix below: sequence with: limit) with: (BeforeSequencePrefix above: sequence with: limit))! {SequenceMapping} shiftAndTranslation self passe! {SequenceDsp} shiftAndTranslation: shift {IntegerVar} self passe! {SequenceDsp} shiftAndTranslation: shift {IntegerVar} with: translation {Sequence} self passe! ! !SequenceSpace methodsFor: 'testing'! {UInt32} actualHashForEqual "is equal to any basic space on the same category of positions" ^self getCategory hashForEqual + 1! {BooleanVar} isEqual: anObject {Heaper} "is equal to any basic space on the same category of positions" ^anObject getCategory == self getCategory! ! !SequenceSpace methodsFor: 'smalltalk: defaults'! {SequenceMapping CLIENT} mapping: shift {IntegerVar} "A transformation which shifts a value by some number of places and then adds a translation to it." ^self mapping: shift with: NULL! ! !SequenceSpace methodsFor: 'generated:'! {void} sendSelfTo: xmtr {Xmtr}! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! SequenceSpace class instanceVariableNames: ''! (SequenceSpace getOrMakeCxxClassDescription) friends: '/* friends for class SequenceSpace */ friend class Sequence; '; attributes: ((Set new) add: #PSEUDO.COPY; add: #CONCRETE; add: #ON.CLIENT; yourself)! !SequenceSpace class methodsFor: 'rcvr creation'! {Heaper} make.Rcvr: rcvr {Rcvr} (rcvr cast: SpecialistRcvr) registerIbid: TheSequenceSpace. ^TheSequenceSpace! ! !SequenceSpace class methodsFor: 'creation'! {SequenceSpace INLINE} implicitReceiver "Get the receiver for wire requests." ^TheSequenceSpace! {SequenceSpace CLIENT login INLINE} make ^TheSequenceSpace! ! !SequenceSpace class methodsFor: 'smalltalk: init'! initTimeNonInherited self REQUIRES: Sequence. TheSequenceSpace := self create! linkTimeNonInherited TheSequenceSpace := NULL! ! !SequenceSpace class methodsFor: 'smalltalk: system'! info.stProtocol "{SequenceRegion CLIENT} above: sequence {Sequence} with: inclusive {BooleanVar} {SequenceRegion CLIENT} below: sequence {Sequence} with: inclusive {BooleanVar} {SequenceRegion CLIENT} interval: lower {Region} with: upper {Sequence} {SequenceMapping CLIENT} mapping: shift {IntegerVar} with: translation {Sequence} {Sequence CLIENT} position: numbers {PrimIntegerArray} {Sequence CLIENT} position: numbers {PrimIntegerArray | NULL} with: shift {IntegerVar | IntegerVarZero} {SequenceRegion CLIENT} prefixedBy: sequence {Sequence} with: limit {IntegerVar} "! !Stepper subclass: #DescendingIntegerStepper instanceVariableNames: ' myEdges {IntegerVarArray} myIndex {Int32} myPosition {IntegerVar}' classVariableNames: '' poolDictionaries: '' category: 'Xanadu-Spaces-Integers'! (DescendingIntegerStepper getOrMakeCxxClassDescription) attributes: ((Set new) add: #CONCRETE; add: #NOT.A.TYPE; yourself)! !DescendingIntegerStepper methodsFor: 'protected: create'! create: edges {IntegerVarArray} with: count {UInt32} super create. myEdges _ edges. myIndex _ count - 2. myIndex >= -1 ifTrue: [myPosition _ (myEdges integerVarAt: myIndex + 1) - 1] ifFalse: [myPosition _ IntegerVar0]! create: edges {IntegerVarArray} with: index {Int32} with: position {IntegerVar} super create. myEdges _ edges. myIndex _ index. myPosition _ position! ! !DescendingIntegerStepper methodsFor: 'creation'! {Stepper} copy ^DescendingIntegerStepper create: myEdges with: myIndex with: myPosition! ! !DescendingIntegerStepper methodsFor: 'accessing'! {Heaper wimpy} fetch self hasValue ifTrue: [^myPosition integer] ifFalse: [^NULL]! {BooleanVar} hasValue ^myIndex >= -1! {void} step myPosition _ myPosition - 1. (myIndex >= Int32Zero and: [myPosition < (myEdges integerVarAt: myIndex)]) ifTrue: [myIndex _ myIndex - 2. myIndex >= -1 ifTrue: [myPosition _ (myEdges integerVarAt: myIndex + 1) - 1]]! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! DescendingIntegerStepper class instanceVariableNames: ''! (DescendingIntegerStepper getOrMakeCxxClassDescription) attributes: ((Set new) add: #CONCRETE; add: #NOT.A.TYPE; yourself)! !DescendingIntegerStepper class methodsFor: 'creation'! {Stepper} make: edges {IntegerVarArray} with: count {UInt32} ^ self create: edges with: count! !Stepper subclass: #DisjointRegionStepper instanceVariableNames: ' myValue {XnRegion} myRegion {XnRegion} myOrder {OrderSpec}' classVariableNames: '' poolDictionaries: '' category: 'Xanadu-Collection-Steppers'! (DisjointRegionStepper getOrMakeCxxClassDescription) attributes: ((Set new) add: #CONCRETE; add: #NOT.A.TYPE; yourself)! !DisjointRegionStepper methodsFor: 'accessing'! {Heaper wimpy} fetch ^myValue! {BooleanVar} hasValue ^myValue ~~ NULL! {void} step myValue _ (myRegion simpleRegions: myOrder) fetch cast: XnRegion. myValue == NULL ifTrue: [myRegion isEmpty ifFalse: [Heaper BLAST: #RegionReturnedNullStepperEvenThoughNonEmpty]] ifFalse: [myRegion _ myRegion minus: myValue]! ! !DisjointRegionStepper methodsFor: 'instance creation'! {Stepper} copy ^DisjointRegionStepper make: (myValue unionWith: myRegion) with: myOrder! create: region {XnRegion} with: order {OrderSpec} super create. myValue _ NULL. myRegion _ region. myOrder _ order. myRegion isEmpty ifFalse: [self step].! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! DisjointRegionStepper class instanceVariableNames: ''! (DisjointRegionStepper getOrMakeCxxClassDescription) attributes: ((Set new) add: #CONCRETE; add: #NOT.A.TYPE; yourself)! !DisjointRegionStepper class methodsFor: 'instance creation'! {Stepper} make: region {XnRegion} with: order {OrderSpec} ^DisjointRegionStepper create: region with: order! !Accumulator subclass: #EdgeAccumulator instanceVariableNames: ' myManager {EdgeManager} myStartsInside {BooleanVar} myEdges {PtrArray of: TransitionEdge} myIndex {Int32} myPending {TransitionEdge} myResultGiven {BooleanVar NOCOPY}' classVariableNames: 'SomeAccumulators {InstanceCache} ' poolDictionaries: '' category: 'Xanadu-EdgeRegion'! (EdgeAccumulator getOrMakeCxxClassDescription) attributes: ((Set new) add: #CONCRETE; add: #COPY; yourself)! !EdgeAccumulator methodsFor: 'protected: create'! create: manager {EdgeManager} with: startsInside {BooleanVar} super create. myManager := manager. myStartsInside := startsInside. myEdges := PtrArray nulls: 4. myIndex := -1. myPending := NULL. myResultGiven := false! create: manager {EdgeManager} with: startsInside {BooleanVar} with: edges {PtrArray of: TransitionEdge} with: index {Int32} with: pending {TransitionEdge} super create. myManager := manager. myStartsInside _ startsInside. myEdges _ edges. myIndex := index. myPending _ pending. myResultGiven := false! ! !EdgeAccumulator methodsFor: 'creation'! {Accumulator} copy | result {Heaper} | result := SomeAccumulators fetch. myResultGiven := true. result == NULL ifTrue: [ ^EdgeAccumulator create: myManager with: myStartsInside with: myEdges with: myIndex with: myPending] ifFalse: [ ^(EdgeAccumulator new.Become: result) create: myManager with: myStartsInside with: myEdges with: myIndex with: myPending]! {void} destroy (SomeAccumulators store: self) ifFalse: [super destroy]! ! !EdgeAccumulator methodsFor: 'operations'! {void} step: someObj {Heaper} self edge: (someObj cast: TransitionEdge)! {Heaper} value ^self region! ! !EdgeAccumulator methodsFor: 'edge operations'! {void} edge: x {TransitionEdge} "add a transition at the given position. doing it again cancels it" myPending == NULL ifTrue: [myPending := x] ifFalse: [(myPending isEqual: x) ifTrue: [myPending := NULL] ifFalse: [self storeStep: myPending. myPending := x]].! {void} edges: stepper {EdgeStepper} "add a whole bunch of edges at once, assuming that they are sorted and there are no duplicates" "do the first step manually in case it is the same as the current edge then do all the rest without checking for repeats" stepper hasValue ifTrue: [|edge {TransitionEdge} | self edge: stepper fetchEdge. stepper step. [(edge := stepper fetch cast: TransitionEdge) ~~ NULL] whileTrue: [ myPending ~~ NULL ifTrue: [self storeStep: myPending]. myPending := edge. stepper step]]! {XnRegion} region "make a region out of the accumulated edges" myPending ~~ NULL ifTrue: [self storeStep: myPending. myPending := NULL]. myResultGiven := true. ^myManager makeNew: myStartsInside with: myEdges with: myIndex + 1! ! !EdgeAccumulator methodsFor: 'private:'! {void} storeStep: edge {TransitionEdge} "Just store an edge into the array and increment the count" myIndex := myIndex + 1. myIndex = myEdges count ifTrue: [ myEdges := (myEdges copyGrow: myEdges count) cast: PtrArray. myResultGiven := false] ifFalse: [ myResultGiven ifTrue: [ myEdges := myEdges copy cast: PtrArray. myResultGiven := false]]. myEdges at: myIndex store: edge.! ! !EdgeAccumulator methodsFor: 'hooks:'! {void RECEIVE.HOOK} restartEdgeAccumulator: rcvr {Rcvr unused} myResultGiven := false! ! !EdgeAccumulator methodsFor: 'generated:'! create.Rcvr: receiver {Rcvr} super create.Rcvr: receiver. myManager _ receiver receiveHeaper. myStartsInside _ receiver receiveBooleanVar. myEdges _ receiver receiveHeaper. myIndex _ receiver receiveInt32. myPending _ receiver receiveHeaper. self restartEdgeAccumulator: receiver.! {void} sendSelfTo: xmtr {Xmtr} super sendSelfTo: xmtr. xmtr sendHeaper: myManager. xmtr sendBooleanVar: myStartsInside. xmtr sendHeaper: myEdges. xmtr sendInt32: myIndex. xmtr sendHeaper: myPending.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! EdgeAccumulator class instanceVariableNames: ''! (EdgeAccumulator getOrMakeCxxClassDescription) attributes: ((Set new) add: #CONCRETE; add: #COPY; yourself)! !EdgeAccumulator class methodsFor: 'smalltalk: init'! initTimeNonInherited SomeAccumulators := InstanceCache make: 8! linkTimeNonInherited SomeAccumulators := NULL! ! !EdgeAccumulator class methodsFor: 'create'! make: manager {EdgeManager} with: startsInside {BooleanVar} | result {Heaper} | result := SomeAccumulators fetch. result == NULL ifTrue: [^ self create: manager with: startsInside] ifFalse: [^ (self new.Become: result) create: manager with: startsInside]! !Heaper subclass: #EdgeManager instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Xanadu-edge'! EdgeManager comment: 'Manages the common code for regions which are represented as a sequence of EdgeTransitions. Each coordinate space should define a subclass which implements the appropriate methods, and then use it to do the various region operations. Clients of the region do not need to see any of these classes.'! (EdgeManager getOrMakeCxxClassDescription) friends: 'friend class EdgeSimpleRegionStepper; friend class EdgeAccumulator; '; attributes: ((Set new) add: #DEFERRED; add: #EQ; yourself)! !EdgeManager methodsFor: 'private:'! {EdgeAccumulator} edgeAccumulator: startsInside {BooleanVar} "Create an accumulator which takes edges and creates a region" ^EdgeAccumulator make: self with: startsInside! {EdgeStepper} edgeStepper: region {XnRegion} "Create a stepper for iterating through the edges of the region" ^EdgeStepper make: (self startsInside: region) not with: (self transitions: region) with: (self transitionsCount: region)! {TransitionEdge} lowerEdge: region {XnRegion} | transitions {PtrArray of: TransitionEdge} | transitions := self transitions: region. ((self startsInside: region) or: [(self transitionsCount: region) = Int32Zero]) ifTrue: [Heaper BLAST: #InvalidRequest]. ^(transitions fetch: Int32Zero) cast: TransitionEdge! {EdgeStepper} singleEdgeStepper: pos {Position} "Create a stepper for iterating through the edges of the region" ^EdgeStepper make: false not with: (self posTransitions: pos)! {TransitionEdge} upperEdge: region {XnRegion} | transitions {PtrArray of: TransitionEdge} transitionsCount {Int32} | transitions := self transitions: region. transitionsCount := self transitionsCount: region. ((self isBoundedRight: region) not or: [transitionsCount == Int32Zero]) ifTrue: [Heaper BLAST: #InvalidRequest]. ^(transitions fetch: (transitionsCount - 1)) cast: TransitionEdge! ! !EdgeManager methodsFor: 'testing'! {BooleanVar} hasMember: region {XnRegion} with: pos {Position} | edges {EdgeStepper} edge {TransitionEdge} result {BooleanVar} | edges := self edgeStepper: region. [(edge := edges fetch cast: TransitionEdge) ~~ NULL] whileTrue: [(edge follows: pos) ifTrue: [result := edges isEntering not. edges destroy. ^ result]. edges step]. result := edges isEntering not. edges destroy. ^ result! {BooleanVar} isBoundedLeft: region {XnRegion} "Same meaning as IntegerRegion::isBoundedLeft" ^(self startsInside: region) not! {BooleanVar} isBoundedRight: region {XnRegion} "Same meaning as IntegerRegion::isBoundedRight" ^(((self transitionsCount: region) bitAnd: 1) == Int32Zero) ~~ (self startsInside: region)! {BooleanVar} isEmpty: region {XnRegion} ^(self startsInside: region) not and: [(self transitionsCount: region) = Int32Zero]! {BooleanVar} isFinite: region {XnRegion} "Here is one place where the *infinite* of the infinite divisibility assumed by OrderedRegion about the full ordering comes in (see class comment). An interval whose left edge is not the same as the right edge is assumed to contain an infinite number of positions" | transitions {PtrArray of: TransitionEdge} transitionsCount {Int32} | transitions := self transitions: region. transitionsCount := self transitionsCount: region. ((self startsInside: region) or: [(transitionsCount bitAnd: 1) ~~ Int32Zero]) ifTrue: [^false]. Int32Zero almostTo: transitionsCount by: 2 do: [ :i {Int32} | (((transitions fetch: i) cast: TransitionEdge) isFollowedBy: ((transitions fetch: i + 1) cast: TransitionEdge)) ifFalse: [^false]]. ^true! {BooleanVar} isFull: region {XnRegion} ^(self startsInside: region) and: [(self transitionsCount: region) = Int32Zero]! {BooleanVar} isSimple: region {XnRegion} | testVal {Int32} | (self startsInside: region) ifTrue: [testVal _ 1] ifFalse: [testVal _ 2]. ^(self transitionsCount: region) <= testVal! {BooleanVar} isSubsetOf: me {XnRegion} with: other {XnRegion} | mine {EdgeStepper} others {EdgeStepper} result {BooleanVar} | (self isEmpty: other) ifTrue: [^self isEmpty: me]. mine := self edgeStepper: me. others := self edgeStepper: other. (mine hasValue or: [others hasValue]) ifFalse: [ result := mine isEntering or: [others isEntering not]. mine destroy. others destroy. ^ result]. (mine isEntering not and: [others isEntering]) ifTrue: [mine destroy. others destroy. ^false]. [mine hasValue and: [others hasValue]] whileTrue: [(others getEdge isGE: mine getEdge) not ifTrue: [(others isEntering not and: [mine isEntering not]) ifTrue: [mine destroy. others destroy. ^false]. others step] ifFalse: [(mine getEdge isGE: others getEdge) not ifTrue: [(others isEntering and: [mine isEntering]) ifTrue: [mine destroy. others destroy. ^false]. mine step] ifFalse: [others isEntering ~~ mine isEntering ifTrue: [mine destroy. others destroy. ^false]. others step. mine step]]]. result := ((mine hasValue and: [others isEntering]) or: [others hasValue and: [mine isEntering not]]) not. mine destroy. others destroy. ^ result! ! !EdgeManager methodsFor: 'enumerating'! {IntegerVar} count: region {XnRegion} "Because Edge Regions should only be used on infinitely divisible spaces (like rationals), if it's finite then it is bounded on both sides, and all the internal intervals are singletons" (self isFinite: region) ifFalse: [Heaper BLAST: #MustBeFinite]. ^(self transitionsCount: region) // 2! ! !EdgeManager methodsFor: 'accessing'! {XnRegion} asSimpleRegion: region {XnRegion} (self isSimple: region) ifTrue: [^region]. (self isBoundedLeft: region) ifTrue: [(self isBoundedRight: region) ifTrue: [^self makeNew: false with: ((PrimSpec pointer arrayWithTwo: (self lowerEdge: region) with: (self upperEdge: region)) cast: PtrArray)] ifFalse: [^self makeNew: false with: ((PrimSpec pointer arrayWith: (self lowerEdge: region)) cast: PtrArray)]] ifFalse: [(self isBoundedRight: region) ifTrue: [^self makeNew: true with: ((PrimSpec pointer arrayWith: (self upperEdge: region)) cast: PtrArray)] ifFalse: [^self makeNew: true with: PtrArray empty]]! {Position} greatestLowerBound: region {XnRegion} "The largest position such that no other positions in the region are any less than it. In other words, this is the lower bounding element. We choose to avoid the terms 'lowerBound' and 'upperBound' as their meanings in IntegerRegion are significantly different. Here, both 'all numbers >= 3' and 'all numbers > 3' have a 'greatestLowerBound' of 3 even though the latter doesn't include 3. To tell whether a bound is included, good old 'hasMember' should do a fine job." ^self edgePosition: (self lowerEdge: region)! {Position} leastUpperBound: region {XnRegion} "The smallest position such that no other positions in the region are any greater than it. In other words, this is the upper bounding element. We choose to avoid the terms 'lowerBound' and 'upperBound' as their meanings in IntegerRegion are significantly different. Here, both 'all numbers <= 3' and 'all numbers < 3' have a 'leastUpperBound' of 3 even though the latter doesn't include 3. To tell whether a bound is included, good old 'hasMember' should do a fine job." ^self edgePosition: (self upperEdge: region)! {XnRegion} simpleUnion: me {XnRegion} with: other {XnRegion} (self isEmpty: me) ifTrue: [^self asSimpleRegion: other]. (self isEmpty: other) ifTrue: [^self asSimpleRegion: me]. ((self isBoundedLeft: me) and: [self isBoundedLeft: other]) ifTrue: [((self isBoundedRight: me) and: [self isBoundedRight: other]) ifTrue: [^self makeNew: false with: ((PrimSpec pointer arrayWithTwo: ((self lowerEdge: me) floor: (self lowerEdge: other)) with: ((self upperEdge: me) ceiling: (self upperEdge: other))) cast: PtrArray)] ifFalse: [^self makeNew: false with: ((PrimSpec pointer arrayWith: ((self lowerEdge: me) floor: (self lowerEdge: other))) cast: PtrArray)]] ifFalse: [((self isBoundedRight: me) and: [self isBoundedRight: other]) ifTrue: [^self makeNew: true with: ((PrimSpec pointer arrayWith: ((self upperEdge: me) ceiling: (self upperEdge: other))) cast: PtrArray)] ifFalse: [^self makeNew: true with: PtrArray empty]]! ! !EdgeManager methodsFor: 'printing'! {void} printRegionOn: region {XnRegion} with: oo {ostream reference} (self isEmpty: region) ifTrue: [oo << '{}'] ifFalse: [ | edges {EdgeStepper} previous {TransitionEdge} | edges := self edgeStepper: region. (self isSimple: region) ifFalse: [oo << '{']. edges isEntering ifFalse: [oo << '(-inf']. previous := NULL. edges forEach: [ :edge {TransitionEdge} | edge printTransitionOn: oo with: edges isEntering with: (previous ~~ NULL and: [previous touches: edge]). previous := edge]. (self isBoundedRight: region) ifFalse: [oo << ' +inf)']. (self isSimple: region) ifFalse: [oo << '}']]! ! !EdgeManager methodsFor: 'operations'! {XnRegion} complement: region {XnRegion} ^self makeNew: (self startsInside: region) not with: (self transitions: region) with: (self transitionsCount: region)! {ScruSet of: XnRegion} distinctions: region {XnRegion} | result {MuSet} | (self isSimple: region) ifFalse: [Heaper BLAST: #InvalidRequest]. (self isEmpty: region) ifTrue: [^ImmuSet make with: region]. (self isFull: region) ifTrue: [^ImmuSet make]. (self transitionsCount: region) = 1 ifTrue: [^ImmuSet make with: region]. result := MuSet make. result store: (self makeNew: false with: ((PrimSpec pointer arrayWith: (self lowerEdge: region)) cast: PtrArray)). result store: (self makeNew: true with: ((PrimSpec pointer arrayWith: (self upperEdge: region)) cast: PtrArray)). ^result asImmuSet! {XnRegion} intersect: meRegion {XnRegion} with: otherRegion {XnRegion} | mine {EdgeStepper} others {EdgeStepper} result {EdgeAccumulator} resultReg {XnRegion} | (self isEmpty: otherRegion) ifTrue: [^otherRegion]. mine := self edgeStepper: meRegion. others := self edgeStepper: otherRegion. result := self edgeAccumulator: ((self startsInside: meRegion) and: [self startsInside: otherRegion]). [mine hasValue and: [others hasValue]] whileTrue: [ | me {TransitionEdge} other {TransitionEdge} | me := mine getEdge. other := others getEdge. (me isGE: other) not ifTrue: [others isEntering not ifTrue: [result edge: me]. mine step] ifFalse: [mine isEntering not ifTrue: [result edge: other]. others step]]. (mine hasValue and: [others isEntering not]) ifTrue: [result edges: mine]. (others hasValue and: [mine isEntering not]) ifTrue: [result edges: others]. mine destroy. others destroy. resultReg := result region. result destroy. ^ resultReg! {Stepper} simpleRegions: region {XnRegion} with: order {OrderSpec default: NULL} order ~~ NULL ifTrue: [self unimplemented]. ^EdgeSimpleRegionStepper make: self with: (self edgeStepper: region)! {XnRegion} unionWith: meRegion {XnRegion} with: otherRegion {XnRegion} | mine {EdgeStepper} others {EdgeStepper} result {EdgeAccumulator} resultReg {XnRegion} | (self isEmpty: otherRegion) ifTrue: [^meRegion]. mine := self edgeStepper: meRegion. others := self edgeStepper: otherRegion. result := self edgeAccumulator: ((self startsInside: meRegion) or: [self startsInside: otherRegion]). [mine hasValue and: [others hasValue]] whileTrue: [ | me {TransitionEdge} other {TransitionEdge} | me := mine getEdge. other := others getEdge. (me isGE: other) not ifTrue: [others isEntering ifTrue: [result edge: me]. mine step] ifFalse: [mine isEntering ifTrue: [result edge: other]. others step]]. (mine hasValue and: [others isEntering]) ifTrue: [result edges: mine]. (others hasValue and: [mine isEntering]) ifTrue: [result edges: others]. mine destroy. others destroy. resultReg := result region. result destroy. ^ resultReg! {XnRegion} with: meRegion {XnRegion} with: newPos {Position} | mine {EdgeStepper} others {EdgeStepper} result {EdgeAccumulator} resultReg {XnRegion} | mine := self edgeStepper: meRegion. others := self singleEdgeStepper: newPos. result := self edgeAccumulator: (self startsInside: meRegion). [mine hasValue and: [others hasValue]] whileTrue: [ | me {TransitionEdge} other {TransitionEdge} | me := mine getEdge. other := others getEdge. (me isGE: other) not ifTrue: [others isEntering ifTrue: [result edge: me]. mine step] ifFalse: [mine isEntering ifTrue: [result edge: other]. others step]]. (mine hasValue and: [others isEntering]) ifTrue: [result edges: mine]. (others hasValue and: [mine isEntering]) ifTrue: [result edges: others]. mine destroy. others destroy. resultReg := result region. result destroy. ^ resultReg! ! !EdgeManager methodsFor: 'protected:'! {Position} edgePosition: edge {TransitionEdge} "The position associated with the given edge. Blast if there is none" self subclassResponsibility! {XnRegion} makeNew: startsInside {BooleanVar} with: transitions {PtrArray of: TransitionEdge} "Make a new region of the right type" self subclassResponsibility! {XnRegion} makeNew: startsInside {BooleanVar} with: transitions {PtrArray of: TransitionEdge} with: count {Int32} "Make a new region of the right type" self subclassResponsibility! {PtrArray of: TransitionEdge} posTransitions: pos {Position} self subclassResponsibility! {BooleanVar} startsInside: region {XnRegion} self subclassResponsibility! {PtrArray of: TransitionEdge} transitions: region {XnRegion} self subclassResponsibility! {Int32} transitionsCount: region {XnRegion} self subclassResponsibility! ! !EdgeManager methodsFor: 'generated:'! actualHashForEqual ^self asOop! isEqual: other ^self == other! !EdgeManager subclass: #RealManager instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Xanadu-tumbler'! (RealManager getOrMakeCxxClassDescription) attributes: ((Set new) add: #CONCRETE; add: #COPY; yourself)! !RealManager methodsFor: 'protected:'! {Position} edgePosition: edge {TransitionEdge} ^(edge cast: RealEdge) position! {XnRegion} makeNew: startsInside {BooleanVar} with: transitions {PtrArray of: TransitionEdge} ^RealRegion make: startsInside with: transitions! {XnRegion} makeNew: startsInside {BooleanVar} with: transitions {PtrArray of: TransitionEdge} with: count {Int32} ^self makeNew: startsInside with: ((transitions copy: count) cast: PtrArray)! {PtrArray of: TransitionEdge} posTransitions: pos {Position} self unimplemented. ^NULL "fodder"! {BooleanVar} startsInside: region {XnRegion} ^(region cast: RealRegion) startsInside! {PtrArray of: TransitionEdge} transitions: region {XnRegion} ^(region cast: RealRegion) secretTransitions! {Int32 INLINE} transitionsCount: region {XnRegion} ^(region cast: RealRegion) secretTransitions count! ! !RealManager methodsFor: 'generated:'! create.Rcvr: receiver {Rcvr} super create.Rcvr: receiver.! {void} sendSelfTo: xmtr {Xmtr} super sendSelfTo: xmtr.! !EdgeManager subclass: #SequenceManager instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Xanadu-tumbler'! SequenceManager comment: 'Specialized object for managing TumblerSpace objects. Is a type so that inlining could potentially be used.'! (SequenceManager getOrMakeCxxClassDescription) attributes: ((Set new) add: #CONCRETE; add: #COPY; yourself)! !SequenceManager methodsFor: 'protected:'! {Position} edgePosition: edge {TransitionEdge} ^(edge cast: SequenceEdge) sequence! {XnRegion} makeNew: startsInside {BooleanVar} with: transitions {PtrArray of: TransitionEdge} ^self makeNew: startsInside with: transitions with: transitions count! {XnRegion} makeNew: startsInside {BooleanVar} with: transitions {PtrArray of: TransitionEdge} with: count {Int32} ^SequenceRegion create: startsInside with: transitions with: count! {PtrArray of: TransitionEdge} posTransitions: pos {Position} ^ (PrimSpec pointer arrayWithTwo: (BeforeSequence make: (pos cast: Sequence)) with: (AfterSequence make: (pos cast: Sequence))) cast: PtrArray! {BooleanVar} startsInside: region {XnRegion} ^(region cast: SequenceRegion) startsInside! {PtrArray of: TransitionEdge} transitions: region {XnRegion} ^(region cast: SequenceRegion) secretTransitions! {Int32} transitionsCount: region {XnRegion} ^(region cast: SequenceRegion) secretTransitionsCount! ! !SequenceManager methodsFor: 'generated:'! create.Rcvr: receiver {Rcvr} super create.Rcvr: receiver.! {void} sendSelfTo: xmtr {Xmtr} super sendSelfTo: xmtr.! !Stepper subclass: #EdgeSimpleRegionStepper instanceVariableNames: ' myManager {EdgeManager} myEdges {EdgeStepper} mySimple {XnRegion}' classVariableNames: '' poolDictionaries: '' category: 'Xanadu-EdgeRegion'! EdgeSimpleRegionStepper comment: 'Consider this a "protected" class. See class comment in EdgeAccumulator'! (EdgeSimpleRegionStepper getOrMakeCxxClassDescription) attributes: ((Set new) add: #CONCRETE; yourself)! !EdgeSimpleRegionStepper methodsFor: 'accessing'! {Heaper wimpy} fetch ^mySimple! {BooleanVar} hasValue ^mySimple ~~ NULL! {void} step | startsInside {BooleanVar} one {TransitionEdge} two {TransitionEdge} | "if there are no more edges then the stepper is empty remember whether we're entering or leaving the region fetch the first edge if there is no first edge then remember the edges are gone if we were already in the region then there is the full region else we're empty else there is a first edge, so if we start outside and there is another edge then get it and make a two-sided region else make a one-side region" myEdges == NULL ifTrue: [mySimple := NULL. ^VOID]. startsInside := myEdges isEntering not. one := myEdges fetchEdge. one == NULL ifTrue: [myEdges := NULL. (startsInside and: [mySimple == NULL]) ifTrue: [mySimple := myManager makeNew: true with: PtrArray empty] ifFalse: [mySimple := NULL]] ifFalse: [myEdges step. (startsInside not and: [myEdges hasValue]) ifTrue: [two := myEdges fetchEdge. myEdges step. mySimple := myManager makeNew: startsInside with: ((PrimSpec pointer arrayWithTwo: one with: two) cast: PtrArray)] ifFalse: [mySimple := myManager makeNew: startsInside with: ((PrimSpec pointer arrayWith: one) cast: PtrArray)]].! ! !EdgeSimpleRegionStepper methodsFor: 'create'! {Stepper} copy | step {EdgeStepper} | "can't to ?: with SPTRs" step := myEdges. step ~~ NULL ifTrue: [step := myEdges copy cast: EdgeStepper]. ^ EdgeSimpleRegionStepper create: myManager with: step with: mySimple! ! !EdgeSimpleRegionStepper methodsFor: 'protected: create'! create: manager {EdgeManager} with: edges {EdgeStepper} super create. myManager := manager. myEdges := edges. mySimple := NULL. self step.! create: manager {EdgeManager} with: edges {EdgeStepper | NULL} with: simple {XnRegion | NULL} super create. myManager := manager. myEdges := edges. mySimple := simple! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! EdgeSimpleRegionStepper class instanceVariableNames: ''! (EdgeSimpleRegionStepper getOrMakeCxxClassDescription) attributes: ((Set new) add: #CONCRETE; yourself)! !EdgeSimpleRegionStepper class methodsFor: 'create'! make: manager {EdgeManager} with: edges {EdgeStepper} ^ self create: manager with: edges! !Stepper subclass: #EdgeStepper instanceVariableNames: ' myEntering {BooleanVar} myEdges {PtrArray of: TransitionEdge} myEdgesCount {Int32} myIndex {Int32}' classVariableNames: 'SomeEdgeSteppers {InstanceCache} ' poolDictionaries: '' category: 'Xanadu-EdgeRegion'! EdgeStepper comment: 'A single instance of this class is cached. To take advantage of this, a method that uses EdgeSteppers should explicitly destroy at least one of them. Consider this a "protected" class. See class comment in EdgeAccumulator.'! (EdgeStepper getOrMakeCxxClassDescription) attributes: ((Set new) add: #CONCRETE; yourself)! !EdgeStepper methodsFor: 'accessing'! {Heaper wimpy} fetch myIndex < myEdgesCount ifTrue: [^myEdges fetch: myIndex] ifFalse: [^NULL]! {BooleanVar} hasValue ^myIndex < myEdgesCount! {void} step self hasValue ifTrue: [myEntering := myEntering not. myIndex := myIndex + 1]! ! !EdgeStepper methodsFor: 'edge accessing'! {TransitionEdge | NULL} fetchEdge myIndex < myEdgesCount ifTrue: [^(myEdges fetch: myIndex) cast: TransitionEdge] ifFalse: [^NULL]! {TransitionEdge} getEdge myIndex < myEdgesCount ifTrue: [^(myEdges fetch: myIndex) cast: TransitionEdge] ifFalse: [Heaper BLAST: #EmptyStepper]. ^NULL "fodder"! {BooleanVar} isEntering "whether the current transition is entering or leaving the set" ^myEntering! ! !EdgeStepper methodsFor: 'protected: create'! create: entering {BooleanVar} with: edges {PtrArray of: TransitionEdge} with: count {Int32} super create. myEntering := entering. myEdges := edges. myEdgesCount := count. myIndex := Int32Zero! create: entering {BooleanVar} with: edges {PtrArray of: TransitionEdge} with: count {Int32} with: index {Int32} super create. myEntering := entering. myEdges := edges. myEdgesCount := count. myIndex := index! ! !EdgeStepper methodsFor: 'create'! {Stepper} copy ^EdgeStepper create: myEntering with: myEdges with: myEdgesCount with: myIndex! ! !EdgeStepper methodsFor: 'destroy'! {void} destroy (SomeEdgeSteppers store: self) ifFalse: [super destroy]! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! EdgeStepper class instanceVariableNames: ''! (EdgeStepper getOrMakeCxxClassDescription) attributes: ((Set new) add: #CONCRETE; yourself)! !EdgeStepper class methodsFor: 'create'! make: entering {BooleanVar} with: edges {PtrArray of: TransitionEdge} | result {Heaper} | result := SomeEdgeSteppers fetch. result == NULL ifTrue: [ ^ self create: entering with: edges with: edges count] ifFalse: [ ^ (self new.Become: result) create: entering with: edges with: edges count]! make: entering {BooleanVar} with: edges {PtrArray of: TransitionEdge} with: count {Int32} | result {Heaper} | result := SomeEdgeSteppers fetch. result == NULL ifTrue: [ ^ self create: entering with: edges with: count] ifFalse: [ ^ (self new.Become: result) create: entering with: edges with: count]! ! !EdgeStepper class methodsFor: 'smalltalk: init'! initTimeNonInherited SomeEdgeSteppers := InstanceCache make: 16! linkTimeNonInherited SomeEdgeSteppers := NULL! !Stepper subclass: #GenericCrossSimpleRegionStepper instanceVariableNames: ' mySpace {CrossSpace} myBoxes {Stepper of: CrossRegion} mySimples {PtrArray of: (Stepper of: XnRegion)}' classVariableNames: '' poolDictionaries: '' category: 'Xanadu-cross'! (GenericCrossSimpleRegionStepper getOrMakeCxxClassDescription) attributes: ((Set new) add: #CONCRETE; add: #EQ; add: #NOT.A.TYPE; yourself)! !GenericCrossSimpleRegionStepper methodsFor: 'operations'! {Heaper wimpy} fetch | result {PtrArray} | self hasValue ifFalse: [^NULL]. result := PtrArray nulls: mySpace axisCount. Int32Zero almostTo: mySpace axisCount do: [ :i {Int32} | result at: i store: ((mySimples get: i) cast: Stepper) get]. ^mySpace crossOfRegions: result! {BooleanVar} hasValue ^myBoxes hasValue! {void} step | index {Int32} | myBoxes hasValue ifTrue: [ index := mySpace axisCount - 1. [index >= Int32Zero] whileTrue: [ | sub {Stepper} | sub := (mySimples get: index) cast: Stepper. sub step. sub hasValue ifTrue: [self replenishSteppers: index + 1. ^VOID]. index := index - 1]. myBoxes step. myBoxes hasValue ifTrue: [self replenishSteppers: Int32Zero]]! ! !GenericCrossSimpleRegionStepper methodsFor: 'private:'! {void} replenishSteppers: index {Int32} "Replenish all steppers starting at index" | box {CrossRegion} | box := myBoxes get cast: CrossRegion. index almostTo: mySpace axisCount do: [ :i {Int32} | mySimples at: i store: (box projection: i) simpleRegions]! ! !GenericCrossSimpleRegionStepper methodsFor: 'create'! {Stepper} copy | simples {PtrArray} | simples := PtrArray nulls: mySimples count. Int32Zero almostTo: simples count do: [ :i {Int32} | simples at: i store: ((mySimples get: i) cast: Stepper) copy]. ^GenericCrossSimpleRegionStepper create: mySpace with: myBoxes copy with: simples! ! !GenericCrossSimpleRegionStepper methodsFor: 'protected: create'! create: space {CrossSpace} with: boxes {Stepper} super create. mySpace := space. myBoxes := boxes. boxes hasValue ifTrue: [mySimples := PtrArray nulls: space axisCount. self replenishSteppers: Int32Zero]! create: space {CrossSpace} with: boxes {Stepper} with: simples {PtrArray} super create. mySpace := space. myBoxes := boxes. mySimples := simples.! ! !GenericCrossSimpleRegionStepper methodsFor: 'generated:'! actualHashForEqual ^self asOop! isEqual: other ^self == other! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! GenericCrossSimpleRegionStepper class instanceVariableNames: ''! (GenericCrossSimpleRegionStepper getOrMakeCxxClassDescription) attributes: ((Set new) add: #CONCRETE; add: #EQ; add: #NOT.A.TYPE; yourself)! !GenericCrossSimpleRegionStepper class methodsFor: 'create'! {Stepper} make: space {CrossSpace} with: boxes {Stepper} ^self create: space with: boxes! !Accumulator subclass: #IntegerEdgeAccumulator instanceVariableNames: ' myStartsInside {BooleanVar} myEdges {IntegerVarArray} myIndex {UInt32} havePending {BooleanVar} myPending {IntegerVar}' classVariableNames: 'SomeAccumulators {InstanceCache} ' poolDictionaries: '' category: 'Xanadu-Spaces-Integers'! (IntegerEdgeAccumulator getOrMakeCxxClassDescription) attributes: ((Set new) add: #CONCRETE; yourself)! !IntegerEdgeAccumulator methodsFor: 'protected: creation'! create: startsInside {BooleanVar} with: count {UInt32} super create. myStartsInside _ startsInside. myEdges _ IntegerVarArray zeros: count. myIndex _ Int32Zero. havePending _ false. myPending _ IntegerVar0! create: startsInside {BooleanVar} with: edges {IntegerVarArray} with: index {UInt32} with: hasPending {BooleanVar} with: pending {IntegerVar} super create. myStartsInside _ startsInside. myEdges _ edges. myIndex _ index. havePending _ hasPending. myPending _ pending! ! !IntegerEdgeAccumulator methodsFor: 'creation'! {Accumulator} copy | result {Heaper} | result := SomeAccumulators fetch. result == NULL ifTrue: [ ^IntegerEdgeAccumulator create: myStartsInside with: myEdges with: myIndex with: havePending with: myPending] ifFalse: [ ^(IntegerEdgeAccumulator new.Become: result) create: myStartsInside with: myEdges with: myIndex with: havePending with: myPending]! {void} destroy (SomeAccumulators store: self) ifFalse: [super destroy]! ! !IntegerEdgeAccumulator methodsFor: 'operations'! {void} step: someObj {Heaper} self edge: (someObj cast: IntegerPos) asIntegerVar! {Heaper} value ^self region! ! !IntegerEdgeAccumulator methodsFor: 'printing'! {void} printOn: oo {ostream reference} oo << self getCategory name << '(' << self region << ')'! ! !IntegerEdgeAccumulator methodsFor: 'edge operations'! {void} edge: x {IntegerVar} "add a transition at the given position. doing it again cancels it. This particular coding is used for C++ inlinability" havePending ifTrue: [myPending = x ifTrue: [havePending _ false] ifFalse: [myEdges at: myIndex storeIntegerVar: myPending. myIndex _ myIndex + 1. myPending _ x]] ifFalse: [havePending _ true. myPending _ x].! {void} edges: stepper {IntegerEdgeStepper} "add a whole bunch of edges at once, assuming that they are sorted and there are no duplicates" stepper hasValue ifTrue: [self edge: stepper edge. stepper step. stepper hasValue ifTrue: [havePending ifFalse: [myPending _ stepper edge. havePending _ true. stepper step]. [stepper hasValue] whileTrue: [myEdges at: myIndex storeIntegerVar: myPending. myIndex _ myIndex + 1. myPending _ stepper edge. stepper step]]]! {IntegerRegion} region "make a region out of the accumulated edges" havePending ifTrue: [myEdges at: myIndex storeIntegerVar: myPending. ^IntegerRegion create: myStartsInside with: myIndex + 1 with: myEdges] ifFalse: [myIndex == Int32Zero ifTrue: [myStartsInside ifTrue: [^IntegerRegion allIntegers] ifFalse: [^IntegerRegion make]] ifFalse: [^IntegerRegion create: myStartsInside with: myIndex with: myEdges]]! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! IntegerEdgeAccumulator class instanceVariableNames: ''! (IntegerEdgeAccumulator getOrMakeCxxClassDescription) attributes: ((Set new) add: #CONCRETE; yourself)! !IntegerEdgeAccumulator class methodsFor: 'creation'! make: startsInside {BooleanVar} with: count {UInt32} | result {Heaper} | result := SomeAccumulators fetch. result == NULL ifTrue: [^ self create: startsInside with: count] ifFalse: [^ (self new.Become: result) create: startsInside with: count]! ! !IntegerEdgeAccumulator class methodsFor: 'smalltalk: init'! initTimeNonInherited SomeAccumulators := InstanceCache make: 16! linkTimeNonInherited SomeAccumulators := NULL! !Stepper subclass: #IntegerEdgeStepper instanceVariableNames: ' myEntering {BooleanVar} myIndex {UInt32} myCount {UInt32} myEdges {IntegerVarArray}' classVariableNames: 'SomeEdgeSteppers {InstanceCache} ' poolDictionaries: '' category: 'Xanadu-Spaces-Integers'! IntegerEdgeStepper comment: 'A single instance of this class is cached. To take advantage of this, a method that uses IntegerEdgeSteppers should explicitly destroy at least one of them.'! (IntegerEdgeStepper getOrMakeCxxClassDescription) attributes: ((Set new) add: #CONCRETE; yourself)! !IntegerEdgeStepper methodsFor: 'operations'! {Heaper wimpy} fetch self hasValue ifTrue: [^IntegerPos make: self edge] ifFalse: [^NULL]! {BooleanVar INLINE} hasValue ^myIndex < myCount! {void INLINE} step myEntering _ myEntering not. myIndex _ myIndex + 1! ! !IntegerEdgeStepper methodsFor: 'edge accessing'! {IntegerVar INLINE} edge "the current transition" (myIndex >= myCount) ifTrue: [ IntegerEdgeStepper outOfBounds ]. ^myEdges integerVarAt: myIndex! {BooleanVar INLINE} isEntering "whether the current transition is entering or leaving the set" ^myEntering! ! !IntegerEdgeStepper methodsFor: 'protected: create'! create: entering {BooleanVar} with: count {UInt32} with: edges {IntegerVarArray} super create. myEntering _ entering. myIndex _ Int32Zero. myCount _ count. myEdges _ edges! create: entering {BooleanVar} with: index {UInt32} with: count {UInt32} with: edges {IntegerVarArray} super create. myEntering _ entering. myIndex _ index. myCount _ count. myEdges _ edges! ! !IntegerEdgeStepper methodsFor: 'destroy'! {void} destroy (SomeEdgeSteppers store: self) ifFalse: [super destroy]! ! !IntegerEdgeStepper methodsFor: 'create'! {Stepper} copy ^IntegerEdgeStepper create: myEntering with: myIndex with: myCount with: myEdges! ! !IntegerEdgeStepper methodsFor: 'printing'! {void} printOn: oo {ostream reference} oo << self getCategory name << '('. self hasValue ifTrue: [self isEntering ifTrue: [oo << 'entering '] ifFalse: [oo << 'leaving ']. oo << self edge]. oo << ')'.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! IntegerEdgeStepper class instanceVariableNames: ''! (IntegerEdgeStepper getOrMakeCxxClassDescription) attributes: ((Set new) add: #CONCRETE; yourself)! !IntegerEdgeStepper class methodsFor: 'errors'! {void} outOfBounds self BLAST: #OutOfBounds! ! !IntegerEdgeStepper class methodsFor: 'create'! make: entering {BooleanVar} with: count {UInt32} with: edges {IntegerVarArray} | result {Heaper} | result := SomeEdgeSteppers fetch. result == NULL ifTrue: [ ^ self create: entering with: count with: edges] ifFalse: [ ^ (self new.Become: result) create: entering with: count with: edges]! ! !IntegerEdgeStepper class methodsFor: 'smalltalk: init'! initTimeNonInherited SomeEdgeSteppers := InstanceCache make: 2! linkTimeNonInherited SomeEdgeSteppers := NULL! !Stepper subclass: #IntegerSimpleRegionStepper instanceVariableNames: ' myEdges {IntegerVarArray} myIndex {UInt32} myCount {UInt32} isLeftBounded {BooleanVar} mySimple {IntegerRegion}' classVariableNames: '' poolDictionaries: '' category: 'Xanadu-Spaces-Integers'! (IntegerSimpleRegionStepper getOrMakeCxxClassDescription) attributes: ((Set new) add: #CONCRETE; add: #NOT.A.TYPE; yourself)! !IntegerSimpleRegionStepper methodsFor: 'operations'! {Heaper wimpy} fetch ^mySimple! {BooleanVar} hasValue ^mySimple ~~ NULL! {void} step isLeftBounded ifTrue: [myIndex _ myIndex + 2] ifFalse: [myIndex _ myIndex + 1]. isLeftBounded _ true. myIndex < myCount ifTrue: [myIndex < (myCount - 1) ifTrue: [mySimple _ IntegerRegion make: (myEdges integerVarAt: myIndex) with: (myEdges integerVarAt: myIndex + 1)] ifFalse: [mySimple _ IntegerRegion after: (myEdges integerVarAt: myIndex)]] ifFalse: [mySimple _ NULL]! ! !IntegerSimpleRegionStepper methodsFor: 'unprotected create'! create: edges {IntegerVarArray} with: count {UInt32} with: leftBounded {BooleanVar} super create. myEdges _ edges. myIndex _ Int32Zero. myCount _ count. isLeftBounded _ leftBounded. count == Int32Zero ifTrue: [leftBounded ifTrue: [mySimple _ NULL] ifFalse: [mySimple _ IntegerRegion allIntegers]] ifFalse: [leftBounded not ifTrue: [mySimple _ IntegerRegion before: (edges integerVarAt: Int32Zero)] ifFalse: [count = 1 ifTrue: [mySimple _ IntegerRegion after: (edges integerVarAt: Int32Zero)] ifFalse: [mySimple _ IntegerRegion make: (edges integerVarAt: Int32Zero) with: (edges integerVarAt: 1)]]]! create: edges {IntegerVarArray} with: index {UInt32} with: count {UInt32} with: leftBounded {BooleanVar} with: simple {IntegerRegion} super create. myEdges _ edges. myIndex _ index. myCount _ count. isLeftBounded _ leftBounded. mySimple _ simple! ! !IntegerSimpleRegionStepper methodsFor: 'create'! {Stepper} copy ^IntegerSimpleRegionStepper create: myEdges with: myIndex with: myCount with: isLeftBounded with: mySimple! ! !IntegerSimpleRegionStepper methodsFor: 'printing'! {void} printOn: oo {ostream reference} oo << self getCategory name << '('. self hasValue ifTrue: [oo << self fetch]. oo << ')'! !Heaper subclass: #Joint instanceVariableNames: ' myUnioned {XnRegion} myIntersected {XnRegion}' classVariableNames: '' poolDictionaries: '' category: 'Xanadu-filter'! Joint comment: 'Joints are used to prune searches through trees of Regions. Each Joint summarizes the Joints and Regions at its node and its children using their intersection and union. If you maintain this information at each each node in the tree, then you can search for Regions in the tree efficiently using Filter::pass() to adapt the search criteria to the contents of the subtree. See also Filter::pass(Joint *).'! (Joint getOrMakeCxxClassDescription) attributes: ((Set new) add: #CONCRETE; add: #COPY; yourself)! !Joint methodsFor: 'creation'! create: unioned {XnRegion} with: intersected{XnRegion} super create. myUnioned _ unioned. myIntersected _ intersected.! ! !Joint methodsFor: 'printing'! {void} printOn: oo {ostream reference} oo << self getCategory name << '(union: ' << myUnioned << '; intersected: ' << myIntersected << ')'! ! !Joint methodsFor: 'accessing'! {XnRegion INLINE} intersected "The intersection of the regions at all child nodes in the tree." ^myIntersected! {Joint INLINE} join: other {Joint} "A Joint that is a parent of this Joint and the given one." ^Joint make.Joint: self with: other! {XnRegion INLINE} unioned "The union of the regions at all child nodes in the tree." ^myUnioned! {Joint} with: region {XnRegion} "A Joint that is a parent of this one and the given region." ^Joint make.XnRegion: (myUnioned unionWith: region) with: (myIntersected intersect: region)! ! !Joint methodsFor: 'testing'! {UInt32} actualHashForEqual ^myUnioned hashForEqual + myIntersected hashForEqual! {BooleanVar} isEqual: other {Heaper} other cast: Joint into: [:o {Joint} | ^(myUnioned isEqual: o unioned) and: [myIntersected isEqual: o intersected]] others: [^false]. ^false "fodder"! ! !Joint methodsFor: 'generated:'! create.Rcvr: receiver {Rcvr} super create.Rcvr: receiver. myUnioned _ receiver receiveHeaper. myIntersected _ receiver receiveHeaper.! {void} sendSelfTo: xmtr {Xmtr} super sendSelfTo: xmtr. xmtr sendHeaper: myUnioned. xmtr sendHeaper: myIntersected.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Joint class instanceVariableNames: ''! (Joint getOrMakeCxxClassDescription) attributes: ((Set new) add: #CONCRETE; add: #COPY; yourself)! !Joint class methodsFor: 'pseudo constructors'! make.CoordinateSpace: space {CoordinateSpace} "An empty Joint in the given coordinate space." ^Joint create: space emptyRegion with: space fullRegion! make.Joint: left {Joint} with: right {Joint} "A joint that is a parent of the two given Joints." ^Joint create: (left unioned unionWith: right unioned) with: (left intersected intersect: right intersected)! make.ScruSet: subs {ScruSet of: Joint} "A Joint that is a parent of all of the Joints in the set." | unioned {XnRegion} intersected {XnRegion} subStepper {Stepper} | subStepper _ subs stepper. unioned _ (subStepper get cast: Joint) unioned. intersected _ (subStepper fetch cast: Joint) intersected. subStepper step. subStepper forEach: [ :sub {Joint} | unioned _ unioned unionWith: sub unioned. intersected _ intersected intersect: sub intersected]. ^Joint create: unioned with: intersected! make.XnRegion: both {XnRegion} "A Joint containing only the given region." ^Joint create: both with: both! make.XnRegion: unioned {XnRegion} with: intersected {XnRegion} "A Joint with the given union and intersection regions." ^Joint create: unioned with: intersected! ! !Joint class methodsFor: 'smalltalk: smalltalk defaults'! make: something (something isKindOf: XnRegion) ifTrue: [^self make.XnRegion: something]. (something isKindOf: CoordinateSpace) ifTrue: [^self make.CoordinateSpace: something]. ^self make.ScruSet: (something cast: ScruSet)! make: something with: other (something isKindOf: Joint) ifTrue: [^self make.Joint: something with: other]. ^self make.XnRegion: (something cast: XnRegion) with: other! !Heaper subclass: #Mapping instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Xanadu-Spaces-Basic'! Mapping comment: 'A mapping is a general mapping from one coordinate space to another, with few of the guarantees provided by Dsps. In particular, the source and destination coordinate spaces can be different, and the mapping doesn''t have to be everywhere defined (but it has to say where it is defined via "domain" and "range" messages). A mapping doesn''t have to be unique--the same domain position may map to multiple range positions and vice versa. A mapping of a XuRegion must yield another XuRegion, but a mapping of a simple region doesn''t have to yield a simple region. A useful and valid way to think of a Mapping is as a (possibly infinite) set of pairs (a mathematical set, not a ScruSet). The domain region consists of the first elements of each pair, and the range region consists of the second elements. A mapping is most useful as a representation of a version comparison of two different organizations of common elements. The mapping would tell how positions in one organization correspond to positions in the other.'! (Mapping getOrMakeCxxClassDescription) friends: '/* friends for class Mapping */ friend void storeMapping (Mapping *, MuSet *); friend class SimpleMapping; '; attributes: ((Set new) add: #ON.CLIENT; add: #DEFERRED; yourself)! !Mapping methodsFor: 'accessing'! {CoordinateSpace} coordinateSpace "the coordinate space of the domain of the Mapping" self subclassResponsibility! {XnRegion CLIENT} domain "Essential. region in which it is valid." self subclassResponsibility! {CoordinateSpace CLIENT INLINE} domainSpace "The coordinate space of the domain of the Mapping" ^self coordinateSpace! {Dsp | NULL} fetchDsp "if this is a Dsp or a Dsp retricted to some domain, return the underlying Dsp. Otherwise NULL." self subclassResponsibility! {BooleanVar CLIENT} isComplete "Essential. Return true if each Position in the domain is mapped to every Position in the range." Ravi thingToDo. "Decide what to do if it is not simple enough" self subclassResponsibility! {BooleanVar CLIENT} isIdentity "Essential. True if this is the identify mapping on the entire space." Ravi thingToDo. "Decide about domain" self subclassResponsibility! {XnRegion CLIENT} range "Essential. region in which inverse is valid. Same as the region that the domain region maps to. For you mathematicians, it is the image of the domain under the mapping." self subclassResponsibility! {CoordinateSpace CLIENT} rangeSpace "The coordinate space of the range of the transformation" self subclassResponsibility! {ImmuSet of: Mapping} simpleMappings "return a set of simple mappings that would combine to this one" self subclassResponsibility! {ImmuSet of: Mapping} simpleRegionMappings "return a set of mappings with simple regions as their domains that would combine to this one." self subclassResponsibility! {Stepper CLIENT of: Mapping} simplerMappings "Essential. Break this Mapping up into simpler Mappings which can be combined together to get this one." ^self simpleMappings stepper! {Mapping CLIENT} unrestricted "Essential. If this is a 'simpler' Mapping, and not isFull, then return a yet simpleMapping of some class from which you can get more information. Note that m->restrict (region)->unrestricted () is not necessarily the same as m, since information may be lost." self fetchDsp == NULL ifTrue: [Heaper BLAST: #NotSimpleEnough]. ^self fetchDsp! ! !Mapping methodsFor: 'mapping'! {Position} inverseOf: after {Position} "Inverse transform a position. Must BLAST if there isn't a unique inverse. 'a->isEqual (this->of (b))' iff 'b->isEqual (this->inverseOf (a))'." self subclassResponsibility! {XnRegion} inverseOfAll: after {XnRegion} "Inverse transform of a region. 'a->isEqual (this->of (b))' iff 'b->isEqual (this->inverseOf (a))'." self subclassResponsibility! {IntegerVar} inverseOfInt: pos {IntegerVar} "Unboxed version of 'this->inverseOf (xuInteger(pos))'. See discussion in the XuInteger class comment about boxed and unboxed protocols" ^((self inverseOf: pos integer) cast: IntegerPos) asIntegerVar! {Position CLIENT} of: before {Position} "Transform a position. 'before' must be a Position of my domain space. Iff 'before' is in the domain region over which I am defined and it maps to a unique range Position then the result will be that Position. Otherwise BLAST. For example, if I map 1 to 4, 1 to 5, and 2 to 5 (and nothing else), then this method will yield 5 given 2, but BLAST given anything else. To find all the values 1 maps to, use the 'ofAll' operation on the singleton region whose member is 1." self subclassResponsibility! {XnRegion CLIENT} ofAll: before {XnRegion} "Essential. Transform a region. The result region has exactly those positions which are the mappings of the positions in 'before'. This must be the case even if these positions cannot be enumerated. If the mapping for a given position is multiply defined, then (if that position is in 'before') all position it maps to must be in the result. Because of this property, the behavior of this method must be taken as really defining the nature of a particular mapping (with other method's behavior being defined in terms of this one), despite the fact that it would have been more natural to take Mapping::of(Position *) as the defining behavior." self subclassResponsibility! {IntegerVar} ofInt: pos {IntegerVar} "Unboxed version of 'this->of (xuInteger(pos))'. See discussion in the XuInteger class comment about boxed and unboxed protocols" ^ ((self of: pos integer) quickCast: IntegerPos) asIntegerVar! ! !Mapping methodsFor: 'operations'! {Mapping} appliedAfter: dsp {Dsp} "Defined by the equivalence: M->transformedBy(D)->of(R) isEqual (M->of(D->of(R))) for all regions R in the domainSpace of M. Equivalent to Dsp::compose, except that it is between a Mapping and a Dsp." self subclassResponsibility! {Mapping CLIENT} combine: other {Mapping} "Essential. Result will do both mine and other's mappings. It will do my mapping where I am defined, and it will do the other's where his is defined. If we are both defined over some domain positions, then the result is a multi-valued mapping. If you think of a Mapping simply as a set of pairs (see class comment), then 'combine' yields a Mapping consisting of the union of these two sets." | result {Mapping} | result _ self fetchCombine: other. result ~~ NULL ifTrue: [^result]. result _ other fetchCombine: self. result ~~ NULL ifTrue: [^result] ifFalse: [| set {MuSet of: Mapping} | set _ MuSet make. set store: self. set store: other. ^CompositeMapping privateMakeMapping: self domainSpace with: self rangeSpace with: set asImmuSet]! {Mapping CLIENT} inverse "Essential. Return the inverse of this transformation. Considering the Mapping as a set of pairs (see class comment), return the Dsp which has the mirror image of all my pairs." self subclassResponsibility! {Mapping} preCompose: dsp {Dsp} "There is no sensible explanation for what this message does on Mappings which aren't Dsps. In the future, we will probably retire this message, so don't use it." self subclassResponsibility! {Mapping CLIENT} restrict: region {XnRegion} "Essential. Restrict the domain. The domain of the result will be the intersection of my domain and 'region'. Otherwise we are the same." self subclassResponsibility! {Mapping} restrictRange: region {XnRegion} "Restrict the range. The range of the result will be the intersection of my range and 'region'. Otherwise we are the same." self subclassResponsibility! {Mapping} transformedBy: dsp {Dsp} "Defined by the equivalence: M->transformedBy(D)->of(R) isEqual (D->of(M->of(R))) for all regions R in the domainSpace of M. Equivalent to Dsp::preCompose, except that it is between a Mapping and a Dsp." self subclassResponsibility! ! !Mapping methodsFor: 'vulnerable: accessing'! {Mapping} fetchCombine: mapping {Mapping} "if I know how to combine the two into a single mapping, then I do so" self subclassResponsibility! ! !Mappin