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

smalltalk: Stream hierarchy + 21 tests; test.sh timeout 60s -> 180s
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 12:02:37 +00:00
parent 496447ae36
commit 47249900f2
4 changed files with 255 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files

92
lib/smalltalk/runtime.sx
View File

@@ -587,6 +587,98 @@
i := i + 1].
^ self"))
(st-class-define! "IdentityDictionary" "Dictionary" (list))
;; ── Stream hierarchy ──
;; Streams wrap a collection with a 0-based `position`. Read/peek
;; advance via `at:` (1-indexed Smalltalk-style) on the collection.
;; Write streams require a mutable collection (Array works; String
;; doesn't, see Phase 5 follow-up).
(st-class-define! "Stream" "Object" (list))
(st-class-define! "PositionableStream" "Stream" (list "collection" "position"))
(st-class-define! "ReadStream" "PositionableStream" (list))
(st-class-define! "WriteStream" "PositionableStream" (list))
(st-class-define! "ReadWriteStream" "WriteStream" (list))
(st-class-add-class-method! "ReadStream" "on:"
(st-parse-method "on: aColl ^ super new on: aColl"))
(st-class-add-class-method! "WriteStream" "on:"
(st-parse-method "on: aColl ^ super new on: aColl"))
(st-class-add-class-method! "WriteStream" "with:"
(st-parse-method
"with: aColl
| s |
s := super new on: aColl.
s setToEnd.
^ s"))
(st-class-add-class-method! "ReadWriteStream" "on:"
(st-parse-method "on: aColl ^ super new on: aColl"))
(st-class-add-method! "PositionableStream" "on:"
(st-parse-method
"on: aColl collection := aColl. position := 0. ^ self"))
(st-class-add-method! "PositionableStream" "atEnd"
(st-parse-method "atEnd ^ position >= collection size"))
(st-class-add-method! "PositionableStream" "position"
(st-parse-method "position ^ position"))
(st-class-add-method! "PositionableStream" "position:"
(st-parse-method "position: n position := n. ^ self"))
(st-class-add-method! "PositionableStream" "reset"
(st-parse-method "reset position := 0. ^ self"))
(st-class-add-method! "PositionableStream" "setToEnd"
(st-parse-method "setToEnd position := collection size. ^ self"))
(st-class-add-method! "PositionableStream" "contents"
(st-parse-method "contents ^ collection"))
(st-class-add-method! "PositionableStream" "skip:"
(st-parse-method "skip: n position := position + n. ^ self"))
(st-class-add-method! "ReadStream" "next"
(st-parse-method
"next
self atEnd ifTrue: [^ nil].
position := position + 1.
^ collection at: position"))
(st-class-add-method! "ReadStream" "peek"
(st-parse-method
"peek
self atEnd ifTrue: [^ nil].
^ collection at: position + 1"))
(st-class-add-method! "ReadStream" "upToEnd"
(st-parse-method
"upToEnd
| result |
result := Array new: 0.
[self atEnd] whileFalse: [result add: self next].
^ result"))
(st-class-add-method! "ReadStream" "next:"
(st-parse-method
"next: n
| result i |
result := Array new: 0.
i := 0.
[(i < n) and: [self atEnd not]] whileTrue: [
result add: self next.
i := i + 1].
^ result"))
(st-class-add-method! "WriteStream" "nextPut:"
(st-parse-method
"nextPut: anObject
collection add: anObject.
position := position + 1.
^ anObject"))
(st-class-add-method! "WriteStream" "nextPutAll:"
(st-parse-method
"nextPutAll: aCollection
aCollection do: [:e | self nextPut: e].
^ aCollection"))
;; ReadWriteStream inherits from WriteStream + ReadStream behaviour;
;; for the simple linear-position model, both nextPut: and next work.
(st-class-add-method! "ReadWriteStream" "next"
(st-parse-method
"next
self atEnd ifTrue: [^ nil].
position := position + 1.
^ collection at: position"))
(st-class-add-method! "ReadWriteStream" "peek"
(st-parse-method
"peek
self atEnd ifTrue: [^ nil].
^ collection at: position + 1"))
"ok")))
;; Initialise on load. Tests can re-bootstrap to reset state.