--- a/compiler/PetitBenchmark.st Mon Nov 03 20:28:27 2014 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,311 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler' }"
-
-Object subclass:#PetitBenchmark
- instanceVariableNames:'sources report contextClass compile'
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Benchmarks'
-!
-
-!PetitBenchmark class methodsFor:'instance creation'!
-
-new
- "return an initialized instance"
-
- ^ self basicNew initialize.
-! !
-
-!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.
-! !
-