extra/smalltalk/library/library.factor

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel present io math sequences assocs math.ranges
   4 locals smalltalk.selectors smalltalk.ast ;
   5 IN: smalltalk.library
   6
   7 ! Some unary selectors
   8 SELECTOR: print
   9 SELECTOR: asString
  10
  11 M: object selector-print dup present print ;
  12 M: object selector-asString present ;
  13
  14 ! Some binary selectors
  15 SELECTOR: +
  16 SELECTOR: -
  17 SELECTOR: *
  18 SELECTOR: /
  19 SELECTOR: <
  20 SELECTOR: >
  21 SELECTOR: <=
  22 SELECTOR: >=
  23 SELECTOR: =
  24
  25 M: object selector-+  swap +  ;
  26 M: object selector--  swap -  ;
  27 M: object selector-*  swap *  ;
  28 M: object selector-/  swap /  ;
  29 M: object selector-<  swap <  ;
  30 M: object selector->  swap >  ;
  31 M: object selector-<= swap <= ;
  32 M: object selector->= swap >= ;
  33 M: object selector-=  swap =  ;
  34
  35 ! Some keyword selectors
  36 SELECTOR: ifTrue:
  37 SELECTOR: ifFalse:
  38 SELECTOR: ifTrue:ifFalse:
  39
  40 M: object selector-ifTrue: [ call( -- result ) ] [ drop nil ] if ;
  41 M: object selector-ifFalse: [ drop nil ] [ call( -- result ) ] if ;
  42 M: object selector-ifTrue:ifFalse: [ drop call( -- result ) ] [ nip call( -- result ) ] if ;
  43
  44 SELECTOR: at:
  45 SELECTOR: at:put:
  46
  47 M: sequence selector-at: nth ;
  48 M: sequence selector-at:put: ( key value receiver -- receiver ) [ swapd set-nth ] keep ;
  49
  50 M: assoc selector-at: at ;
  51 M: assoc selector-at:put: ( key value receiver -- receiver ) [ swapd set-at ] keep ;
  52
  53 SELECTOR: do:
  54
  55 M:: object selector-do: ( quot receiver -- nil )
  56     receiver [ quot call( elt -- result ) drop ] each nil ;
  57
  58 SELECTOR: to:
  59 SELECTOR: to:do:
  60
  61 M: object selector-to: swap [a,b] ;
  62 M:: object selector-to:do: ( to quot from -- nil )
  63     from to [a,b] [ quot call( i -- result ) drop ] each nil ;
  64
  65 SELECTOR: value
  66 SELECTOR: value:
  67 SELECTOR: value:value:
  68 SELECTOR: value:value:value:
  69 SELECTOR: value:value:value:value:
  70
  71 M: object selector-value call( -- result ) ;
  72 M: object selector-value: call( input -- result ) ;
  73 M: object selector-value:value: call( input input -- result ) ;
  74 M: object selector-value:value:value: call( input input input -- result ) ;
  75 M: object selector-value:value:value:value: call( input input input input -- result ) ;