--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PetitBenchmark.st	Sun Oct 26 01:03:31 2014 +0000
@@ -0,0 +1,306 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+Object subclass:#PetitBenchmark
+	instanceVariableNames:'sources report contextClass compile'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'PetitCompiler-Benchmarks'
+!
+
+PetitBenchmark comment:''
+!
+
+!PetitBenchmark methodsFor:'benchmark support'!
+
+createContext
+	^ contextClass new
+!
+
+endSuite
+!
+
+initialize
+	super initialize.
+	sources := PetitBenchmarkSources new.
+	contextClass := PPCContext.
+	compile := false.
+!
+
+measure: parser on: input
+	self measure: parser on: input name: #unknown
+!
+
+measure: parser on: input name: aString
+	| time result context p |
+	context := self createContext.
+	
+	compile 	ifTrue: [ 
+					p := (parser end compile: #TmpBenchmark) 
+				] ifFalse: [ 
+					p := parser end. 
+				].
+
+	
+	time := Time millisecondsToRun: [ result := p parse: input withContext: context ].
+
+	self assert: result isPetitFailure not.
+	self reportFor: parser context: context input: input time: time name: aString.
+!
+
+measure: parser onSources: inputs name: aString
+	| time result context p totalInput |
+	
+	compile 	ifTrue: [ 
+					p := (parser end compile: #TmpBenchmark) 
+				] ifFalse: [ 
+					p := parser end. 
+				].
+			
+	totalInput := ''.
+	time := 0.
+	inputs do: [:input | 
+		context := self createContext.
+		time := time + (Time millisecondsToRun: [ result := p parse: input withContext: context ]).
+		totalInput := totalInput, input.
+		self assert: result isPetitFailure not.
+	].
+	
+	
+	self reportFor: parser context: context input: totalInput time: time name: aString.
+!
+
+reportFor: parser context: context input: input time: time
+	self reportFor: parser context: context input: input time: time name: #unknown
+!
+
+reportFor: parser context: context input: input time: time name: name
+	Transcript crShow: (self getMetaInfo: name).
+	Transcript crShow: '	Compile: ', compile asString.	
+	
+	Transcript crShow: '	Total time: ', time asString, ' ms'.
+		
+	Transcript crShow: '	Time per character: ', 
+	(((time / input size) asFloat * 1000) asString truncateTo: 6), 
+	' microseconds'.
+	
+	Transcript crShow: '	Backtrack per character: ',
+	((context backtrackCount / input size) asFloat asString truncateTo: 6),
+	'.'.
+	
+	Transcript crShow: '	Remembers per character: ',
+	((context rememberCount / input size) asFloat asString truncateTo: 6),
+	'.'.
+!
+
+startSuite
+	Transcript crShow: Date current asString, ' ', Time current asString.
+! !
+
+!PetitBenchmark methodsFor:'benchmarks'!
+
+benchmarkAnyStar
+"
+	self measure: self anyStar on: sources petitParserPackage.
+"	
+	self measure: self anyStar on: (self changesSized: 1000*1000) name: #anyStar.
+!
+
+benchmarkAttributes
+	| string text allStyles |
+	string := (self changesSized: 60000).
+	text := string asText.
+	allStyles := {
+		'Announcement' -> TextColor green. 
+		'Collections' -> TextColor blue.
+		'File' -> TextColor blue.
+ 		'Metacello' -> TextColor red.
+		'Monticello' -> TextColor magenta.
+		'Morphic' -> TextColor orange.
+		'Mooose' -> TextColor green.
+		'FAMIX' -> TextColor green.
+		'Roassal' -> TextColor green.
+	}.
+	
+	allStyles do: [ :assoc | | parser result time |
+		parser := (assoc key asParser, #newline asParser negate star).
+		time := Time millisecondsToRun: [
+			result := parser matchingRangesIn: string.
+		].
+		self reportFor: parser input: string time: time.
+	].
+!
+
+benchmarkBacktrack
+"
+	self measure: self anyStar on: sources petitParserPackage.
+"	
+	| parser |
+	parser := ((#any asParser, 'foo' asParser) / self tokenParser / #any asParser) plus.
+	self measure: parser on: (self changesSized: 100*1000) name: #backtrack.
+!
+
+benchmarkJava
+	| parser |
+	parser := PPJavaParser new.
+	self measure: parser on: sources javaLangMath name: #java.
+!
+
+benchmarkNegate
+"
+	self measure: self anyStar on: sources petitParserPackage.
+"	
+	| parser |
+	parser := ('a' asParser negate star, 'a' asParser) star, #any asParser star.
+	self measure: parser on: (self changesSized: 1000*1000) name: #negate.
+!
+
+benchmarkOpalCompiler
+	| parser time input |
+	parser := OpalCompiler new.
+	input := sources smalltalkSourcesBig.
+	time := [ input do: [ :source | parser parse: source ]] timeToRun asMilliseconds.
+	
+	self reportInput: input time: time name: 'Opal'
+!
+
+benchmarkSmalltalkGrammar
+	| parser time input context |
+	parser := PPSmalltalkGrammar new.
+	context := PPContext new.
+	context initializeFor: parser.
+	input := sources smalltalkSourcesBig.
+
+	time := [ input do: [ :source | parser parse: source withContext: context ]] timeToRun asMilliSeconds.
+	
+	self reportInput: input time: time name: 'Smalltalk Grammar'.
+!
+
+benchmarkSmalltalkGrammarCompiled
+	| parser time input context  |
+	parser := PPSmalltalkGrammar new compile.
+	context := PPCContext new.
+	context initializeFor: parser.
+	input := sources smalltalkSourcesBig.
+
+	time := [ input do: [ :source | parser parse: source withContext: context ]] timeToRun asMilliSeconds.
+	
+	self reportInput: input time: time name: 'Compiled Grammar'.
+
+"	
+	size := input inject: 0 into: [:r :e | r + e size  ].
+	Transcript crShow: 'Compiled Grammar time: ', time asString.
+	Transcript crShow: 'Time per character: ', (time / size * 1000.0) asString, ' microseconds'.
+"
+!
+
+benchmarkSmalltalkObject
+	| parser |
+	parser := PPSmalltalkGrammar new.
+	self measure: parser onSources: sources smalltalkObjectMethods name: #smalltalkObject.
+!
+
+benchmarkSmalltalkParser
+	| parser time input context |
+	parser := PPSmalltalkParser new.
+	context := PPContext new.
+	context initializeFor: parser.
+	input := sources smalltalkSourcesBig.
+
+	time := [ input do: [ :source | parser parse: source withContext: context ]] timeToRun asMilliSeconds.
+	
+	self reportInput: input time: time name: 'Smalltalk Parser'.
+!
+
+benchmarkSmalltalkParserCompiled
+	| parser time input context |
+	parser := PPSmalltalkParser new compile.
+	context := PPCContext new.
+	context initializeFor: parser.
+	input := sources smalltalkSourcesBig.
+
+	time := [ input do: [ :source | parser parse: source withContext: context ]] timeToRun asMilliSeconds.
+	
+		self reportInput: input time: time name: 'Smalltalk Parser Compiled'.
+!
+
+benchmarkToken
+"
+	self measure: self anyStar on: sources petitParserPackage.
+"	
+	| parser |
+	parser := (self tokenParser / #any asParser) star.
+	self measure: parser on: (self changesSized: 1000*1000) name: #token.
+!
+
+reportInput: input time: time name: name
+	| size |
+	size := input inject: 0 into: [:r :e | r + e size  ].
+	Transcript crShow: 'Size: ', size asString.
+	Transcript crShow: name, ' time: ', time asString.
+	Transcript crShow: 'Time per character: ', (time / size * 1000.0) asString, ' microseconds'.
+! !
+
+!PetitBenchmark methodsFor:'meta'!
+
+getMetaInfo: key
+	| info |
+	info := self metaInfo select: [ :each | each key = key ].
+	info isEmpty ifTrue: [ ^ 'unknown benchmark' ].
+	^ info anyOne value
+!
+
+metaInfo
+	^ { 
+		#anyStar -> '.* Parser'.
+		#token -> 'Token Parser'.
+		#backtrack -> 'Backtracking Parser'.
+		#negate -> 'Negate Parser'.
+		#java -> 'Standard Java Parser'.
+		#smalltalkObject -> 'All Smalltalk Object methods'
+	}
+! !
+
+!PetitBenchmark methodsFor:'parsers'!
+
+anyStar
+	^ #any asParser star
+!
+
+tokenParser
+	^ #letter asParser, (#letter asParser / #digit asParser) star trim
+! !
+
+!PetitBenchmark methodsFor:'settings'!
+
+compile: aBoolean
+	compile := aBoolean
+!
+
+contextClass: aClass
+	contextClass := aClass
+! !
+
+!PetitBenchmark methodsFor:'sources'!
+
+changesSized: size
+	| string changes |
+	changes := PharoFilesOpener default changesFileOrNil contents.
+	string :=  changes copyFrom: 1 to: size.
+	^ string
+	
+! !
+
+!PetitBenchmark methodsFor:'suites'!
+
+suite1
+	self startSuite.
+	
+	self benchmarkNegate.
+	self benchmarkBacktrack.
+	self benchmarkToken.
+	self benchmarkAnyStar.
+	self benchmarkJava.
+	
+	self endSuite.
+! !
+