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

"{ NameSpace: Smalltalk }"

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

compile: value

	compile := value

!

createContext

	^ contextClass new

!

initialize

	super initialize.

	sources := PPCBenchmarkResources new.

	contextClass := PPCContext.

	compile := false.

!

measure: aParser on: anInput name: aString

	| time result p |

	context := self createContext.

	p := compile ifTrue: [ 

		aParser end compile

	] ifFalse: [ 

		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.

!

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),

	'.'.

"

!

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

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

!

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

"

!

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

! !

!PPCBenchmark methodsFor:'benchmarks - micro'!

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.

!

benchmarkToken

"

	self measure: self anyStar on: sources petitParserPackage.

"	

	parser := (self tokenParser / #any asParser) star.

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

! !

!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:'benchmarks-CalipeL- setup & teardown'!

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

		#tokenCompiled -> 'Token Parser Compiled'.

		#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 class methodsFor:'documentation'!

version_HG

    ^ '$Changeset: <not expanded> $'

! !