1 ! Copyright (C) 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: kernel present io math sequences assocs ranges
4 math.order tools.time smalltalk.selectors smalltalk.ast ;
10 M: object selector-print dup present print ;
11 M: object selector-asString present ;
18 M: object selector-print: [ present ] dip stream-print nil ;
19 M: object selector-nextPutAll: selector-print: ;
20 M: object selector-tab " " swap selector-print: ;
21 M: object selector-nl stream-nl nil ;
33 M: object selector-+ swap + ;
34 M: object selector-- swap - ;
35 M: object selector-* swap * ;
36 M: object selector-/ swap / ;
37 M: object selector-< swap < ;
38 M: object selector-> swap > ;
39 M: object selector-<= swap <= ;
40 M: object selector->= swap >= ;
41 M: object selector-= swap = ;
46 M: object selector-min: min ;
47 M: object selector-max: max ;
51 SELECTOR: ifTrue:ifFalse:
53 M: object selector-ifTrue: [ call( -- result ) ] [ drop nil ] if ;
54 M: object selector-ifFalse: [ drop nil ] [ call( -- result ) ] if ;
55 M: object selector-ifTrue:ifFalse: [ drop call( -- result ) ] [ nip call( -- result ) ] if ;
59 M: object selector-isNil nil eq? ;
64 M: sequence selector-at: nth ;
65 M: sequence selector-at:put: ( key value receiver -- receiver ) [ swapd set-nth ] keep ;
67 M: assoc selector-at: at ;
68 M: assoc selector-at:put: ( key value receiver -- receiver ) [ swapd set-at ] keep ;
72 M:: object selector-do: ( quot receiver -- nil )
73 receiver [ quot call( elt -- result ) drop ] each nil ;
78 M: object selector-to: swap [a..b] ;
79 M:: object selector-to:do: ( to quot from -- nil )
80 from to [a..b] [ quot call( i -- result ) drop ] each nil ;
84 SELECTOR: value:value:
85 SELECTOR: value:value:value:
86 SELECTOR: value:value:value:value:
88 M: object selector-value call( -- result ) ;
89 M: object selector-value: call( input -- result ) ;
90 M: object selector-value:value: call( input input -- result ) ;
91 M: object selector-value:value:value: call( input input input -- result ) ;
92 M: object selector-value:value:value:value: call( input input input input -- result ) ;
96 M: object selector-new new ;
100 M: object selector-time '[ _ call( -- result ) ] time ;