"{ Package: 'stx:goodies/petitparser/compiler' }"

Object subclass:#PetitBenchmark

	instanceVariableNames:'sources report contextClass compile'

	classVariableNames:''

	poolDictionaries:''

	category:'PetitCompiler-Benchmarks'

!

!PetitBenchmark class methodsFor:'instance creation'!

new

    "return an initialized instance"

    ^ self basicNew initialize.

! !

!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.

! !