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

Revision 5930, 8.8 kB (checked in by murky-satyr, 7 years ago)

lang/smalltalk/misc/gost.st: ...

Line 
1#!gst
2"=====================================================================
3|
4| GoST - A golf extension for GNU Smalltalk, much like Ruby's goruby.
5|
6| (tested on 2.3.6)
7|
8 ====================================================================="
9
10Object subclass: #Golf
11  instanceVariableNames: ''
12  classVariableNames: 'Dic'
13  poolDictionaries: ''
14  category: 'Golf'!
15Golf.Dic := Dictionary new
16  add: $S -> Smalltalk;
17  add: $X -> thisContext;
18  add: $< -> stdin;
19  add: $> -> stdout;
20  add: $* -> Smalltalk arguments;
21  add: $/ -> $<10>;
22  add: $\ -> nil;
23  yourself!
24!Golf class methodsFor: 'golf'!
25printOn: s
26  s nextPutAll: 'Golf'; nextPutAll: Dic printString!
27find: abbr from: list
28  | m |
29  m := String streamContents: [:s|
30    abbr do: [:c| s nextPut: c. c = $: or: [ s nextPut: $* ] ] ].
31  ^(SortedCollection sortBlock:
32    [:a :b| a size = b size ifTrue: [ a <= b ] ifFalse: [ a size < b size ] ])
33    addAll: (list select: [:x| m match: x ignoreCase: false ]); yourself!
34abbreviate: sele from: list
35  | s |
36  s := ((sele subStrings: $:) collect: [:k|
37    | h |
38    {h := String with: k first}, ((1 to: k size - 1) collect: [:i|
39      ((k copyFrom: 2) combinations: i) collect: [:t| h, t ] ]) concat ]) directProduct.
40  ^(((sele includes: $:)
41    ifTrue:  [ s collect: [:ks| (ks collect: [:k| k, ':' ]) concat ] ]
42    ifFalse: [ s concat ])
43      detect: [:x| ((Golf find: x from: list) at: 1 ifAbsent: []) = sele ]
44      ifNone: [ ^nil ]) asSymbol!
45narrow: methods downTo: selector
46  | a |
47  a := selector occurrencesOf: $:.
48  ^methods select: [:s| (s occurrencesOf: $:) = a ]!
49?? sym
50  ^(Smalltalk includesKey: sym)
51    ifTrue:  [ Golf abbreviate: sym from: Smalltalk keys ]
52    ifFalse: [ nil ]!
53
54!ClassDescription methodsFor: 'golf'!
55? abbr
56  ^Golf.Dic at: self -> abbr asSymbol ifAbsentPut: [
57    (Golf find: abbr from: (Golf narrow: self allSelectors downTo: abbr)) at: 1 ifAbsent:
58      [ self error: ('%1 %2 not found.' bindWith: Golf with: abbr) ] ]!
59?? s
60  ^(self canUnderstand: s)
61    ifTrue:  [ Golf abbreviate: s from: (Golf narrow: self allSelectors downTo: s) ]
62    ifFalse: [ nil ]!
63>? abbr
64  "Just for peeking."
65  | s |
66  ^((self whichClassIncludesSelector: (s := self ? abbr)) >> s) methodSourceString!
67
68!Object methodsFor: 'golf'!
69doesNotUnderstand: m
70  ^m selector: self class ? m selector; sendTo: self!
71H
72  ^'Hello, world!' P!
73Q
74  | s |
75  s := thisContext.
76  [ s methodClass = UndefinedObject ] whileFalse: [ s := s sender ].
77  ^(s method methodSourceString, '!') display!
78P
79  self P: (Golf.Dic at: $>)!
80P: s
81  self displayOn: s. (Golf.Dic at: $/) displayOn: s!
82|> s
83  self P: s!
84
85!Symbol methodsFor: 'golf'!
86doesNotUnderstand: m
87  ^m sendTo: (self C ifNil:[ ^super doesNotUnderstand: m ])!
88C
89  ^Smalltalk at: ((Golf find: self from: Smalltalk keys) at: 1 ifAbsent: [ ^nil ])!
90<+ o
91  ^SelfAssigner as: self with: o!
92
93!Character methodsFor: 'golf'!
94doesNotUnderstand: m
95  ^m sendTo: (Golf.Dic at: self ifAbsent: [ ^super doesNotUnderstand: m ])!
96, o
97  ^(UnicodeString with: self), (o isCharacter ifTrue: [ {o} ] ifFalse: [ o ])!
98+ o
99  o isInteger and: [ ^Character codePoint: codePoint + o ].
100  self doesNotUnderstand: (Message selector: #+ arguments: {o})!
101- o
102  o isInteger   and: [ ^Character codePoint: codePoint - o ].
103  o isCharacter and: [ ^codePoint - o codePoint ].
104  self doesNotUnderstand: (Message selector: #- arguments: {o})!
105* o
106  o isInteger and: [ ^UnicodeString new: o withAll: self ].
107  self doesNotUnderstand: (Message selector: #* arguments: {o})!
108~ o
109  o isCharacter and: [ ^UnicodeString withAll:
110    ((codePoint to: o codePoint) collect: [:v| Character codePoint: v ]) ].
111  self doesNotUnderstand: (Message selector: #~ arguments: {o})!
112<- o
113  ^Golf.Dic at: self put: o!
114
115!String methodsFor: 'golf'!
116H
117  ^('%1ello, %2orld%3' bindWithArguments: ((1 to: 3) collect:
118    [:x| self at: x ifAbsent: [ 'Hw!' at: x ] ])) P!
119E
120  ^Behavior evaluate: self!
121%% a
122  ^self bindWithArguments: a!
123
124!SequenceableCollection methodsFor: 'golf'!
125/ p
126  ^(p isKindOf: SequenceableCollection) ifTrue: [
127    | s r |
128    s := self readStream. r := OrderedCollection new.
129    [ r add: (s upToAll: p). s atEnd ] whileFalse.
130    r.
131  ] ifFalse: [ super / p ]!
132* o
133  ^(o isKindOf: Integer)
134    ifTrue:  [ | r s i |
135      r := self species new: (s := self size) * o. i := 1.
136      o timesRepeat: [ r replaceFrom: i to: (i := i + s) - 1 with: self ].
137      r ]
138    ifFalse: [ | j s t r i |
139      s := (j := o size = 0 ifTrue: [ self first species with: o ] ifFalse: [ o ]) size.
140      t := self inject: 0 into: [:n :x| n + x size ].
141      r := self first species new: self size - (i := 1) * s + t.
142      self do: [:x| r replaceFrom: i to: (i := i + x size) - 1 with: x ]
143           separatedBy: [ r replaceFrom: i to: (i := i + s) - 1 with: j ].
144      r ]!
145>< d
146  "*Experimental*  e.g. 'Hello' >< {$H->$G. $l->$t} => 'Getto'"
147  ^d inject: self copy into: [:r :a| r replaceAll: a key with: a value ]!
148displayOn: s
149  | j |
150  (j := Golf.Dic at: $\) isNil
151    ifTrue:  [ self do: [:x| x displayOn: s ] ]
152    ifFalse: [ self do: [:x| x displayOn: s ] separatedBy: [ j displayOn: s ] ]!
153 
154!False methodsFor: 'golf'!
155displayOn: s!
156
157!UndefinedObject methodsFor: 'golf'!
158displayOn: s!
159
160!Number methodsFor: 'golf'!
161doesNotUnderstand: m
162  ^[ super doesNotUnderstand: m copy ] ifError: [ ^m sendTo: (1 to: self) ]!
163~ n
164  ^self to: n by: (n < self ifTrue: [ -1 ] ifFalse: [ 1 ])!
165** n
166  ^self raisedTo: n!
167? n
168  ^self raisedTo: n!
169
170!Integer methodsFor: 'golf'!
171>> n
172  ^self bitShift: n negated!
173<< n
174  ^self bitShift: n!
175& n
176  ^self bitAnd: n!
177| n
178  ^self bitOr:  n!
179\ n
180  ^self bitXor: n!
181
182!Boolean methodsFor: 'golf'!
183doesNotUnderstand: m
184  ^[ super doesNotUnderstand: m copy ] ifError: [ ^m sendTo: self asCBooleanValue ]!
185&& b
186  ^self and: b!
187|| b
188  ^self or:  b!
189? a
190  | o |
191  o := self ifTrue: [ a first ] ifFalse: [ a last ].
192  ^(o isKindOf: BlockClosure) ifTrue: [ o value ] ifFalse: [ o ]!
193
194!Collection methodsFor: 'golf'!
195R
196  "Answers a [R]andom item."
197  ^self asArray at: Random next * self size // 1 + 1!
198D
199  "Makes a [D]ictionary from an array of associations."
200  ^self asArray inject: Dictionary new into: [ :d :a | d add: a. d ]!
201@ o
202  ^(o respondsTo: #collect:)
203    ifTrue:  [ o collect: [:i| self at: i ] ]
204    ifFalse: [ self at: o ]!
205+ o
206  (o isKindOf: BlockClosure) and: [ ^self fold: o ].
207  o isSymbol and: [ ^self fold: [:a :b| a perform: o with: b ] ]!
208/ n
209  | r s |
210  r := OrderedCollection new: (self size / n) ceiling.
211  s := ReadStream on: self.
212  [ r add: (s nextAvailable: n). s atEnd ] whileFalse.
213  ^r!
214\ b
215  ^self collect: b!
216\> b
217  ^self \ [:x| (b value: x) P ]!
218<< o
219  self add: o!
220
221!BlockClosure methodsFor: 'golf'!
222* n
223  ^n timesRepeat: self!
224< o
225  o isArray and: [ ^self valueWithArguments: o ].
226  ^self value: o!
227displayOn: s
228  ^(self value) displayOn: s!
229
230!FileStream methodsFor: 'golf'!
231\ b
232  ^(self contents subStrings: (Golf.Dic at: $/)) \ b!
233
234
235"[ Not-so-golf Additions ]"
236
237!Collection methodsFor: 'arithmetic'!
238combinations: n
239  n <= 1 and: [ ^self asArray collect: [:x| self species with: x ] ].
240  n >= self size and: [ ^{self copy} ].
241  ^(1 to: self size - n + 1) inject: {} into:
242    [:c :i| c, (((self copyFrom: i + 1) combinations: n - 1) collect:
243      [:comb| (self species with: (self at: i)), comb ])]!
244directProduct
245  "Answer a new array of arrays that's a direct(cartesian)-product of all my elements,
246   which should be arrays. (Based on http://ja.doukaku.org/comment/2171/)"
247  ^self reverse inject: #(#()) into: [:as :cl|
248    cl inject: #() into: [:r :e| r, (as collect: [:a| {e}, a ]) ] ]!
249sum
250  ^self fold: [:x :y| x + y ]!
251concat
252  ^self fold: [:x :y| x , y ]!
253max
254  ^self fold: [:a :b| a < b ifTrue: [ b ] ifFalse: [ a ] ]!
255min
256  ^self fold: [:a :b| a > b ifTrue: [ b ] ifFalse: [ a ] ]!
257
258!Object methodsFor: 'rubylike-case'!
259<> cases
260  cases do: [:a| a key =? self and: [ | v |
261    ^((v := a value) isKindOf: BlockClosure) ifTrue: [ v value ] ifFalse: [ v ] ] ].
262  ^nil!
263case: cases
264  ^self <> cases!
265case: cases else: elseBlock
266  ^self <> cases ifNil: elseBlock!
267=? o
268  ^self = o!
269!
270
271Object subclass: #Any
272  instanceVariableNames: ''
273  classVariableNames: ''
274  poolDictionaries: ''
275  category: '?'!
276!Any class methodsFor: 'rubylike-case'!
277=? o
278  ^true!
279
280!BlockClosure methodsFor: 'rubylike-case'!
281=? o
282  ^self value = o!
283
284!Class methodsFor: 'rubylike-case'!
285=? o
286  ^o isKindOf: self!
287
288!CharacterArray methodsFor: 'rubylike-case'!
289=? o
290  ^self match: o!
291
292!Collection methodsFor: 'rubylike-case'!
293=? o
294  ^self includes: o!
295!
296
297Object subclass: #SelfAssigner
298  instanceVariableNames: 'value'
299  classVariableNames: ''
300  poolDictionaries: ''
301  category: 'Experiment'!
302!SelfAssigner class methodsFor: 'creating instances'!
303as: sym with: o
304  ^Object classPool at: sym put: (super basicNew setValue: o)!
305
306!SelfAssigner class methodsFor: 'initialization'!
307isolate
308  superclass := nil!
309
310!SelfAssigner methodsFor: 'hacking'!
311doesNotUnderstand: m
312  ^value := m sendTo: value!
313setValue: o
314  value := o!
315!
316SelfAssigner isolate!
Note: See TracBrowser for help on using the browser.