8 Commits 346447e15e ... 45563d44b6

Author SHA1 Message Date
  Herbert Vojčík 45563d44b6 Extract common code to Axes class-side helpers. 6 years ago
  Herbert Vojčík df953a730b Axes ext methods in JSObjectProxy as well. 6 years ago
  Herbert Vojčík 9fc55e9ccb Refactor Axon and SimpleAxon. 6 years ago
  Herbert Vojčík fb1ec7b8f5 Refactor former registerIn:. 6 years ago
  Herbert Vojčík 84be616bc5 PluggableInterest, related simplifications. 6 years ago
  Herbert Vojčík 9e2859db67 No need for DumbAxon. 6 years ago
  Herbert Vojčík 09fc7d8192 Make AxonInterest more generic. 6 years ago
  Herbert Vojčík 6ac9e12684 README: Axes. 6 years ago
5 changed files with 847 additions and 298 deletions
  1. 14 14
      README.md
  2. 14 16
      src/Axxord-Tests.js
  3. 2 2
      src/Axxord-Tests.st
  4. 660 178
      src/Axxord.js
  5. 157 88
      src/Axxord.st

+ 14 - 14
README.md

@@ -3,18 +3,19 @@ Axxord
 
 Small blackboard system for Amber Smalltalk.
 
-Legacy Lyst README follows:
+Axes
+----
 
-Get / set hierarchical data using array-like indexes.
+Axes is hierarchical index used to access blackboard data.
 
-The Lyst index (aka yndex) an array of elements: either strings, numbers
+Axes is an array of elements: either strings, numbers
 or a sub-arrays. These are used to denote the (relative) location
 of a piece of data in a hierarchical object, and is used to read or write
 from / to this position.
 
 Elements of a path are equivalent to elements of paths in classic file systems:
 each elements is one step deeper in a tree hierarchy. Thus, to read a data denoted
-by a path, Lyst starts from actual position, reads the contents denoted by first element,
+by a path, Axes starts from actual position, reads the contents denoted by first element,
 use the result to read the contents denoted by second elements etc. until the end.
 To write the data, the algorithm is similar to reading one, byt the last element is used
 to write the data instead.
@@ -26,16 +27,15 @@ to write the data instead.
  - if _subarray_ path element `#(bar)` is read from _foo_, `foo bar` is performed;
  - if _subarray_ path element `#(bar)` is written to _foo_, `foo bar: value` is performed.
 
-API
-----
+###API
 
 ----
 
 ```st
-Object >> atLyst: aCollection ifAbsent: aBlock
+Object >> atAxes: aCollection ifAbsent: aBlock
 ```
 
-For example `container atLyst: #((todos) 1 done) ifAbsent: [...]'` essentially does
+For example `container atAxes: #((todos) 1 done) ifAbsent: [...]'` essentially does
 
 	| x |
 	x := container todos at: 1.
@@ -54,10 +54,10 @@ the `ifAbsent` block value is returned.
 ----
 
 ```st
-Object >> atLyst: aCollection ifAbsent: aBlock put: anObject
+Object >> atAxes: aCollection ifAbsent: aBlock put: anObject
 ```
 
-For example `container atLyst: #((todos) 1 done) ifAbsent: [...] put: 'foo'` essentially does
+For example `container atAxes: #((todos) 1 done) ifAbsent: [...] put: 'foo'` essentially does
 
 	| x |
 	x := container todos at: 1.
@@ -75,16 +75,16 @@ the `ifAbsent` block value is returned.
 ----
 
 ```st
-Lyst class >> parse: aString
+Axes class >> parse: aString
 ```
 
-Parses a string to get a proper array index to use with `atLyst:` API.
+Parses a string to get a proper array index to use with `atAxes:` API.
 
 The syntax is resembling Smalltalk literal array syntax very closely.
-For example `Lyst parse: '(value)'` and `Lyst parse: '(todos) 1 done'`
+For example `Axes parse: '(value)'` and `Axes parse: '(todos) 1 done'`
 produce `#((value))` and `#((todos) 1 done)` as results.
 
 Syntactic sugar: as `(foo)` happens often, to denote unary selector,
 it can be written equivalently as `~foo`, to improve readability.
