"{ Package: 'stx:goodies/petitparser/compiler/benchmarks' }"

"{ NameSpace: Smalltalk }"

Object subclass:#PPCBenchmark
	instanceVariableNames:'sources report contextClass compile parser context input
		configuration'
	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'!

compile: value
    compile := value
!

measure: aParser on: anInput name: aString
    | time result p |
    context := self createContext.
    
    p := compile ifTrue: [ 
        aParser end compile
    ] ifFalse: [ 
        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.
!

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),
    '.'.
"
!

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

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'.
!

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 |

    self setupSmalltalkGrammar.

    time := [ input do: [ :source | parser parse: source withContext: context ]] timeToRun asMilliSeconds.
    
    self reportInput: input time: time name: 'Smalltalk Grammar'.
!

benchmarkSmalltalkGrammarCompiled
    | time  |

    self setupSmalltalkGrammarCompiled.

    time := [ input do: [ :source | parser parse: source withContext: context ]] timeToRun asMilliSeconds.
    
    self reportInput: input time: time name: 'Compiled Smalltalk 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'.
"
!

benchmarkSmalltalkGrammarTokenized
    | time   |

    self setupSmalltalkGrammarTokenized.
    
    time := [ input do: [ :source | 
            parser parse: source withContext: context ] 
    ] timeToRun asMilliSeconds.
    
    self reportInput: input time: time name: 'Tokenized Smalltalk 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'.
"
!

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 |
    
    configuration := PPCConfiguration default.
    parser := PPSmalltalkParser new compileWithConfiguration: configuration.
    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'.
! !

!PPCBenchmark methodsFor:'benchmarks - expression grammar'!

benchmarkExpressionGrammar
    | time |

    self setupExpressionGrammar.

    time := [ input do: [ :source | parser parse: source withContext: context ]] timeToRun asMilliSeconds.
    
    self reportInput: input time: time name: 'Expression Grammar'.
!

benchmarkExpressionGrammarCompiled
    | time |

    self setupExpressionGrammarCompiled.

    time := [ input do: [ :source | parser parse: source withContext: context ]] timeToRun asMilliSeconds.
    
    self reportInput: input time: time name: 'Compiled Expression Grammar'.
!

benchmarkExpressionGrammarTokenized
    | time |

    self setupExpressionGrammarTokenized.

    time := [ input do: [ :source | parser parse: source withContext: context ]] timeToRun asMilliSeconds.
    
    self reportInput: input time: time name: 'Tokenized Expression Grammar'.
!

benchmarkLL1ExpressionGrammar
    | time |

    self setupLL1ExpressionGrammar.

    time := [ input do: [ :source | parser parse: source withContext: context ]] timeToRun asMilliSeconds.
    
    self reportInput: input time: time name: 'LL1 Expression Grammar'.
!

benchmarkLL1ExpressionGrammarCompiled
    | time |

    self setupLL1ExpressionGrammarCompiled.

    time := [ input do: [ :source | parser parse: source withContext: context ]] timeToRun asMilliSeconds.
    
    self reportInput: input time: time name: 'Compiled LL1 Expression Grammar'.
!

benchmarkLL1ExpressionGrammarTokenized
    | time |

    self setupLL1ExpressionGrammarTokenized.

    time := [ input do: [ :source | parser parse: source withContext: context ]] timeToRun asMilliSeconds.
    
    self reportInput: input time: time name: 'Tokenized LL1 Expression Grammar'.
! !

!PPCBenchmark methodsFor:'benchmarks - micro'!

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.
!

benchmarkToken
"
    self measure: self anyStar on: sources petitParserPackage.
