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

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

        ((Smalltalk respondsTo:#isSmalltalkX) and:[Smalltalk isSmalltalkX]) ifTrue:[ 
            BenchmarkSkipRequest signal.
        ].
        
        parser := PPJavaSyntax new.
        context := PPCContext new.
        context initializeFor: parser.
        input := sources javaSourcesBig.

    "Modified: / 20-04-2015 / 12:55:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

setupJavaSyntaxCompiledC
        ((Smalltalk respondsTo:#isSmalltalkX) and:[Smalltalk isSmalltalkX]) ifTrue:[ 
            BenchmarkSkipRequest signal.
        ]. 
        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'.
"

    "Modified: / 20-04-2015 / 12:55:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

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 notNil ifTrue:[
	    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 notNil ifTrue:[
	    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.
	^ string
	
! !

!PPCBenchmark methodsFor:'suites'!

suite1
	self startSuite.
	
	self benchmarkNegate.
	self benchmarkBacktrack.
	self benchmarkToken.
	self benchmarkAnyStar.
	self benchmarkJava.
	
	self endSuite.
! !

!PPCBenchmark class methodsFor:'documentation'!

version_HG

    ^ '$Changeset: <not expanded> $'
! !