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 ranges
   4 math.order tools.time smalltalk.selectors smalltalk.ast ;
   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: print:
  14 SELECTOR: nextPutAll:
  15 SELECTOR: tab
  16 SELECTOR: nl
  17
  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 ;
  22
  23 SELECTOR: +
  24 SELECTOR: -
  25 SELECTOR: *
  26 SELECTOR: /
  27 SELECTOR: <
  28 SELECTOR: >
  29 SELECTOR: <=
  30 SELECTOR: >=
  31 SELECTOR: =
  32
  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 =  ;
  42
  43 SELECTOR: min:
  44 SELECTOR: max:
  45
  46 M: object selector-min: min ;
  47 M: object selector-max: max ;
  48
  49 SELECTOR: ifTrue:
  50 SELECTOR: ifFalse:
  51 SELECTOR: ifTrue:ifFalse:
  52
  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 ;
  56
  57 SELECTOR: isNil
  58
  59 M: object selector-isNil nil eq? ;
  60
  61 SELECTOR: at:
  62 SELECTOR: at:put:
  63
  64 M: sequence selector-at: nth ;
  65 M: sequence selector-at:put: ( key value receiver -- receiver ) [ swapd set-nth ] keep ;
  66
  67 M: assoc selector-at: at ;
  68 M: assoc selector-at:put: ( key value receiver -- receiver ) [ swapd set-at ] keep ;
  69
  70 SELECTOR: do:
  71
  72 M:: object selector-do: ( quot receiver -- nil )
  73     receiver [ quot call( elt -- result ) drop ] each nil ;
  74
  75 SELECTOR: to:
  76 SELECTOR: to:do:
  77
  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 ;
  81
  82 SELECTOR: value
  83 SELECTOR: value:
  84 SELECTOR: value:value:
  85 SELECTOR: value:value:value:
  86 SELECTOR: value:value:value:value:
  87
  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 ) ;
  93
  94 SELECTOR: new
  95
  96 M: object selector-new new ;
  97
  98 SELECTOR: time
  99
 100 M: object selector-time '[ _ call( -- result ) ] time ;