Merged JK's version from Monticello
Name: PetitParser-JanKurs.260
Author: JanKurs
Time: 17-11-2014, 12:09:05.490 PM
UUID: 07411cef-ef69-40db-9d93-d4018a9b34ef
Name: PetitTests-JanKurs.65
Author: JanKurs
Time: 17-11-2014, 12:09:04.530 PM
UUID: f98d613f-f4ce-4e0e-a7e9-310ee7c7e7a6
Name: PetitSmalltalk-JanKurs.78
Author: JanKurs
Time: 14-11-2014, 05:05:07.765 PM
UUID: 3d68330d-44d5-46c3-9705-97f627b3edbc
Name: PetitCompiler-JanKurs.71
Author: JanKurs
Time: 18-11-2014, 09:48:35.425 AM
UUID: 06352c33-3c76-4382-8536-0cc48e225117
Name: PetitCompiler-Tests-JanKurs.21
Author: JanKurs
Time: 17-11-2014, 05:51:53.134 PM
UUID: 8d6c0799-14e7-4871-8d91-8b0f9886db83
Name: PetitCompiler-Benchmarks-JanKurs.2
Author: JanKurs
Time: 17-11-2014, 05:51:07.887 PM
UUID: d5e3a980-7871-487a-a232-e3ca93fc2483
"{ Package: 'stx:goodies/petitparser/compiler/benchmarks' }"
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
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:'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> $'
! !