root/lang/smalltalk/misc/gost.st @ 7218

#!gst
"=====================================================================
|
| GoST - A golf extension for GNU Smalltalk, much like Ruby's goruby.
|
| (tested on 2.3.6)
|
 ====================================================================="

Object subclass: #Golf
  instanceVariableNames: ''
  classVariableNames: 'Dic'
  poolDictionaries: ''
  category: 'Golf'!
Golf.Dic := Dictionary new
  add: $S -> Smalltalk;
  add: $X -> thisContext;
  add: $< -> stdin;
  add: $> -> stdout;
  add: $* -> Smalltalk arguments;
  add: $/ -> $<10>;
  add: $\ -> nil;
  yourself!
!Golf class methodsFor: 'golf'!
printOn: s
  s nextPutAll: 'Golf'; nextPutAll: Dic printString!
find: abbr from: list
  | m |
  m := String streamContents: [:s|
    abbr do: [:c| s nextPut: c. c = $: or: [ s nextPut: $* ] ] ].
  ^(SortedCollection sortBlock:
    [:a :b| a size = b size ifTrue: [ a <= b ] ifFalse: [ a size < b size ] ])
    addAll: (list select: [:x| m match: x ignoreCase: false ]); yourself!
abbreviate: sele from: list
  | s |
  s := ((sele subStrings: $:) collect: [:k|
    | h |
    {h := String with: k first}, ((1 to: k size - 1) collect: [:i|
      ((k copyFrom: 2) combinations: i) collect: [:t| h, t ] ]) concat ]) directProduct.
  ^(((sele includes: $:)
    ifTrue:  [ s collect: [:ks| (ks collect: [:k| k, ':' ]) concat ] ]
    ifFalse: [ s concat ])
      detect: [:x| ((Golf find: x from: list) at: 1 ifAbsent: []) = sele ]
      ifNone: [ ^nil ]) asSymbol!
narrow: methods downTo: selector
  | a |
  a := selector occurrencesOf: $:.
  ^methods select: [:s| (s occurrencesOf: $:) = a ]!
?? sym
  ^(Smalltalk includesKey: sym)
    ifTrue:  [ Golf abbreviate: sym from: Smalltalk keys ]
    ifFalse: [ nil ]!

!ClassDescription methodsFor: 'golf'!
? abbr
  ^Golf.Dic at: self -> abbr asSymbol ifAbsentPut: [
    (Golf find: abbr from: (Golf narrow: self allSelectors downTo: abbr)) at: 1 ifAbsent:
      [ self error: ('%1 %2 not found.' bindWith: Golf with: abbr) ] ]!
?? s
  ^(self canUnderstand: s)
    ifTrue:  [ Golf abbreviate: s from: (Golf narrow: self allSelectors downTo: s) ]
    ifFalse: [ nil ]!
>? abbr
  "Just for peeking."
  | s |
  ^((self whichClassIncludesSelector: (s := self ? abbr)) >> s) methodSourceString!

!Object methodsFor: 'golf'!
doesNotUnderstand: m
  ^m selector: self class ? m selector; sendTo: self!
H
  ^'Hello, world!' P!
Q
  | s |
  s := thisContext.
  [ s methodClass = UndefinedObject ] whileFalse: [ s := s sender ].
  ^(s method methodSourceString, '!') display!
P
  self P: (Golf.Dic at: $>)!
P: s
  self displayOn: s. (Golf.Dic at: $/) displayOn: s!
|> s
  self P: s!