-So above Lyst indexes' parseable string representation
+So above Axes' parseable string representation
 would likely be written `'~value'` and `'~todos 1 done'` instead.

+ 14 - 16
src/Axxord-Tests.js

@@ -624,7 +624,7 @@ return $core.withContext(function($ctx1) {
 result=nil;
 model=$globals.HashedCollection._newFromPairs_(["foo",["bar", [(1), [(2), (3)]], "baz"],"moo","zoo"]);
 axon=$recv($globals.TestSpyAxon)._new();
-$recv(axon)._registerIn_(model);
+$recv(model)._axxord_(axon);
 $recv(model)._axes_transform_(["foo", (2)],(function(r){
 return "new";
 
@@ -637,10 +637,10 @@ return self;
 },
 //>>excludeStart("ide", pragmas.excludeIdeData);
 args: [],
-source: "testModelTransformSentToAxon\x0a| model result axon |\x0aresult := nil.\x0amodel := #{ 'foo' -> #('bar' #(1 #(2 3)) 'baz'). 'moo' -> 'zoo' }.\x0aaxon := TestSpyAxon new.\x0aaxon registerIn: model.\x0amodel axes: #(foo 2) transform: [:r | #new].\x0aself assert: axon changedAspectLog equals: #((foo 2))",
+source: "testModelTransformSentToAxon\x0a| model result axon |\x0aresult := nil.\x0amodel := #{ 'foo' -> #('bar' #(1 #(2 3)) 'baz'). 'moo' -> 'zoo' }.\x0aaxon := TestSpyAxon new.\x0amodel axxord: axon.\x0amodel axes: #(foo 2) transform: [:r | #new].\x0aself assert: axon changedAspectLog equals: #((foo 2))",
 referencedClasses: ["TestSpyAxon"],
 //>>excludeEnd("ide");
-messageSends: ["new", "registerIn:", "axes:transform:", "assert:equals:", "changedAspectLog"]
+messageSends: ["new", "axxord:", "axes:transform:", "assert:equals:", "changedAspectLog"]
 }),
 $globals.PlainConsumeTransformTest);
 
@@ -952,7 +952,7 @@ $globals.PlainConsumeTransformTest);
 
 
 
-$core.addClass("TestSpyAxon", $globals.DumbAxon, ["changedAspectLog"], "Axxord-Tests");
+$core.addClass("TestSpyAxon", $globals.Axon, ["changedAspectLog"], "Axxord-Tests");
 //>>excludeStart("ide", pragmas.excludeIdeData);
 $globals.TestSpyAxon.comment="I am an axon that logs changed aspects. I am useful in tests.";
 //>>excludeEnd("ide");
