diff -r 5c502ab8e87d -r b2f2f15cef26 compiler/benchmarks/PPCBenchmark.st --- /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 + + + + input do: [ :source | RBParser parseMethod: source ] +! + +benchmarkSmalltalkParserC + + + + input do: [ :source | parser parse: source withContext: context ] +! + +benchmarkSmalltalkParserCompiledC + + + + + 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. +! ! +