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

Object subclass:#PPCBenchmark

	instanceVariableNames:'sources report contextClass compile parser context input'

	classVariableNames:''

	poolDictionaries:''

	category:'PetitCompiler-Benchmarks-Core'

!

!PPCBenchmark class methodsFor:'instance creation'!

new

    "return an initialized instance"

    ^ self basicNew initialize.

! !

!PPCBenchmark class methodsFor:'benchmarking-CalipeL'!

run

	| benchmarkSuiteClass |

	benchmarkSuiteClass := Smalltalk at: #BenchmarkSuite.

	benchmarkSuiteClass isNil ifTrue:[

		self error: 'CalipeL is not loaded.'

	].

	^ (benchmarkSuiteClass  class:self) run

  	"

	PPCBenchmark run.

	"

!

run: selector

	| benchmarkSuiteClass |

	benchmarkSuiteClass := Smalltalk at: #BenchmarkSuite.

	benchmarkSuiteClass isNil ifTrue:[

		self error: 'CalipeL is not loaded.'

	].

	^ (benchmarkSuiteClass  class:self selector: selector ) run

	"

	PPCBenchmark run: #benchmarkRBParserC

	"

! !

!PPCBenchmark methodsFor:'benchmark support'!

createContext

	^ contextClass new

!

endSuite

!

initialize

	super initialize.

	sources := PPCBenchmarkResources new.

	contextClass := PPCContext.

	compile := false.

!

measure: parser on: input

	self measure: parser on: input name: #unknown

!

measure: aParser on: anInput name: aString

	| time result p |

	context := self createContext.

	compile 	ifTrue: [ 

					p := (aParser end compile: #TmpBenchmark) 

				] ifFalse: [ 

					p := aParser end. 

				].

	time := Time millisecondsToRun: [ result := p parse: anInput withContext: context ].

	self assert: result isPetitFailure not.

	self reportFor: aParser context: context input: anInput 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: aParser context: aContext input: anInput 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 / anInput size) asFloat * 1000) asString truncateTo: 6), 

	' microseconds'.

"	Transcript crShow: '	Backtrack per character: ',

	((aContext backtrackCount / anInput size) asFloat asString truncateTo: 6),

	'.'.

	Transcript crShow: '	Remembers per character: ',

	((aContext rememberCount / input size) asFloat asString truncateTo: 6),

	'.'.

"

!

startSuite

	Transcript crShow: Date current asString, ' ', Time current asString.

! !

!PPCBenchmark methodsFor:'benchmarks'!

benchmarkAnyStar

"

	self measure: self anyStar on: sources petitParserPackage.

"	

	self measure: self anyStar on: (sources changesSized: 1000*1000) name: #anyStar.

!

benchmarkAnyStarBlock

"

	self measure: self anyStar on: sources petitParserPackage.

"	

	self measure: self anyStarBlock on: (sources changesSized: 1000*1000) name: #anyStarBlock.

!

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.

!

benchmarkJavaSyntax

	| time |

	self assert: '../java-src' asFileReference exists description: '../java-src directory with java sources expected'.

	parser := PPJavaSyntax new.

	context := PPCContext new.

	context initializeFor: parser.

	input := sources javaSourcesBig.

	time := [ input do: [ :source | parser parse: source withContext: context ]] timeToRun asMilliSeconds.

	self reportInput: input time: time name: 'Java Syntax'.

!

benchmarkJavaSyntaxCompiled

	| time |

	self assert: '../java-src' asFileReference exists description: '../java-src directory with java sources expected'.

	parser := PPJavaSyntax new compile.

	context := PPCContext new.

	context initializeFor: parser.

	input := sources javaSourcesBig.

	time := [ input do: [ :source | parser parse: source withContext: context ]] timeToRun asMilliSeconds.

	self reportInput: input time: time name: 'Java Syntax Compiled'.

!

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

	| time |

	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

	| time  |

	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

	| time |

	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

	| time |

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

! !

!PPCBenchmark methodsFor:'benchmarks-CalipeL'!

