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 fry
   4 tools.time locals smalltalk.selectors smalltalk.ast smalltalk.classes ;
   5 IN: smalltalk.library
   6
   7 SELECTOR: print
   8 SELECTOR: asString
   9
  10 M: object selector-print dup present print ;
  11 M: object selector-asString present ;
  12
  13 SELECTOR: +
  14 SELECTOR: -
  15 SELECTOR: *
  16 SELECTOR: /
  17 SELECTOR: <
  18 SELECTOR: >
  19 SELECTOR: <=
  20 SELECTOR: >=
  21 SELECTOR: =
  22
  23 M: object selector-+  swap +  ;
  24 M: object selector--  swap -  ;
  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
  33 SELECTOR: ifTrue:
  34 SELECTOR: ifFalse:
  35 SELECTOR: ifTrue:ifFalse:
  36
  37 M: object selector-ifTrue: [ call( -- result ) ] [ drop nil ] if ;
  38 M: object selector-ifFalse: [ drop nil ] [ call( -- result ) ] if ;
  39 M: object selector-ifTrue:ifFalse: [ drop call( -- result ) ] [ nip call( -- result ) ] if ;
  40
  41 SELECTOR: at:
  42 SELECTOR: at:put:
  43
  44 M: sequence selector-at: nth ;
  45 M: sequence selector-at:put: ( key value receiver -- receiver ) [ swapd set-nth ] keep ;
  46
  47 M: assoc selector-at: at ;
  48 M: assoc selector-at:put: ( key value receiver -- receiver ) [ swapd set-at ] keep ;
  49
  50 SELECTOR: do:
  51
  52 M:: object selector-do: ( quot receiver -- nil )
  53     receiver [ quot call( elt -- result ) drop ] each nil ;
  54
  55 SELECTOR: to:
  56 SELECTOR: to:do:
  57
  58 M: object selector-to: swap [a,b] ;
  59 M:: object selector-to:do: ( to quot from -- nil )
  60     from to [a,b] [ quot call( i -- result ) drop ] each nil ;
  61
  62 SELECTOR: value
  63 SELECTOR: value:
  64 SELECTOR: value:value:
  65 SELECTOR: value:value:value:
  66 SELECTOR: value:value:value:value:
  67
  68 M: object selector-value call( -- result ) ;
  69 M: object selector-value: call( input -- result ) ;
  70 M: object selector-value:value: call( input input -- result ) ;
  71 M: object selector-value:value:value: call( input input input -- result ) ;
  72 M: object selector-value:value:value:value: call( input input input input -- result ) ;
  73
  74 SELECTOR: new
  75
  76 M: object selector-new new ;
  77
  78 SELECTOR: time
  79
  80 M: object selector-time '[ _ call( -- result ) ] time ;