coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions 8 Packages Projects Releases Wiki Activity

smalltalk: HashedCollection/Set/Dictionary/IdentityDictionary + 29 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Details

Browse Source
This commit is contained in:
giles
2026-04-25 11:27:00 +00:00
parent 3be722d5b6
commit 496447ae36
4 changed files with 330 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
lib/smalltalk/eval.sx
View File

@@ -855,6 +855,8 @@
(fn (e) (st-block-apply (nth args 0) (list e)))
a)
a))
((= selector "add:")
(begin (append! a (nth args 0)) (nth args 0)))
((= selector "collect:")
(map (fn (e) (st-block-apply (nth args 0) (list e))) a))
((= selector "select:")

111
lib/smalltalk/runtime.sx
View File

@@ -378,7 +378,9 @@
(st-class-define! "String" "ArrayedCollection" (list))
(st-class-define! "Symbol" "String" (list))
(st-class-define! "OrderedCollection" "SequenceableCollection" (list "array" "firstIndex" "lastIndex"))
(st-class-define! "Dictionary" "Collection" (list))
;; Hashed collection family
(st-class-define! "HashedCollection" "Collection" (list "array"))
(st-class-define! "Set" "HashedCollection" (list))
;; Blocks / contexts
(st-class-define! "BlockClosure" "Object" (list))
;; Reflection support — Message holds the selector/args for a DNU send.
@@ -478,6 +480,113 @@
(st-parse-method "notEmpty ^ self size > 0"))
(st-class-add-method! "SequenceableCollection" "asString"
(st-parse-method "asString ^ self printString"))
;; ── HashedCollection / Set / Dictionary ──
;; Implemented as user instances with array-backed storage. Sets
;; use a single `array` ivar; Dictionaries use parallel `keys`/
;; `values` arrays. New is class-side and routes through `init`.
(st-class-add-method! "HashedCollection" "init"
(st-parse-method "init array := Array new: 0. ^ self"))
(st-class-add-method! "HashedCollection" "size"
(st-parse-method "size ^ array size"))
(st-class-add-method! "HashedCollection" "isEmpty"
(st-parse-method "isEmpty ^ array isEmpty"))
(st-class-add-method! "HashedCollection" "notEmpty"
(st-parse-method "notEmpty ^ array notEmpty"))
(st-class-add-method! "HashedCollection" "do:"
(st-parse-method "do: aBlock array do: aBlock. ^ self"))
(st-class-add-method! "HashedCollection" "asArray"
(st-parse-method "asArray ^ array"))
(st-class-add-class-method! "Set" "new"
(st-parse-method "new ^ super new init"))
(st-class-add-method! "Set" "add:"
(st-parse-method
"add: anObject
(self includes: anObject) ifFalse: [array add: anObject].
^ anObject"))
(st-class-add-method! "Set" "addAll:"
(st-parse-method
"addAll: aCollection
aCollection do: [:e | self add: e].
^ aCollection"))
(st-class-add-method! "Set" "remove:"
(st-parse-method
"remove: anObject
array := array reject: [:e | e = anObject].
^ anObject"))
(st-class-add-method! "Set" "includes:"
(st-parse-method "includes: anObject ^ array includes: anObject"))
(st-class-define! "Dictionary" "HashedCollection" (list "keys" "values"))
(st-class-add-class-method! "Dictionary" "new"
(st-parse-method "new ^ super new init"))
(st-class-add-method! "Dictionary" "init"
(st-parse-method
"init keys := Array new: 0. values := Array new: 0. ^ self"))
(st-class-add-method! "Dictionary" "size"
(st-parse-method "size ^ keys size"))
(st-class-add-method! "Dictionary" "isEmpty"
(st-parse-method "isEmpty ^ keys isEmpty"))
(st-class-add-method! "Dictionary" "notEmpty"
(st-parse-method "notEmpty ^ keys notEmpty"))
(st-class-add-method! "Dictionary" "keys"
(st-parse-method "keys ^ keys"))
(st-class-add-method! "Dictionary" "values"
(st-parse-method "values ^ values"))
(st-class-add-method! "Dictionary" "at:"
(st-parse-method
"at: aKey
| i |
i := keys indexOf: aKey.
i = 0 ifTrue: [^ nil].
^ values at: i"))
(st-class-add-method! "Dictionary" "at:ifAbsent:"
(st-parse-method
"at: aKey ifAbsent: aBlock
| i |
i := keys indexOf: aKey.
i = 0 ifTrue: [^ aBlock value].
^ values at: i"))
(st-class-add-method! "Dictionary" "at:put:"
(st-parse-method
"at: aKey put: aValue
| i |
i := keys indexOf: aKey.
i = 0
ifTrue: [keys add: aKey. values add: aValue]
ifFalse: [values at: i put: aValue].
^ aValue"))
(st-class-add-method! "Dictionary" "includesKey:"
(st-parse-method "includesKey: aKey ^ (keys indexOf: aKey) > 0"))
(st-class-add-method! "Dictionary" "removeKey:"
(st-parse-method
"removeKey: aKey
| i nk nv j |
i := keys indexOf: aKey.
i = 0 ifTrue: [^ nil].
nk := Array new: 0. nv := Array new: 0.
j := 1.
[j <= keys size] whileTrue: [
j = i ifFalse: [
nk add: (keys at: j).
nv add: (values at: j)].
j := j + 1].
keys := nk. values := nv.
^ aKey"))
(st-class-add-method! "Dictionary" "do:"
(st-parse-method "do: aBlock values do: aBlock. ^ self"))
(st-class-add-method! "Dictionary" "keysDo:"
(st-parse-method "keysDo: aBlock keys do: aBlock. ^ self"))
(st-class-add-method! "Dictionary" "valuesDo:"
(st-parse-method "valuesDo: aBlock values do: aBlock. ^ self"))
(st-class-add-method! "Dictionary" "keysAndValuesDo:"
(st-parse-method
"keysAndValuesDo: aBlock
| i |
i := 1.
[i <= keys size] whileTrue: [
aBlock value: (keys at: i) value: (values at: i).
i := i + 1].
^ self"))
(st-class-define! "IdentityDictionary" "Dictionary" (list))
"ok")))
;; Initialise on load. Tests can re-bootstrap to reset state.

216
lib/smalltalk/tests/hashed.sx Normal file
View File

@@ -0,0 +1,216 @@
;; HashedCollection / Set / Dictionary / IdentityDictionary tests.
;; These are user classes implemented in `runtime.sx` with array-backed
;; storage. Set: single ivar `array`. Dictionary: parallel `keys`/`values`.
(set! st-test-pass 0)
(set! st-test-fail 0)
(set! st-test-fails (list))
(st-bootstrap-classes!)
(define ev (fn (src) (smalltalk-eval src)))
(define evp (fn (src) (smalltalk-eval-program src)))
;; ── 1. Class hierarchy ──
(st-test "Set < HashedCollection" (st-class-inherits-from? "Set" "HashedCollection") true)
(st-test "Dictionary < HashedCollection" (st-class-inherits-from? "Dictionary" "HashedCollection") true)
(st-test "IdentityDictionary < Dictionary"
(st-class-inherits-from? "IdentityDictionary" "Dictionary") true)
;; ── 2. Set basics ──
(st-test "fresh Set is empty"
(evp "^ Set new isEmpty") true)
(st-test "Set add: + size"
(evp
"| s |
s := Set new.
s add: 1. s add: 2. s add: 3.
^ s size")
3)
(st-test "Set add: deduplicates"
(evp
"| s |
s := Set new.
s add: 1. s add: 1. s add: 1.
^ s size")
1)
(st-test "Set includes: found"
(evp
"| s | s := Set new. s add: #a. s add: #b. ^ s includes: #a")
true)
(st-test "Set includes: missing"
(evp
"| s | s := Set new. s add: #a. ^ s includes: #z")
false)
(st-test "Set remove: drops the element"
(evp
"| s |
s := Set new.
s add: 1. s add: 2. s add: 3.
s remove: 2.
^ s includes: 2")
false)
(st-test "Set remove: keeps the others"
(evp
"| s |
s := Set new.
s add: 1. s add: 2. s add: 3.
s remove: 2.
^ s size")
2)
(st-test "Set do: iterates"
(evp
"| s sum |
s := Set new.
s add: 1. s add: 2. s add: 3.
sum := 0.
s do: [:e | sum := sum + e].
^ sum")
6)
(st-test "Set addAll: with an Array"
(evp
"| s |
s := Set new.
s addAll: #(1 2 3 2 1).
^ s size")
3)
;; ── 3. Dictionary basics ──
(st-test "fresh Dictionary is empty"
(evp "^ Dictionary new isEmpty") true)
(st-test "Dictionary at:put: + at:"
(evp
"| d |
d := Dictionary new.
d at: #a put: 1.
d at: #b put: 2.
^ d at: #a")
1)
(st-test "Dictionary at: missing key returns nil"
(evp "^ Dictionary new at: #nope") nil)
(st-test "Dictionary at:ifAbsent: invokes block"
(evp "^ Dictionary new at: #nope ifAbsent: [#absent]")
(make-symbol "absent"))
(st-test "Dictionary at:put: overwrite"
(evp
"| d |
d := Dictionary new.
d at: #x put: 1.
d at: #x put: 99.
^ d at: #x")
99)
(st-test "Dictionary size after several puts"
(evp
"| d |
d := Dictionary new.
d at: #a put: 1. d at: #b put: 2. d at: #c put: 3.
^ d size")
3)
(st-test "Dictionary includesKey: found"
(evp
"| d | d := Dictionary new. d at: #a put: 1. ^ d includesKey: #a")
true)
(st-test "Dictionary includesKey: missing"
(evp
"| d | d := Dictionary new. d at: #a put: 1. ^ d includesKey: #z")
false)
(st-test "Dictionary removeKey:"
(evp
"| d |
d := Dictionary new.
d at: #a put: 1. d at: #b put: 2. d at: #c put: 3.
d removeKey: #b.
^ d size")
2)
(st-test "Dictionary removeKey: drops only that key"
(evp
"| d |
d := Dictionary new.
d at: #a put: 1. d at: #b put: 2. d at: #c put: 3.
d removeKey: #b.
^ d at: #a")
1)
;; ── 4. Dictionary iteration ──
(st-test "Dictionary do: yields values"
(evp
"| d sum |
d := Dictionary new.
d at: #a put: 1. d at: #b put: 2. d at: #c put: 3.
sum := 0.
d do: [:v | sum := sum + v].
^ sum")
6)
(st-test "Dictionary keysDo: yields keys"
(evp
"| d log |
d := Dictionary new.
d at: #a put: 1. d at: #b put: 2.
log := #().
d keysDo: [:k | log := log , (Array with: k)].
^ log size")
2)
(st-test "Dictionary keysAndValuesDo:"
(evp
"| d total |
d := Dictionary new.
d at: #a put: 10. d at: #b put: 20.
total := 0.
d keysAndValuesDo: [:k :v | total := total + v].
^ total")
30)
;; Helper used by some tests above:
(st-class-add-class-method! "Array" "with:"
(st-parse-method "with: x | a | a := Array new: 1. a at: 1 put: x. ^ a"))
(st-test "Dictionary keys returns Array"
(sort
(evp
"| d | d := Dictionary new.
d at: #x put: 1. d at: #y put: 2. d at: #z put: 3.
^ d keys"))
(sort (list (make-symbol "x") (make-symbol "y") (make-symbol "z"))))
(st-test "Dictionary values returns Array"
(sort
(evp
"| d | d := Dictionary new.
d at: #x put: 100. d at: #y put: 200.
^ d values"))
(sort (list 100 200)))
;; ── 5. Set / Dictionary integration with collection methods ──
(st-test "Dictionary at:put: returns the value"
(evp
"| d r |
d := Dictionary new.
r := d at: #a put: 42.
^ r")
42)
(st-test "Set has its class"
(evp "^ Set new class name") "Set")
(st-test "Dictionary has its class"
(evp "^ Dictionary new class name") "Dictionary")
(list st-test-pass st-test-fail)

3
plans/smalltalk-on-sx.md
View File

@@ -88,7 +88,7 @@ Core mapping:
### Phase 5 — collections + numeric tower
- [x] `SequenceableCollection`/`OrderedCollection`/`Array`/`String`/`Symbol`. Bootstrap installs shared methods on `SequenceableCollection`: `inject:into:`, `detect:`/`detect:ifNone:`, `count:`, `allSatisfy:`/`anySatisfy:`, `includes:`, `do:separatedBy:`, `indexOf:`/`indexOf:ifAbsent:`, `reject:`, `isEmpty`/`notEmpty`, `asString`. They each call `self do:`, which dispatches to the receiver's primitive `do:` — so Array, String, and Symbol inherit them uniformly. String/Symbol primitives gained `at:` (1-indexed), `copyFrom:to:`, `first`/`last`, `do:`. OrderedCollection class is in the bootstrap hierarchy; its instance shape will fill out alongside Set/Dictionary in the next box. 28 tests in `lib/smalltalk/tests/collections.sx`.
- [ ] `HashedCollection`/`Set`/`Dictionary`/`IdentityDictionary`
- [x] `HashedCollection`/`Set`/`Dictionary`/`IdentityDictionary`. Implemented as user classes in `runtime.sx`. `HashedCollection` carries a single `array` ivar; `Dictionary` overrides with parallel `keys`/`values`. Set: `add:` (dedup), `addAll:`, `remove:`, `includes:`, `do:`, `size`, `asArray`. Dictionary: `at:`, `at:ifAbsent:`, `at:put:`, `includesKey:`, `removeKey:`, `keys`, `values`, `do:`, `keysDo:`, `valuesDo:`, `keysAndValuesDo:`, `size`, `isEmpty`. `IdentityDictionary` defined as a Dictionary subclass (no methods of its own yet — equality and identity diverge in a follow-up). Class-side `new` calls `super new init`. Added Array primitive `add:` (append). 29 tests in `lib/smalltalk/tests/hashed.sx`.
- [ ] `Stream` hierarchy: `ReadStream`/`WriteStream`/`ReadWriteStream`
- [ ] `Number` tower: `SmallInteger`/`LargePositiveInteger`/`Float`/`Fraction`
- [ ] `String>>format:`, `printOn:` for everything
@@ -108,6 +108,7 @@ Core mapping:
_Newest first. Agent appends on every commit._
- 2026-04-25: HashedCollection / Set / Dictionary / IdentityDictionary + 29 tests (`lib/smalltalk/tests/hashed.sx`). Set: dedup add:, remove:, includes:, do:, addAll:. Dictionary: parallel keys/values backing; at:put:, at:ifAbsent:, includesKey:, removeKey:, keysDo:, keysAndValuesDo:. Class-side `new` chains `super new init`. Array primitive `add:` added. 552/552 total.
- 2026-04-25: Phase 5 sequenceable-collection methods + 28 tests (`lib/smalltalk/tests/collections.sx`). 13 shared methods on `SequenceableCollection` (inject:into:, detect:, count:, …), inherited by Array/String/Symbol via `self do:`. String primitives at:/copyFrom:to:/first/last/do:. 523/523 total.
- 2026-04-25: Exception system + 15 tests (`lib/smalltalk/tests/exceptions.sx`). Exception/Error/ZeroDivide/MessageNotUnderstood in bootstrap; signal/signal: raise via SX `raise`; on:do:/ensure:/ifCurtailed: on BlockClosure via SX `guard`. Phase 4 complete. 495/495 total.
- 2026-04-25: `Object>>becomeForward:` + 6 tests. In-place mutation of `:class` and `:ivars` via `dict-set!`; aliases see the new identity. 480/480 total.