"	
    parser := (self tokenParser / #any asParser) star.
    self measure: parser on: (sources changesSized: 1000*1000) name: #token.
! !

!PPCBenchmark methodsFor:'benchmarks-CalipeL'!

benchmarkExpressionGrammarC
    <setup: #setupExpressionGrammar>
    <benchmark: 'Petit Expression Grammar - Standard'>
    
    input do: [ :source | parser parse: source withContext: context ]
!

benchmarkExpressionGrammarTokenizedC
    <setup: #setupExpressionGrammarTokenized>
    <teardown: #teardownExpressionGrammarTokenized>
    <benchmark: 'Petit Expression Grammar - Tokenized'>
    
    
    input do: [ :source | parser parse: source withContext: context ]
!

benchmarkJavaSyntaxC
    <setup: #setupJavaSyntax>
    <benchmark: 'Petit Java Parser - Standard'>
    
    input do: [ :source | parser parse: source withContext: context ]
!

benchmarkJavaSyntaxCompiledC
    <setup: #setupJavaSyntaxCompiled>
    <teardown: #teardownJavaSyntaxCompiled>
    <benchmark: 'Petit Java Parser - Compiled'>
    
    input do: [ :source | parser parse: source withContext: context ]
    
!

benchmarkRBParserC
    <setup: #setupRBParser>
    <benchmark: 'RB Smalltalk Parser'>
    
    input do: [ :source | RBParser parseMethod: source ]
!

benchmarkSmalltalkGrammarC
    <setup: #setupSmalltalkGrammar>
    <benchmark: 'Petit Smalltalk Grammar - Standard'>
    
    input do: [ :source | parser parse: source withContext: context ]
!

benchmarkSmalltalkGrammarCompiledC
    <setup: #setupSmalltalkGrammarCompiled>
    <teardown: #teardownSmalltalkGrammarCompiled>
    <benchmark: 'Petit Smalltalk Grammar - Compiled'>
    
    
    input do: [ :source | parser parse: source withContext: context ]
!

benchmarkSmalltalkGrammarTokenizedC
    <setup: #setupSmalltalkGrammarTokenized>
    <teardown: #teardownSmalltalkGrammarTokenized>
    <benchmark: 'Petit Smalltalk Grammar - Tokenized'>
    
    
    input do: [ :source | parser parse: source withContext: context ]
!

benchmarkSmalltalkParserC
    <setup: #setupSmalltalkParser>
    <benchmark: 'Petit Smalltalk Parser - Standard'>
    
    input do: [ :source | parser parse: source withContext: context ]
!

benchmarkSmalltalkParserCompiledC
    <setup: #setupSmalltalkParserCompiled>
    <teardown: #teardownSmalltalkParserCompiled>
    <benchmark: 'Petit Smalltalk Parser - Compiled'>
    
    input do: [ :source | parser parse: source withContext: context ]
    
! !

!PPCBenchmark methodsFor:'intitialization'!

createContext
    ^ contextClass new
!

initialize
    super initialize.
    sources := PPCResources current.
    contextClass := PPCContext.
    compile := false.
! !

!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'.
        #tokenCompiled -> 'Token Parser Compiled'.
        #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:'setup & teardown'!

setupExpressionGrammar
    
    parser := PPExpressionGrammar new.
    context := PPCContext new.
    context initializeFor: parser.
    input := sources expressionSourcesMedium.
!

setupExpressionGrammarCompiled
    
    configuration := PPCConfiguration universal.
    configuration arguments name: #PPCompiledExpressionGrammar.
    parser := PPExpressionGrammar new compileWithConfiguration: configuration.
    context := PPCContext new.
    context initializeFor: parser.
    input := sources expressionSourcesMedium.
!

setupExpressionGrammarTokenized
    
    configuration := PPCConfiguration LL1.
    configuration arguments name: #PPTokenizedLL1ExpressionGrammar.
    parser := PPLL1ExpressionGrammar new compileWithConfiguration: configuration.
    context := PPCContext new.
    context initializeFor: parser.
    input := sources expressionSourcesMedium.
!

setupJavaSyntax
    
    parser := PPJavaSyntax new.
    context := PPCContext new.
    context initializeFor: parser.
    input := sources javaSourcesBig.
!

setupJavaSyntaxCompiled
    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'.
"
!

setupLL1ExpressionGrammar
    
    parser := PPLL1ExpressionGrammar new.
    context := PPCContext new.
    context initializeFor: parser.
    input := sources expressionSourcesBig.
!

setupLL1ExpressionGrammarCompiled
    
    configuration := PPCConfiguration universal.
    configuration arguments name: #PPCompiledLL1ExpressionGrammar.
    parser := PPLL1ExpressionGrammar new compileWithConfiguration: configuration.
    context := PPCContext new.
    context initializeFor: parser.
    input := sources expressionSourcesBig.
!

setupLL1ExpressionGrammarTokenized
    
    configuration := PPCConfiguration universal.
    configuration arguments name: #PPTokenizedLL1ExpressionGrammar.
    parser := PPLL1ExpressionGrammar new compileWithConfiguration: configuration.
    context := PPCContext new.
    context initializeFor: parser.
    input := sources expressionSourcesBig.
!

setupRBParser
    
    input := sources smalltalkSourcesBig.
!

setupSmalltalkGrammar
    
    parser := PPSmalltalkGrammar new.
    context := PPCContext new.
    context initializeFor: parser.
    input := sources smalltalkSourcesBig.
!

setupSmalltalkGrammarCompiled

    configuration := PPCConfiguration universal.
    configuration arguments name: #PPCompiledSmalltalkGrammar.
    parser := PPSmalltalkGrammar new compileWithConfiguration: configuration.
    context := PPCContext new.
    context initializeFor: parser.
    input := sources smalltalkSourcesBig.
!

setupSmalltalkGrammarTokenized

    configuration := PPCConfiguration LL1.
    configuration arguments name: #PPTokenizedSmalltalkGrammar.
    parser := PPSmalltalkGrammar new compileWithConfiguration: configuration.
    context := PPCContext new.
    context initializeFor: parser.
    input := sources smalltalkSourcesBig.
!

setupSmalltalkParser
    
    parser := PPSmalltalkParser new.
    context := PPCContext new.
    context initializeFor: parser.
    input := sources smalltalkSourcesBig.
!

setupSmalltalkParserCompiled

    configuration := PPCConfiguration universal.
    parser := PPSmalltalkParser new compileWithConfiguration: configuration.
    context := PPCContext new.
    context initializeFor: parser.
    input := sources smalltalkSourcesBig.
!

setupSmalltalkParserTokenized

    configuration := PPCConfiguration LL1.
    parser := PPSmalltalkParser new compileWithConfiguration: configuration.
    context := PPCContext new.
    context initializeFor: parser.
    input := sources smalltalkSourcesBig.
!

teardownExpressionGrammarTokenized
    parser class removeFromSystem.
!

teardownJavaSyntaxCompiled
    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'.
"
!

teardownSmalltalkGrammarCompiled
    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'.
"
!

teardownSmalltalkGrammarTokenized
    parser class removeFromSystem.
!

teardownSmalltalkParserCompiled
    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 class methodsFor:'documentation'!

version_HG

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