Changeset 5088 for lang/smalltalk

Timestamp:

01/20/08 19:37:32 (10 months ago)

Author:

murky-satyr

Message:

lang/smalltalk/misc/gost.st: Corresponds roughly to [goruby rev15046] (the flagitious patch).

Files:

• lang/smalltalk/misc/gost.st (modified) (8 diffs)

lang/smalltalk/misc/gost.st

@@ -10 +10 @@
 Object subclass: #Golf
   instanceVariableNames: ''
-  classVariableNames: 'Dic Global'
+  classVariableNames: 'Dic'
   poolDictionaries: ''
   category: 'Golf'!
-Golf.Dic    := Dictionary new.
-Golf.Global := Dictionary new
+Golf.Dic := Dictionary new
+  add: $S -> Smalltalk;
+  add: $X -> thisContext;
   add: $< -> stdin;
   add: $> -> stdout;
   add: $* -> Smalltalk arguments;
-  add: $S -> Smalltalk;
-  add: $X -> thisContext;
-  add: $/ -> Character nl;
+  add: $/ -> $<10>;
   add: $\ -> nil;
   yourself!
 !Golf class methodsFor: 'golf'!
 printOn: s
-  s nextPutAll: self D; nl; nextPutAll: self G!
-D
-  ^'Golf', Dic displayString!
-G
-  ^String streamContents: [:s| Global associationsDo: [:a| s << a; nl ] ]!
+  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: sym from: list
+  | s |
+  s := ((sym 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 ]) X.
+  ^(((sym includes: $:)
+    ifTrue:  [ s collect: [:ks| (ks collect: [:k| k, ':' ]) concat ] ]
+    ifFalse: [ s concat ])
+      detect: [:x| ((Golf find: x from: list) at: 1 ifAbsent: []) = sym ]
+      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
-  | a s |
-  a := abbr occurrencesOf: $:.
-  s := ((abbr inject: '' writeStream into:
-    [:s :c| c <= $Z and: [ s << $* ]. s << c ]) << $*) contents.
-  ^Golf.Dic at: {abbr asSymbol. self} ifAbsentPut: [
-    self allSelectors asSortedCollection
-      detect: [:x| (x occurrencesOf: $:) = a and: [ s match: x ignoreCase: false ] ]
-      ifNone: [ self error: Golf D, ' "', abbr, '" not found.' ] ]!
-
+? 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
+  | s |
+  ^(self whichClassIncludesSelector: (s := self ? abbr)) >> s!
+  
 !Object methodsFor: 'golf'!
 doesNotUnderstand: m
-  ^m selector: self class ?? m selector; sendTo: self!
+  ^m selector: self class ? m selector; sendTo: self!
 H
-  ^'Hello, world!' displayNl!
-H: args
-  ^('%1ello, %2orld%3' bindWithArguments: args) displayNl!
+  ^'Hello, world!' P!
 Q
   | s |
@@ -55 +77 @@
   ^(s method methodSourceString, '!') display!
 P
-  ^self displayNl!
-P: f
-  self displayOn: f. f nl!
-|> f
-  self displayOn: f!
+  self P: (Golf.Dic at: $>)!
+P: s
+  self displayOn: s. (Golf.Dic at: $/) displayOn: s!
+|> s
+  self P: s!
 
 !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 ])!
 
 !Character methodsFor: 'golf'!
 doesNotUnderstand: m
-  ^m sendTo: (Golf.Global at: self ifAbsent: [ ^super doesNotUnderstand: m ])!
+  ^m sendTo: (Golf.Dic at: self ifAbsent: [ ^super doesNotUnderstand: m ])!
 , o
   ^self asString, (o isCharacter ifTrue: [ {o} ] ifFalse: [ o ])!
 + n
   ^(codePoint + n) asCharacter!
+- n
+  ^(codePoint - n) asCharacter!
 * n
   ^String new: n withAll: self!
 ~ c
-  ^((codePoint ~ c value) inject: '' writeStream into:
-    [:s :v| s << v asCharacter ]) contents!
+  ^'', ((codePoint ~ c value) collect: [:v| v asCharacter ])!
 <- o
-  ^Golf.Global at: self put: o!
-
-!CharacterArray methodsFor: 'golf'!
-C
-  | s |
-  s := (((self copyFrom: 2) inject: '' writeStream << self first into:
-    [:s :c| c <= $Z and: [ s << $* ]. s << c ]) << $*) contents.
-  ^Smalltalk at: (##(Smalltalk keys asSortedCollection)
-    detect: [:k| s match: k ignoreCase: false ]
-    ifNone: [ ^nil ])!
+  ^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!
@@ -102 +124 @@
   ] ifFalse: [ super / p ]!
 * o
-  ^o isNumber
-    ifTrue:  [ self species streamContents: [:s| o timesRepeat: [ s nextPutAll: self ] ] ]
-    ifFalse: [
-      | j |
-      j := (o isKindOf: SequenceableCollection) ifTrue: [ o ] ifFalse: [ {o} ].
-      self fold: [:a :b| a, j, b ]]!
+  ^(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'"
@@ -113 +141 @@
 displayOn: s
   | j |
-  (j := Golf.Global at: $\) isNil
+  (j := Golf.Dic at: $\) isNil
     ifTrue:  [ self do: [:x| x displayOn: s ] ]
     ifFalse: [ self do: [:x| x displayOn: s ] separatedBy: [ j displayOn: s ] ]!
-
-!!
-
+  
 !False methodsFor: 'golf'!
 displayOn: s!
@@ -170 +196 @@
     ifTrue:  [ o collect: [:i| self at: i ] ]
     ifFalse: [ self at: o ]!
++ o
+  (o isKindOf: BlockClosure) and: [ ^self fold: o ].
+  o isSymbol and: [ ^self fold: [:a :b| a perform: o with: b ] ]!
 / n
   | r s |
@@ -182 +211 @@
 << o
   self add: o!
-sum
-  ^self fold: [:a :b| a + b ]!
-max
-  ^self fold: [:a :b| a < b ifTrue: [ b ] ifFalse: [ a ] ]!
-min
-  ^self fold: [:a :b| a > b ifTrue: [ b ] ifFalse: [ a ] ]!
 
 !BlockClosure methodsFor: 'golf'!
@@ -194 +217 @@
 < a
   ^self valueWithArguments: a!
+displayOn: s
+  ^(self value) displayOn: s!
 
 !FileStream methodsFor: 'golf'!
 \ b
-  ^(self contents subStrings: Character nl) \ 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 ])]!
+X
+  "Generates a cartesian-product."
+  ^self reverse inject: #(#()) into: [:arrs :colln|
+    colln inject: #() into: [:rs :elem| rs, (arrs collect: [:arr | {elem}, arr ]) ] ]!
+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'!
@@ -223 +267 @@
 =? o
   ^true!
-
 !BlockClosure methodsFor: 'rubylike-case'!
 =? o