@@ -961,11 +961,11 @@ $core.method({
 selector: "changed:",
 protocol: "action",
 fn: function (anAspect){
-var self=this;
+var self=this,$self=this;
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
 return $core.withContext(function($ctx1) {
 //>>excludeEnd("ctx");
-$recv(self["@changedAspectLog"])._add_(anAspect);
+$recv($self["@changedAspectLog"])._add_(anAspect);
 return self;
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
 }, function($ctx1) {$ctx1.fill(self,"changed:",{anAspect:anAspect},$globals.TestSpyAxon)});
@@ -985,10 +985,8 @@ $core.method({
 selector: "changedAspectLog",
 protocol: "accessing",
 fn: function (){
-var self=this;
-var $1;
-$1=self["@changedAspectLog"];
-return $1;
+var self=this,$self=this;
+return $self["@changedAspectLog"];
 
 },
 //>>excludeStart("ide", pragmas.excludeIdeData);
@@ -1005,8 +1003,8 @@ $core.method({
 selector: "changedAspectLog:",
 protocol: "accessing",
 fn: function (anObject){
-var self=this;
-self["@changedAspectLog"]=anObject;
+var self=this,$self=this;
+$self["@changedAspectLog"]=anObject;
 return self;
 
 },
@@ -1024,19 +1022,19 @@ $core.method({
 selector: "initialize",
 protocol: "initialization",
 fn: function (){
-var self=this;
+var self=this,$self=this;
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
 return $core.withContext(function($ctx1) {
 //>>excludeEnd("ctx");
 (
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
-$ctx1.supercall = true, 
+$ctx1.supercall = true,
 //>>excludeEnd("ctx");
-$globals.TestSpyAxon.superclass.fn.prototype._initialize.apply($recv(self), []));
+($globals.TestSpyAxon.superclass||$boot.nilAsClass).fn.prototype._initialize.apply($self, []));
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
 $ctx1.supercall = false;
 //>>excludeEnd("ctx");;
-self["@changedAspectLog"]=[];
+$self["@changedAspectLog"]=[];
 return self;
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
 }, function($ctx1) {$ctx1.fill(self,"initialize",{},$globals.TestSpyAxon)});

+ 2 - 2
src/Axxord-Tests.st

@@ -146,7 +146,7 @@ testModelTransformSentToAxon
 result := nil.
 model := #{ 'foo' -> #('bar' #(1 #(2 3)) 'baz'). 'moo' -> 'zoo' }.
 axon := TestSpyAxon new.
-axon registerIn: model.
+model axxord: axon.
 model axes: #(foo 2) transform: [:r | #new].
 self assert: axon changedAspectLog equals: #((foo 2))
 !
@@ -216,7 +216,7 @@ model := #(2 #(1 0)).
 self should: [model axes: #() transform: [:r | #new]] raise: Error
 ! !
 
-DumbAxon subclass: #TestSpyAxon
+Axon subclass: #TestSpyAxon
 	instanceVariableNames: 'changedAspectLog'
 	package: 'Axxord-Tests'!
 !TestSpyAxon commentStamp!

File diff suppressed because it is too large
+ 660 - 178
src/Axxord.js


+ 157 - 88
src/Axxord.st

@@ -3,6 +3,50 @@ Object subclass: #Axes
 	instanceVariableNames: ''
 	package: 'Axxord'!
 
+!Axes class methodsFor: 'delegated'!
+
+on: anObject at: aCollection consume: aBlock
+	| value |
+	value := anObject atAxes: aCollection ifAbsent: [ ^ anObject ].
+	^ aBlock value: value
+!
+
+on: anObject at: aCollection ifAbsent: aBlock
+	^ aCollection inject: anObject into: [ :soFar :segment |
+		segment asAxisIn: soFar ifAbsent: [ ^ aBlock value ]]
+!
+
+on: anObject at: aCollection ifAbsent: aBlock put: value
+	| penultimate |
+	penultimate := anObject atAxes: aCollection allButLast ifAbsent: aBlock.
+	^ aCollection last asAxisIn: penultimate ifAbsent: aBlock put: value
+!
+
+on: anObject at: aCollection transform: aBlock
+	| value newValue |
+	value := anObject atAxes: aCollection ifAbsent: [ ^ anObject ].
+	newValue := aBlock value: value.
+	value == newValue ifFalse: [ anObject atAxes: aCollection ifAbsent: [ ^ anObject ] put: newValue ].
+	anObject axxord ifNotNil: [:axon | axon changed: aCollection]
+! !
+
+!Axes class methodsFor: 'factory'!
+
+newInterestThru: anAspect doing: aBlock
+	^ PluggableInterest new
+		accept: [ :aspect | aspect size <= anAspect size
+			ifTrue: [ aspect = (anAspect copyFrom: 1 to: aspect size) ]
+			ifFalse: [ anAspect = (aspect copyFrom: 1 to: anAspect size) ] ]
+		enact: aBlock
+!
+
+newInterestUpTo: anAspect doing: aBlock
+	^ PluggableInterest new
+		accept: [ :changedAspect | changedAspect size <= anAspect size and:
+			[changedAspect = (anAspect copyFrom: 1 to: changedAspect size)] ]
+		enact: aBlock
+! !
+
 !Axes class methodsFor: 'parsing'!
 
 parse: message
@@ -75,13 +119,15 @@ My subclasses must provide implementation for:
  - do:
  - clean!
 
-!Axon methodsFor: 'action'!
+!Axon methodsFor: 'accessing'!
 
 addInterest: anInterest
 	self
 		add: (anInterest flag; yourself);
 		dirty: true
-!
+! !
+
+!Axon methodsFor: 'change-update'!
 
 changed: anAspect
 	| needsToRun |
@@ -100,8 +146,24 @@ changedAll
 		each flag.
 		needsToRun := true ].
 	self dirty: needsToRun
+! !
+
+!Axon methodsFor: 'primitive ops'!
+
+add: anInterest
+	self subclassResponsibility
+!
+
+clean
+	self subclassResponsibility
 !
 
+do: aBlock
+	self subclassResponsibility
+! !
+
+!Axon methodsFor: 'private'!
+
 dirty: aBoolean
 	aBoolean ifTrue: [[ self run ] fork]
 !
@@ -112,95 +174,66 @@ run
 	    needsClean := false.
 		self do: [ :each |
 			each isFlagged ifTrue: [ each run ].
-	        each isEnabled ifFalse: [ needsClean := true ]
+	        each isClosed ifTrue: [ needsClean := true ]
 		].
     	needsClean ifTrue: [ self clean ]
 	] on: Error do: [ self dirty: true ]
 ! !
 
-!Axon methodsFor: 'injecting'!
-
-registerIn: anObject
-<inlineJS: 'anObject.$axon$=self'>
-! !
-
-Axon subclass: #DumbAxon
-	instanceVariableNames: ''
+Axon subclass: #SimpleAxon
+	instanceVariableNames: 'queue'
 	package: 'Axxord'!
-!DumbAxon commentStamp!
-I am an axon that does nothing.!
-
-!DumbAxon methodsFor: 'as yet unclassified'!
-
-add: anInterest
-	"pass"
-!
 
-clean
-	"pass"
-!
+!SimpleAxon methodsFor: 'initialization'!
 
-do: aBlock
-	"pass"
+initialize
+    super initialize.
+	queue := OrderedCollection new
 ! !
 
-Axon subclass: #SimpleAxon
-	instanceVariableNames: 'queue'
-	package: 'Axxord'!
-
-!SimpleAxon methodsFor: 'accessing'!
+!SimpleAxon methodsFor: 'primitive ops'!
 
 add: aSubscription
 	queue add: aSubscription.
-! !
-
-!SimpleAxon methodsFor: 'bookkeeping'!
+!
 
 clean
-	queue := queue select: [ :each | each isEnabled ]
-! !
-
-!SimpleAxon methodsFor: 'enumeration'!
+	queue := queue reject: [ :each | each isClosed ]
+!
 
 do: aBlock
 	queue do: aBlock
 ! !
 
-!SimpleAxon methodsFor: 'initialization'!
-
-initialize
-    super initialize.
-	queue := OrderedCollection new
-! !
-
 Object subclass: #AxonInterest
-	instanceVariableNames: 'aspect actionBlock flagged'
+	instanceVariableNames: 'flagged'
 	package: 'Axxord'!
 
 !AxonInterest methodsFor: 'accessing'!
 
-aspect: anAspect block: aBlock
-	aspect := anAspect.
-    actionBlock := aBlock
-!
-
 flag
 	flagged := true
 ! !
 
 !AxonInterest methodsFor: 'action'!
 
+close
+	self subclassResponsibility
+!
+
+enact
+	self subclassResponsibility
+!
+
 run
-	[ flagged := false. actionBlock value ]
-    on: AxonOff do: [ actionBlock := nil ]
+	[ flagged := false. self enact ]
+    on: AxonOff do: [ self close ]
 ! !
 
 !AxonInterest methodsFor: 'initialization'!
 
 initialize
 	super initialize.
-    aspect := nil.
-    actionBlock := nil.
     flagged := false.
 ! !
 
@@ -211,44 +244,51 @@ accepts: anAspect
     self subclassResponsibility
 !
 
-isEnabled
-	^actionBlock notNil
+isClosed
+	self subclassResponsibility
 !
 
 isFlagged
 	^flagged
 ! !
 
-AxonInterest subclass: #InterestedInEqual
-	instanceVariableNames: ''
+AxonInterest subclass: #PluggableInterest
+	instanceVariableNames: 'acceptBlock enactBlock'
 	package: 'Axxord'!
 
-!InterestedInEqual methodsFor: 'testing'!
+!PluggableInterest methodsFor: 'accessing'!
 
-accepts: anAspect
-    ^ anAspect = aspect
+accept: aBlock enact: anotherBlock
+	acceptBlock := aBlock.
+    enactBlock := anotherBlock
 ! !
 
-AxonInterest subclass: #InterestedThruAxes
-	instanceVariableNames: ''
-	package: 'Axxord'!
+!PluggableInterest methodsFor: 'action'!
 
-!InterestedThruAxes methodsFor: 'testing'!
+close
+	acceptBlock := nil.
+	enactBlock := nil
+!
 
-accepts: anAspect
-    ^anAspect size <= aspect size
-		ifTrue: [anAspect = (aspect copyFrom: 1 to: anAspect size)]
-		ifFalse: [aspect = (anAspect copyFrom: 1 to: aspect size)]
+enact
+	enactBlock value
 ! !
 
-AxonInterest subclass: #InterestedUpToAxes
-	instanceVariableNames: ''
-	package: 'Axxord'!
+!PluggableInterest methodsFor: 'initialization'!
 
-!InterestedUpToAxes methodsFor: 'testing'!
+initialize
+	super initialize.
+    self close
+! !
+
+!PluggableInterest methodsFor: 'testing'!
 
 accepts: anAspect
-    ^anAspect size <= aspect size and: [anAspect = (aspect copyFrom: 1 to: anAspect size)]
+    ^ acceptBlock value: anAspect
+!
+
+isClosed
+	^ acceptBlock isNil
 ! !
 
 Error subclass: #AxonOff
@@ -290,6 +330,40 @@ asAxisIn: anObject ifAbsent: aBlock put: anotherObject
 	^ result
 ! !
 
+!JSObjectProxy methodsFor: '*Axxord'!
+
+asAxisIn: anObject ifAbsent: aBlock
+	^ aBlock value
+!
+
+asAxisIn: anObject ifAbsent: aBlock put: anotherObject
+	^ aBlock value
+!
+
+atAxes: aCollection ifAbsent: aBlock
+	^ Axes on: self at: aCollection ifAbsent: aBlock
+!
+
+atAxes: aCollection ifAbsent: aBlock put: value
+	^ Axes on: self at: aCollection ifAbsent: aBlock put: value
+!
+
+axes: aCollection consume: aBlock
+	^ Axes on: self at: aCollection consume: aBlock
+!
+
+axes: aCollection transform: aBlock
+	^ Axes on: self at: aCollection transform: aBlock
+!
+
+axxord
+<inlineJS: 'return $self["@jsObject"].$axxord$'>
+!
+
+axxord: anAxon
+<inlineJS: '$self["@jsObject"].$axxord$ = anAxon'>
+! !
+
 !Number methodsFor: '*Axxord'!
 
 asAxisIn: anObject ifAbsent: aBlock
@@ -315,32 +389,27 @@ asAxisIn: anObject ifAbsent: aBlock put: anotherObject
 !
 
 atAxes: aCollection ifAbsent: aBlock
-	^ aCollection inject: self into: [ :soFar :segment |
-		segment asAxisIn: soFar ifAbsent: [ ^ aBlock value ]]
+	^ Axes on: self at: aCollection ifAbsent: aBlock
 !
 
 atAxes: aCollection ifAbsent: aBlock put: value
-	| penultimate |
-	penultimate := self atAxes: aCollection allButLast ifAbsent: aBlock.
-	^ aCollection last asAxisIn: penultimate ifAbsent: aBlock put: value
+	^ Axes on: self at: aCollection ifAbsent: aBlock put: value
 !
 
 axes: aCollection consume: aBlock
-	| value |
-	value := self atAxes: aCollection ifAbsent: [ ^self ].
-	^ aBlock value: value
+	^ Axes on: self at: aCollection consume: aBlock
 !
 
 axes: aCollection transform: aBlock
-	| value newValue |
-	value := self atAxes: aCollection ifAbsent: [ ^self ].
-	newValue := aBlock value: value.
-	value == newValue ifFalse: [ self atAxes: aCollection ifAbsent: [ ^self ] put: newValue ].
-	self registeredAxon ifNotNil: [:axon | axon changed: aCollection]
+	^ Axes on: self at: aCollection transform: aBlock
+!
+
+axxord
+<inlineJS: 'return self.$axxord$'>
 !
 
-registeredAxon
-<inlineJS: 'return self.$axon$'>
+axxord: anAxon
+<inlineJS: 'self.$axxord$ = anAxon'>
 ! !
 
 !String methodsFor: '*Axxord'!

Some files were not shown because too many files changed in this diff