@ o
  (o respondsTo: #collect:) and: [ ^o collect: [:i| self at: i ] ].
  ^self at: o!

!Symbol methodsFor: 'golf'!
doesNotUnderstand: m
  ^m sendTo: (self C ifNil:[ ^super doesNotUnderstand: m ])!
C
  ^Smalltalk at: ((Golf find: self from: Smalltalk keys) at: 1 ifAbsent: [ ^nil ])!
<+ o
  ^SelfAssigner as: self with: o!

!Character methodsFor: 'golf'!
doesNotUnderstand: m
  ^m sendTo: (Golf.Dic at: self ifAbsent: [ ^super doesNotUnderstand: m ])!
, o
  ^(UnicodeString with: self), (o isCharacter ifTrue: [ {o} ] ifFalse: [ o ])!
+ o
  o isInteger and: [ ^Character codePoint: codePoint + o ].
  self doesNotUnderstand: (Message selector: #+ arguments: {o})!
- o
  o isInteger   and: [ ^Character codePoint: codePoint - o ].
  o isCharacter and: [ ^codePoint - o codePoint ].
  self doesNotUnderstand: (Message selector: #- arguments: {o})!
* o
  o isInteger and: [ ^UnicodeString new: o withAll: self ].
  self doesNotUnderstand: (Message selector: #* arguments: {o})!
~ o
  o isCharacter and: [ ^UnicodeString withAll:
    ((codePoint to: o codePoint) collect: [:v| Character codePoint: v ]) ].
  self doesNotUnderstand: (Message selector: #~ arguments: {o})!
<- o
  ^Golf.Dic at: self put: o!

!String methodsFor: 'golf'!
H
  ^('%1ello, %2orld%3' bindWithArguments: ((1 to: 3) collect:
    [:x| self at: x ifAbsent: [ 'Hw!' at: x ] ])) P!
E
  ^Behavior evaluate: self!
%% a
  ^self bindWithArguments: a!
base: n
  "Shortcut for Integer class>>#readFrom:radix:."
  ^Integer readFrom: (ReadStream on: self) radix: n!

!SequenceableCollection methodsFor: 'golf'!
/ o
  | s r |
  s := ReadStream on: self. 
  r := OrderedCollection new.
  (o isKindOf: SequenceableCollection) and: [
    [ r add: (s upToAll: o). s atEnd ] whileFalse ].
  (o isKindOf: Integer) and: [
    [ r add: (s nextAvailable: o). s atEnd ] whileFalse ].
  ^r!
* o
  ^(o isKindOf: Integer)
    ifTrue:  [ | r s i |
      r := self species new: (s := self size) * o. i := 1.
      o timesRepeat: [ r replaceFrom: i to: (i := i + s) - 1 with: self ].
      r ]
    ifFalse: [ | j s t r i |
      s := (j := o size = 0 ifTrue: [ self first species with: o ] ifFalse: [ o ]) size.
      t := self inject: 0 into: [:n :x| n + x size ].
      r := self first species new: self size - (i := 1) * s + t.
      self do: [:x| r replaceFrom: i to: (i := i + x size) - 1 with: x ]
           separatedBy: [ r replaceFrom: i to: (i := i + s) - 1 with: j ].
      r ]!
>< d
  "*Experimental*  e.g. 'Hello' >< {$H->$G. $l->$t} => 'Getto'"
  ^d inject: self copy into: [:r :a| r replaceAll: a key with: a value ]!
displayOn: s
  | j |
  (j := Golf.Dic at: $\)
    ifNil:    [ self do: [:x| x displayOn: s ] ]
    ifNotNil: [ self do: [:x| x displayOn: s ] separatedBy: [ j displayOn: s ] ]!
zip
  "Transpose rows with columns (derived from GolfScript)."
  | cols |
  cols := 1 to: self size.
  ^(1 to: self first size) collect:
    [:i| cols collect: [:j| (self at: j) at: i ] ]!

!False methodsFor: 'golf'!
displayOn: s!

!UndefinedObject methodsFor: 'golf'!
displayOn: s!

!Number methodsFor: 'golf'!
doesNotUnderstand: m
  ^[ super doesNotUnderstand: m copy ] ifError: [ ^m sendTo: (1 to: self) ]!
~ n
  ^self to: n by: (n < self ifTrue: [ -1 ] ifFalse: [ 1 ])!
** n
  ^self raisedTo: n!
? n
  ^self raisedTo: n!

!Integer methodsFor: 'golf'!
>> n
  ^self bitShift: n negated!
<< n
  ^self bitShift: n!
& n
  ^self bitAnd: n!
| n
  ^self bitOr:  n!
\ n
  ^self bitXor: n!
base: n
  "Perform #printStringRadix: without BBr in front of it."
  ^((self printStringRadix: n) subStrings: $r) last!

!Boolean methodsFor: 'golf'!
doesNotUnderstand: m
  ^[ super doesNotUnderstand: m copy ] ifError: [ ^m sendTo: self asCBooleanValue ]!
&& b
  ^self and: b!
|| b
  ^self or:  b!
? a
  | o |
  o := self ifTrue: [ a first ] ifFalse: [ a last ].
  ^(o isKindOf: BlockClosure) ifTrue: [ o value ] ifFalse: [ o ]!

!Collection methodsFor: 'golf'!
R
  "Answers a [R]andom item."
  ^self asArray at: Random next * self size // 1 + 1!
D
  "Makes a [D]ictionary from an array of associations."
  ^self asArray inject: Dictionary new into: [ :d :a | d add: a. d ]!
+ o
  (o isKindOf: BlockClosure) and: [ ^self fold: o ].
  o isSymbol and: [ ^self fold: [:a :b| a perform: o with: b ] ]!
\ b
  ^self collect: b!
\> b
  ^self \ [:x| (b value: x) P ]!
<< o
  self add: o!

!BlockClosure methodsFor: 'golf'!
* n
  ^n timesRepeat: self!
< o
  o isArray and: [ ^self valueWithArguments: o ].
  ^self value: o!
displayOn: s
  ^(self value) displayOn: s!

!FileStream methodsFor: 'golf'!
\ b
  ^(self contents subStrings: (Golf.Dic at: $/)) \ b!


"[ Not-so-golf Additions ]"

!Collection methodsFor: 'arithmetic'!
combinations: n
  n <= 1 and: [ ^self asArray collect: [:x| self species with: x ] ].
  n >= self size and: [ ^{self copy} ].
  ^(1 to: self size - n + 1) inject: {} into:
    [:c :i| c, (((self copyFrom: i + 1) combinations: n - 1) collect:
      [:comb| (self species with: (self at: i)), comb ])]!
directProduct
  "Answer a new array of arrays that's a direct(cartesian)-product of all my elements,
   which should be arrays. (Based on http://ja.doukaku.org/comment/2171/)"
  ^self reverse inject: #(#()) into: [:as :cl|
    cl inject: #() into: [:r :e| r, (as collect: [:a| {e}, a ]) ] ]!
sum
  ^self fold: [:x :y| x + y ]!
concat
  ^self fold: [:x :y| x , y ]!
max
  ^self fold: [:a :b| a < b ifTrue: [ b ] ifFalse: [ a ] ]!
min
  ^self fold: [:a :b| a > b ifTrue: [ b ] ifFalse: [ a ] ]!

!Object methodsFor: 'rubylike-case'!
<> cases
  cases do: [:a| a key =? self and: [ | v |
    ^((v := a value) isKindOf: BlockClosure) ifTrue: [ v value ] ifFalse: [ v ] ] ].
  ^nil!
case: cases
  ^self <> cases!
case: cases else: elseBlock
  ^self <> cases ifNil: elseBlock!
=? o
  ^self = o!
!

Object subclass: #Any
  instanceVariableNames: ''
  classVariableNames: ''
  poolDictionaries: ''
  category: '?'!
!Any class methodsFor: 'rubylike-case'!
=? o
  ^true!

!BlockClosure methodsFor: 'rubylike-case'!
=? o
  ^self value = o!

!Class methodsFor: 'rubylike-case'!
=? o
  ^o isKindOf: self!

!CharacterArray methodsFor: 'rubylike-case'!
=? o
  ^self match: o!

!Collection methodsFor: 'rubylike-case'!
=? o
  ^self includes: o!
!

Object subclass: #SelfAssigner
  instanceVariableNames: 'value'
  classVariableNames: ''
  poolDictionaries: ''
  category: 'Experiment'!
!SelfAssigner class methodsFor: 'creating instances'!
as: sym with: o
  ^Object classPool at: sym put: (super basicNew setValue: o)!

!SelfAssigner class methodsFor: 'initialization'!
isolate
  superclass := nil!

!SelfAssigner methodsFor: 'hacking'!
doesNotUnderstand: m
  ^value := m sendTo: value!
setValue: o
  value := o!
!
SelfAssigner isolate!