Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

[PreSmalltalks] Do not rely on working primitive #perform: #298

Merged
merged 3 commits into from
Jun 26, 2024
Merged

[PreSmalltalks] Do not rely on working primitive #perform: #298

Show file tree
Hide file tree
Changes from 1 commit
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
77b2278
[PreSmalltalks] Do not rely on working primitive #perform:
shingarov Jun 21, 2024
f0aaf38
[Currying #perform] Cache numArgs in a temp because Symbol>>numArgs i…
shingarov Jun 26, 2024
cdbfb3a
[Currying #perform] Warn the programmer about inconsistent with: vs w…
shingarov Jun 26, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
42 changes: 30 additions & 12 deletions src/PreSmalltalks-Pharo/Object.extension.st
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,7 +1,35 @@
Extension { #name : #Object }

{ #category : #'*PreSmalltalks-Pharo' }
Object >> perform: aSymbol [
^ self perform: aSymbol withArguments: #()
]

{ #category : #'*PreSmalltalks-Pharo' }
Object >> perform: selector withArguments: argArray [
^ self perform: selector withArguments: argArray inSuperclass: self class
]

{ #category : #'*PreSmalltalks-Pharo' }
Object >> perform: selector withArguments: argArray inSuperclass: lookupClass [
selector numArgs = argArray size
ifTrue: [ ^self primPerform: selector withArguments: argArray inSuperclass: lookupClass ].

^selector numArgs < argArray size
ifTrue: [ self error: 'cannot uncurry' ]
ifFalse: [ "curry"
| n |
n := selector numArgs - argArray size.
{
[ :x | self perform: selector withArguments: argArray, {x} inSuperclass: lookupClass ].
[ :x :y | self perform: selector withArguments: argArray, {x.y} inSuperclass: lookupClass ].
[ :x :y :z | self perform: selector withArguments: argArray, {x.y.z} inSuperclass: lookupClass ].
} at: n
].
]

shingarov marked this conversation as resolved.
Show resolved Hide resolved
{ #category : #'*PreSmalltalks-Pharo' }
Object >> primPerform: selector withArguments: argArray inSuperclass: lookupClass [
"NOTE: This is just like perform:withArguments:, except that
the message lookup process begins, not with the receivers's class,
but with the supplied superclass instead. It will fail if lookupClass
Expand All @@ -12,19 +40,9 @@ Object >> perform: selector withArguments: argArray inSuperclass: lookupClass [
<primitive: 100>
selector isSymbol
ifFalse: [ ^ self error: 'selector argument must be a Symbol' ].
selector numArgs < argArray size
ifTrue: [ ^ self error: 'cannot uncurry' ].
selector numArgs > argArray size
ifTrue: [ "curry"
| n |
n := selector numArgs - argArray size.
^{
[ :x | self perform: selector withArguments: argArray, {x} inSuperclass: lookupClass ].
[ :x :y | self perform: selector withArguments: argArray, {x.y} inSuperclass: lookupClass ].
[ :x :y :z | self perform: selector withArguments: argArray, {x.y.z} inSuperclass: lookupClass ].
} at: n
].
(self class includesBehavior: lookupClass)
ifFalse: [ ^ self error: 'lookupClass is not in my inheritance chain' ].
selector numArgs = argArray size
ifFalse: [ ^ self error: 'Undefined behavior on wrong arity' ].
self primitiveFailed
]
2 changes: 0 additions & 2 deletions src/PreSmalltalks-Tests/CurryingTest.class.st
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -37,7 +37,6 @@ CurryingTest >> testCurry [
{ #category : #tests }
CurryingTest >> testCurryingCollect [
| partial |
self skip "http://lists.squeakfoundation.org/pipermail/vm-dev/2022-October/038462.html".
partial := { 'abc' . 'xyz' . '123' } collect: #beginsWith: .
self
assert: (partial collect: [ :x | x value: 'a' ])
Expand All @@ -47,7 +46,6 @@ CurryingTest >> testCurryingCollect [
{ #category : #tests }
CurryingTest >> testCurryingCollectInt [
| partial |
self skip "http://lists.squeakfoundation.org/pipermail/vm-dev/2022-October/038462.html".
partial := { 5 . 6 . 7 } collect: #isDivisibleBy: .
self
assert: (partial collect: [ :x | x value: 2 ])
Expand Down
Loading