steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

smalltalk selector: to selector\

locals-and-roots
Doug Coleman 2016-06-05 17:22:22 -07:00
parent 98d9e2eb9c
commit 5d4ec06b7f
2 changed files with 34 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
demos/smalltalk/library/library.factor
View File

@ -5,31 +5,31 @@ math.order fry tools.time locals smalltalk.selectors
smalltalk.ast smalltalk.classes ; smalltalk.ast smalltalk.classes ;
in: smalltalk.library in: smalltalk.library
selector: print selector\ print
selector: asString selector\ asString
M: object selector-print dup present print ; M: object selector-print dup present print ;
M: object selector-asString present ; M: object selector-asString present ;
selector: print: selector\ print:
selector: nextPutAll: selector\ nextPutAll:
selector: tab selector\ tab
selector: nl selector\ nl
M: object selector-print: [ present ] dip stream-print nil ; M: object selector-print: [ present ] dip stream-print nil ;
M: object selector-nextPutAll: selector-print: ; M: object selector-nextPutAll: selector-print: ;
M: object selector-tab " " swap selector-print: ; M: object selector-tab " " swap selector-print: ;
M: object selector-nl stream-nl nil ; M: object selector-nl stream-nl nil ;
selector: + selector\ +
selector: - selector\ -
selector: * selector\ *
selector: / selector\ /
selector: < selector\ <
selector: > selector\ >
selector: <= selector\ <=
selector: >= selector\ >=
selector: = selector\ =
M: object selector-+ swap + ; M: object selector-+ swap + ;
M: object selector-- swap - ; M: object selector-- swap - ;
@ -41,26 +41,26 @@ M: object selector-<= swap <= ;
M: object selector->= swap >= ; M: object selector->= swap >= ;
M: object selector-= swap = ; M: object selector-= swap = ;
selector: min: selector\ min:
selector: max: selector\ max:
M: object selector-min: min ; M: object selector-min: min ;
M: object selector-max: max ; M: object selector-max: max ;
selector: ifTrue: selector\ ifTrue:
selector: ifFalse: selector\ ifFalse:
selector: ifTrue:ifFalse: selector\ ifTrue:ifFalse:
M: object selector-ifTrue: [ call( -- result ) ] [ drop nil ] if ; M: object selector-ifTrue: [ call( -- result ) ] [ drop nil ] if ;
M: object selector-ifFalse: [ drop nil ] [ call( -- result ) ] if ; M: object selector-ifFalse: [ drop nil ] [ call( -- result ) ] if ;
M: object selector-ifTrue:ifFalse: [ drop call( -- result ) ] [ nip call( -- result ) ] if ; M: object selector-ifTrue:ifFalse: [ drop call( -- result ) ] [ nip call( -- result ) ] if ;
selector: isNil selector\ isNil
M: object selector-isNil nil eq? ; M: object selector-isNil nil eq? ;
selector: at: selector\ at:
selector: at:put: selector\ at:put:
M: sequence selector-at: nth ; M: sequence selector-at: nth ;
M: sequence selector-at:put: ( key value receiver -- receiver ) [ swapd set-nth ] keep ; M: sequence selector-at:put: ( key value receiver -- receiver ) [ swapd set-nth ] keep ;
@ -68,23 +68,23 @@ M: sequence selector-at:put: ( key value receiver -- receiver ) [ swapd set-nth
M: assoc selector-at: at ; M: assoc selector-at: at ;
M: assoc selector-at:put: ( key value receiver -- receiver ) [ swapd set-at ] keep ; M: assoc selector-at:put: ( key value receiver -- receiver ) [ swapd set-at ] keep ;
selector: do: selector\ do:
M:: object selector-do: ( quot receiver -- nil ) M:: object selector-do: ( quot receiver -- nil )
receiver [ quot call( elt -- result ) drop ] each nil ; receiver [ quot call( elt -- result ) drop ] each nil ;
selector: to: selector\ to:
selector: to:do: selector\ to:do:
M: object selector-to: swap [a,b] ; M: object selector-to: swap [a,b] ;
M:: object selector-to:do: ( to quot from -- nil ) M:: object selector-to:do: ( to quot from -- nil )
from to [a,b] [ quot call( i -- result ) drop ] each nil ; from to [a,b] [ quot call( i -- result ) drop ] each nil ;
selector: value selector\ value
selector: value: selector\ value:
selector: value:value: selector\ value:value:
selector: value:value:value: selector\ value:value:value:
selector: value:value:value:value: selector\ value:value:value:value:
M: object selector-value call( -- result ) ; M: object selector-value call( -- result ) ;
M: object selector-value: call( input -- result ) ; M: object selector-value: call( input -- result ) ;
@ -92,10 +92,10 @@ M: object selector-value:value: call( input input -- result ) ;
M: object selector-value:value:value: call( input input input -- result ) ; M: object selector-value:value:value: call( input input input -- result ) ;
M: object selector-value:value:value:value: call( input input input input -- result ) ; M: object selector-value:value:value:value: call( input input input input -- result ) ;
selector: new selector\ new
M: object selector-new new ; M: object selector-new new ;
selector: time selector\ time
M: object selector-time '[ _ call( -- result ) ] time ; M: object selector-time '[ _ call( -- result ) ] time ;

2
demos/smalltalk/selectors/selectors.factor
View File

@ -26,4 +26,4 @@ SYMBOLS: unary binary keyword ;
bi define-simple-generic ; bi define-simple-generic ;
SYNTAX: SELECTOR: scan-token selector>generic drop ; SYNTAX: SELECTOR: scan-token selector>generic drop ;
SYNTAX: selector: scan-token selector>generic drop ; SYNTAX: selector\ scan-token selector>generic drop ;