benchmarkJavaSyntaxC

	<setup: #setupJavaSyntaxC>

	<benchmark: 'Petit Java Parser - Standard'>

	input do: [ :source | parser parse: source withContext: context ]

!

benchmarkJavaSyntaxCompiledC

	<setup: #setupJavaSyntaxCompiledC>

	<teardown: #teardownJavaSyntaxCompiledC>

	<benchmark: 'Petit Java Parser - Compiled'>

	input do: [ :source | parser parse: source withContext: context ]

!

benchmarkRBParserC

	<setup: #setupRBParserC>

	<benchmark: 'RB Smalltalk Parser'>

	input do: [ :source | RBParser parseMethod: source ]

!

benchmarkSmalltalkGrammarC

	<setup: #setupSmalltalkGrammarC>

	<benchmark: 'Petit Smalltalk Grammar - Standard'>

	input do: [ :source | parser parse: source withContext: context ]

!

benchmarkSmalltalkGrammarCompiledC

	<setup: #setupSmalltalkGrammarCompiledC>

	<teardown: #teardownSmalltalkGrammarCompiledC>

	<benchmark: 'Petit Smalltalk Grammar - Compiled'>

	input do: [ :source | parser parse: source withContext: context ]

!

benchmarkSmalltalkParserC

	<setup: #setupSmalltalkParserC>

	<benchmark: 'Petit Smalltalk Parser - Standard'>

	input do: [ :source | parser parse: source withContext: context ]

!

benchmarkSmalltalkParserCompiledC

	<setup: #setupSmalltalkParserCompiledC>

	<teardown: #teardownSmalltalkParserCompiledC>

	<benchmark: 'Petit Smalltalk Parser - Compiled'>

	input do: [ :source | parser parse: source withContext: context ]

! !

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

		#anyStarBlock -> 'context next in loop'.

	}

! !

!PPCBenchmark methodsFor:'parsers'!

anyStar

	^ #any asParser star

!

anyStarBlock

	^ [ :ctx | [ctx atEnd] whileFalse: [ ctx next ] ] asParser

!

tokenParser

	^ #letter asParser, (#letter asParser / #digit asParser) star trim

! !

!PPCBenchmark methodsFor:'settings'!

compile: aBoolean

	compile := aBoolean

!

contextClass: aClass

	contextClass := aClass

! !

!PPCBenchmark methodsFor:'setup & teardown-CalipeL'!

setupJavaSyntaxC

	parser := PPJavaSyntax new.

	context := PPCContext new.

	context initializeFor: parser.

	input := sources javaSourcesBig.

!

setupJavaSyntaxCompiledC

	parser := PPJavaSyntax new compile.

	context := PPCContext new.

	context initializeFor: parser.

	input := sources javaSourcesBig.

"	

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

"

!

setupRBParserC

	input := sources smalltalkSourcesBig.

!

setupSmalltalkGrammarC

	parser := PPSmalltalkGrammar new.

	context := PPCContext new.

	context initializeFor: parser.

	input := sources smalltalkSourcesBig.

!

setupSmalltalkGrammarCompiledC

	parser := PPSmalltalkGrammar new compile.

	context := PPCContext new.

	context initializeFor: parser.

	input := sources smalltalkSourcesBig.

"	

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

"

!

setupSmalltalkParserC

	parser := PPSmalltalkParser new.

	context := PPCContext new.

	context initializeFor: parser.

	input := sources smalltalkSourcesBig.

!

setupSmalltalkParserCompiledC

	parser := PPSmalltalkParser new compile.

	context := PPCContext new.

	context initializeFor: parser.

	input := sources smalltalkSourcesBig.

"	

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

"

!

teardownJavaSyntaxCompiledC

	parser class removeFromSystem.

"	

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

"

!

teardownSmalltalkGrammarCompiledC

	parser class removeFromSystem.

"	

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

"

!

teardownSmalltalkParserCompiledC

	parser class removeFromSystem.

"	

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

"

! !

!PPCBenchmark methodsFor:'sources'!

changesSized: size

	| string changes |

	changes := PharoFilesOpener default changesFileOrNil contents.

	string :=  changes copyFrom: 1 to: size.