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

Revision 6351, 9.1 kB (checked in by murky-satyr, 7 years ago)

lang/smalltalk/misc/gost.st: Integer>>#base: String>>#base:

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@ o
85  (o respondsTo: #collect:) and: [ ^o collect: [:i| self at: i ] ].
86  ^self at: o!
87
88!Symbol methodsFor: 'golf'!
89doesNotUnderstand: m
90  ^m sendTo: (self C ifNil:[ ^super doesNotUnderstand: m ])!
91C
92  ^Smalltalk at: ((Golf find: self from: Smalltalk keys) at: 1 ifAbsent: [ ^nil ])!
93<+ o
94  ^SelfAssigner as: self with: o!
95
96!Character methodsFor: 'golf'!
97doesNotUnderstand: m
98  ^m sendTo: (Golf.Dic at: self ifAbsent: [ ^super doesNotUnderstand: m ])!
99, o
100  ^(UnicodeString with: self), (o isCharacter ifTrue: [ {o} ] ifFalse: [ o ])!
101+ o
102  o isInteger and: [ ^Character codePoint: codePoint + o ].
103  self doesNotUnderstand: (Message selector: #+ arguments: {o})!
104- o
105  o isInteger   and: [ ^Character codePoint: codePoint - o ].
106  o isCharacter and: [ ^codePoint - o codePoint ].
107  self doesNotUnderstand: (Message selector: #- arguments: {o})!
108* o
109  o isInteger and: [ ^UnicodeString new: o withAll: self ].
110  self doesNotUnderstand: (Message selector: #* arguments: {o})!
111~ o
112  o isCharacter and: [ ^UnicodeString withAll:
113    ((codePoint to: o codePoint) collect: [:v| Character codePoint: v ]) ].
114  self doesNotUnderstand: (Message selector: #~ arguments: {o})!
115<- o
116  ^Golf.Dic at: self put: o!
117
118!String methodsFor: 'golf'!
119H
120  ^('%1ello, %2orld%3' bindWithArguments: ((1 to: 3) collect:
121    [:x| self at: x ifAbsent: [ 'Hw!' at: x ] ])) P!
122E
123  ^Behavior evaluate: self!
124%% a
125  ^self bindWithArguments: a!
126base: n
127  "Shortcut for Integer class>>#readFrom:radix:."
128  ^Integer readFrom: (ReadStream on: self) radix: n!
129
130!SequenceableCollection methodsFor: 'golf'!
131/ o
132  | s r |
133  s := ReadStream on: self.
134  r := OrderedCollection new.
135  (o isKindOf: SequenceableCollection) and: [
136    [ r add: (s upToAll: o). s atEnd ] whileFalse ].
137  (o isKindOf: Integer) and: [
138    [ r add: (s nextAvailable: o). s atEnd ] whileFalse ].
139  ^r!
140* o
141  ^(o isKindOf: Integer)
142    ifTrue:  [ | r s i |
143      r := self species new: (s := self size) * o. i := 1.
144      o timesRepeat: [ r replaceFrom: i to: (i := i + s) - 1 with: self ].
145      r ]
146    ifFalse: [ | j s t r i |
147      s := (j := o size = 0 ifTrue: [ self first species with: o ] ifFalse: [ o ]) size.
148      t := self inject: 0 into: [:n :x| n + x size ].
149      r := self first species new: self size - (i := 1) * s + t.
150      self do: [:x| r replaceFrom: i to: (i := i + x size) - 1 with: x ]
151           separatedBy: [ r replaceFrom: i to: (i := i + s) - 1 with: j ].
152      r ]!
153>< d
154  "*Experimental*  e.g. 'Hello' >< {$H->$G. $l->$t} => 'Getto'"
155  ^d inject: self copy into: [:r :a| r replaceAll: a key with: a value ]!
156displayOn: s
157  | j |
158  (j := Golf.Dic at: $\)
159    ifNil:    [ self do: [:x| x displayOn: s ] ]
160    ifNotNil: [ self do: [:x| x displayOn: s ] separatedBy: [ j displayOn: s ] ]!
161zip
162  "Transpose rows with columns (derived from GolfScript)."
163  | cols |
164  cols := 1 to: self size.
165  ^(1 to: self first size) collect:
166    [:i| cols collect: [:j| (self at: j) at: i ] ]!
167
168!False methodsFor: 'golf'!
169displayOn: s!
170
171!UndefinedObject methodsFor: 'golf'!
172displayOn: s!
173
174!Number methodsFor: 'golf'!
175doesNotUnderstand: m
176  ^[ super doesNotUnderstand: m copy ] ifError: [ ^m sendTo: (1 to: self) ]!
177~ n
178  ^self to: n by: (n < self ifTrue: [ -1 ] ifFalse: [ 1 ])!
179** n
180  ^self raisedTo: n!
181? n
182  ^self raisedTo: n!
183
184!Integer methodsFor: 'golf'!
185>> n
186  ^self bitShift: n negated!
187<< n
188  ^self bitShift: n!
189& n
190  ^self bitAnd: n!
191| n
192  ^self bitOr:  n!
193\ n
194  ^self bitXor: n!
195base: n
196  "Perform #printStringRadix: without BBr in front of it."
197  ^((self printStringRadix: n) subStrings: $r) last!
198
199!Boolean methodsFor: 'golf'!
200doesNotUnderstand: m
201  ^[ super doesNotUnderstand: m copy ] ifError: [ ^m sendTo: self asCBooleanValue ]!
202&& b
203  ^self and: b!
204|| b
205  ^self or:  b!
206? a
207  | o |
208  o := self ifTrue: [ a first ] ifFalse: [ a last ].
209  ^(o isKindOf: BlockClosure) ifTrue: [ o value ] ifFalse: [ o ]!
210
211!Collection methodsFor: 'golf'!
212R
213  "Answers a [R]andom item."
214  ^self asArray at: Random next * self size // 1 + 1!
215D
216  "Makes a [D]ictionary from an array of associations."
217  ^self asArray inject: Dictionary new into: [ :d :a | d add: a. d ]!
218+ o
219  (o isKindOf: BlockClosure) and: [ ^self fold: o ].
220  o isSymbol and: [ ^self fold: [:a :b| a perform: o with: b ] ]!
221\ b
222  ^self collect: b!
223\> b
224  ^self \ [:x| (b value: x) P ]!
225<< o
226  self add: o!
227
228!BlockClosure methodsFor: 'golf'!
229* n
230  ^n timesRepeat: self!
231< o
232  o isArray and: [ ^self valueWithArguments: o ].
233  ^self value: o!
234displayOn: s
235  ^(self value) displayOn: s!
236
237!FileStream methodsFor: 'golf'!
238\ b
239  ^(self contents subStrings: (Golf.Dic at: $/)) \ b!
240
241
242"[ Not-so-golf Additions ]"
243
244!Collection methodsFor: 'arithmetic'!
245combinations: n
246  n <= 1 and: [ ^self asArray collect: [:x| self species with: x ] ].
247  n >= self size and: [ ^{self copy} ].
248  ^(1 to: self size - n + 1) inject: {} into:
249    [:c :i| c, (((self copyFrom: i + 1) combinations: n - 1) collect:
250      [:comb| (self species with: (self at: i)), comb ])]!
251directProduct
252  "Answer a new array of arrays that's a direct(cartesian)-product of all my elements,
253   which should be arrays. (Based on http://ja.doukaku.org/comment/2171/)"
254  ^self reverse inject: #(#()) into: [:as :cl|
255    cl inject: #() into: [:r :e| r, (as collect: [:a| {e}, a ]) ] ]!
256sum
257  ^self fold: [:x :y| x + y ]!
258concat
259  ^self fold: [:x :y| x , y ]!
260max
261  ^self fold: [:a :b| a < b ifTrue: [ b ] ifFalse: [ a ] ]!
262min
263  ^self fold: [:a :b| a > b ifTrue: [ b ] ifFalse: [ a ] ]!
264
265!Object methodsFor: 'rubylike-case'!
266<> cases
267  cases do: [:a| a key =? self and: [ | v |
268    ^((v := a value) isKindOf: BlockClosure) ifTrue: [ v value ] ifFalse: [ v ] ] ].
269  ^nil!
270case: cases
271  ^self <> cases!
272case: cases else: elseBlock
273  ^self <> cases ifNil: elseBlock!
274=? o
275  ^self = o!
276!
277
278Object subclass: #Any
279  instanceVariableNames: ''
280  classVariableNames: ''
281  poolDictionaries: ''
282  category: '?'!
283!Any class methodsFor: 'rubylike-case'!
284=? o
285  ^true!
286
287!BlockClosure methodsFor: 'rubylike-case'!
288=? o
289  ^self value = o!
290
291!Class methodsFor: 'rubylike-case'!
292=? o
293  ^o isKindOf: self!
294
295!CharacterArray methodsFor: 'rubylike-case'!
296=? o
297  ^self match: o!
298
299!Collection methodsFor: 'rubylike-case'!
300=? o
301  ^self includes: o!
302!
303
304Object subclass: #SelfAssigner
305  instanceVariableNames: 'value'
306  classVariableNames: ''
307  poolDictionaries: ''
308  category: 'Experiment'!
309!SelfAssigner class methodsFor: 'creating instances'!
310as: sym with: o
311  ^Object classPool at: sym put: (super basicNew setValue: o)!
312
313!SelfAssigner class methodsFor: 'initialization'!
314isolate
315  superclass := nil!
316
317!SelfAssigner methodsFor: 'hacking'!
318doesNotUnderstand: m
319  ^value := m sendTo: value!
320setValue: o
321  value := o!
322!
323SelfAssigner isolate!
Note: See TracBrowser for help on using the browser.