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