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 fry tools.time locals smalltalk.selectors
   5 smalltalk.ast smalltalk.classes ;
   6 IN: smalltalk.library
   7
   8 SELECTOR: print
   9 SELECTOR: asString
  10
  11 M: object selector-print dup present print ;
  12 M: object selector-asString present ;
  13
  14 SELECTOR: print:
  15 SELECTOR: nextPutAll:
  16 SELECTOR: tab
  17 SELECTOR: nl
  18
  19 M: object selector-print: [ present ] dip stream-print nil ;
  20 M: object selector-nextPutAll: selector-print: ;
  21 M: object selector-tab "    " swap selector-print: ;
  22 M: object selector-nl stream-nl nil ;
  23
  24 SELECTOR: +
  25 SELECTOR: -
  26 SELECTOR: *
  27 SELECTOR: /
  28 SELECTOR: <
  29 SELECTOR: >
  30 SELECTOR: <=
  31 SELECTOR: >=
  32 SELECTOR: =
  33
  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 M: object selector-=  swap =  ;
  43
  44 SELECTOR: min:
  45 SELECTOR: max:
  46
  47 M: object selector-min: min ;
  48 M: object selector-max: max ;
  49
  50 SELECTOR: ifTrue:
  51 SELECTOR: ifFalse:
  52 SELECTOR: ifTrue:ifFalse:
  53
  54 M: object selector-ifTrue: [ call( -- result ) ] [ drop nil ] if ;
  55 M: object selector-ifFalse: [ drop nil ] [ call( -- result ) ] if ;
  56 M: object selector-ifTrue:ifFalse: [ drop call( -- result ) ] [ nip call( -- result ) ] if ;
  57
  58 SELECTOR: isNil
  59
  60 M: object selector-isNil nil eq? ;
  61
  62 SELECTOR: at:
  63 SELECTOR: at:put:
  64
  65 M: sequence selector-at: nth ;
  66 M: sequence selector-at:put: ( key value receiver -- receiver ) [ swapd set-nth ] keep ;
  67
  68 M: assoc selector-at: at ;
  69 M: assoc selector-at:put: ( key value receiver -- receiver ) [ swapd set-at ] keep ;
  70
  71 SELECTOR: do:
  72
  73 M:: object selector-do: ( quot receiver -- nil )
  74     receiver [ quot call( elt -- result ) drop ] each nil ;
  75
  76 SELECTOR: to:
  77 SELECTOR: to:do:
  78
  79 M: object selector-to: swap [a..b] ;
  80 M:: object selector-to:do: ( to quot from -- nil )
  81     from to [a..b] [ quot call( i -- result ) drop ] each nil ;
  82
  83 SELECTOR: value
  84 SELECTOR: value:
  85 SELECTOR: value:value:
  86 SELECTOR: value:value:value:
  87 SELECTOR: value:value:value:value:
  88
  89 M: object selector-value call( -- result ) ;
  90 M: object selector-value: call( input -- result ) ;
  91 M: object selector-value:value: call( input input -- result ) ;
  92 M: object selector-value:value:value: call( input input input -- result ) ;
  93 M: object selector-value:value:value:value: call( input input input input -- result ) ;
  94
  95 SELECTOR: new
  96
  97 M: object selector-new new ;
  98
  99 SELECTOR: time
 100
 101 M: object selector-time '[ _ call( -- result ) ] time ;