--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/benchmarks/PPCBenchmark.st Wed Nov 19 10:52:37 2014 +0000
@@ -0,0 +1,435 @@
+"{ Package: 'stx:goodies/petitparser/compiler/benchmarks' }"
+
+Object subclass:#PPCBenchmark
+ instanceVariableNames:'sources report contextClass compile parser context input'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Benchmarks'
+!
+
+!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.
+!
+
+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'!
+
+benchmarkRBParserC
+ <setup: #setupRBParserC>
+ <benchmark: 'RB Smalltalk Parser'>
+
+ input do: [ :source | RBParser parseMethod: source ]
+!
+
+benchmarkSmalltalkParserC
+ <setup: #setupSmalltalkParserC>
+ <benchmark: 'Petit Smalltalk Parser - Standard'>
+
+ input do: [ :source | parser parse: source withContext: context ]
+!
+
+benchmarkSmalltalkParserCompiledC
+ <setup: #setupSmalltalkParserCompiledC>
+ <teaddown: #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'!
+
+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.
+!
+
+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'.
+"
+!
+
+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.
+! !
+