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

     2 

     3 Object subclass:#PPCBenchmark

     4 	instanceVariableNames:'sources report contextClass compile parser context input'

     5 	classVariableNames:''

     6 	poolDictionaries:''

     7 	category:'PetitCompiler-Benchmarks'

     8 !

     9 

    10 !PPCBenchmark class methodsFor:'instance creation'!

    11 

    12 new

    13     "return an initialized instance"

    14 

    15     ^ self basicNew initialize.

    16 ! !

    17 

    18 !PPCBenchmark class methodsFor:'benchmarking-CalipeL'!

    19 

    20 run

    21 	| benchmarkSuiteClass |

    22 	

    23 	benchmarkSuiteClass := Smalltalk at: #BenchmarkSuite.

    24 	benchmarkSuiteClass isNil ifTrue:[

    25 		self error: 'CalipeL is not loaded.'

    26 	].

    27 	^ (benchmarkSuiteClass  class:self) run

    28 

    29   	"

    30 	PPCBenchmark run.

    31 	"

    32 !

    33 

    34 run: selector

    35 	| benchmarkSuiteClass |

    36 	

    37 	benchmarkSuiteClass := Smalltalk at: #BenchmarkSuite.

    38 	benchmarkSuiteClass isNil ifTrue:[

    39 		self error: 'CalipeL is not loaded.'

    40 	].

    41 	^ (benchmarkSuiteClass  class:self selector: selector ) run

    42 	

    43 	"

    44 	PPCBenchmark run: #benchmarkRBParserC

    45 	"

    46 ! !

    47 

    48 !PPCBenchmark methodsFor:'benchmark support'!

    49 

    50 createContext

    51 	^ contextClass new

    52 !

    53 

    54 endSuite

    55 !

    56 

    57 initialize

    58 	super initialize.

    59 	sources := PPCBenchmarkResources new.

    60 	contextClass := PPCContext.

    61 	compile := false.

    62 !

    63 

    64 measure: parser on: input

    65 	self measure: parser on: input name: #unknown

    66 !

    67 

    68 measure: aParser on: anInput name: aString

    69 	| time result p |

    70 	context := self createContext.

    71 	

    72 	compile 	ifTrue: [ 

    73 					p := (aParser end compile: #TmpBenchmark) 

    74 				] ifFalse: [ 

    75 					p := aParser end. 

    76 				].

    77 

    78 	

    79 	time := Time millisecondsToRun: [ result := p parse: anInput withContext: context ].

    80 

    81 	self assert: result isPetitFailure not.

    82 	self reportFor: aParser context: context input: anInput time: time name: aString.

    83 !

    84 

    85 measure: parser onSources: inputs name: aString

    86 	| time result context p totalInput |

    87 	

    88 	compile 	ifTrue: [ 

    89 					p := (parser end compile: #TmpBenchmark) 

    90 				] ifFalse: [ 

    91 					p := parser end. 

    92 				].

    93 			

    94 	totalInput := ''.

    95 	time := 0.

    96 	inputs do: [:input | 

    97 		context := self createContext.

    98 		time := time + (Time millisecondsToRun: [ result := p parse: input withContext: context ]).

    99 		totalInput := totalInput, input.

   100 		self assert: result isPetitFailure not.

   101 	].

   102 	

   103 	

   104 	self reportFor: parser context: context input: totalInput time: time name: aString.

   105 !

   106 

   107 reportFor: parser context: context input: input time: time

   108 	self reportFor: parser context: context input: input time: time name: #unknown

   109 !

   110 

   111 reportFor: aParser context: aContext input: anInput time: time name: name

   112 	Transcript crShow: (self getMetaInfo: name).

   113 	Transcript crShow: '	Compile: ', compile asString.	

   114 	

   115 	Transcript crShow: '	Total time: ', time asString, ' ms'.

   116 		

   117 	Transcript crShow: '	Time per character: ', 

   118 	(((time / anInput size) asFloat * 1000) asString truncateTo: 6), 

   119 	' microseconds'.

   120 	

   121 "	Transcript crShow: '	Backtrack per character: ',

   122 	((aContext backtrackCount / anInput size) asFloat asString truncateTo: 6),

   123 	'.'.

   124 	

   125 	Transcript crShow: '	Remembers per character: ',

   126 	((aContext rememberCount / input size) asFloat asString truncateTo: 6),

   127 	'.'.

   128 "

   129 !

   130 

   131 startSuite

   132 	Transcript crShow: Date current asString, ' ', Time current asString.

   133 ! !

   134 

   135 !PPCBenchmark methodsFor:'benchmarks'!

   136 

   137 benchmarkAnyStar

   138 "

   139 	self measure: self anyStar on: sources petitParserPackage.

   140 "	

   141 	self measure: self anyStar on: (sources changesSized: 1000*1000) name: #anyStar.

   142 !

   143 

   144 benchmarkAnyStarBlock

   145 "

   146 	self measure: self anyStar on: sources petitParserPackage.

   147 "	

   148 	self measure: self anyStarBlock on: (sources changesSized: 1000*1000) name: #anyStarBlock.

   149 !

   150 

   151 benchmarkAttributes

   152 	| string text allStyles |

   153 	string := (self changesSized: 60000).

   154 	text := string asText.

   155 	allStyles := {

   156 		'Announcement' -> TextColor green. 

   157 		'Collections' -> TextColor blue.

   158 		'File' -> TextColor blue.

   159  		'Metacello' -> TextColor red.

   160 		'Monticello' -> TextColor magenta.

   161 		'Morphic' -> TextColor orange.

   162 		'Mooose' -> TextColor green.

   163 		'FAMIX' -> TextColor green.

   164 		'Roassal' -> TextColor green.

   165 	}.

   166 	

   167 	allStyles do: [ :assoc | | parser result time |

   168 		parser := (assoc key asParser, #newline asParser negate star).

   169 		time := Time millisecondsToRun: [

   170 			result := parser matchingRangesIn: string.

   171 		].

   172 		self reportFor: parser input: string time: time.

   173 	].

   174 !

   175 

   176 benchmarkBacktrack

   177 "

   178 	self measure: self anyStar on: sources petitParserPackage.

   179 "	

   180 	| parser |

   181 	parser := ((#any asParser, 'foo' asParser) / self tokenParser / #any asParser) plus.

   182 	self measure: parser on: (self changesSized: 100*1000) name: #backtrack.

   183 !

   184 

   185 benchmarkJava

   186 	| parser |

   187 	parser := PPJavaParser new.

   188 	self measure: parser on: sources javaLangMath name: #java.

   189 !

   190 

   191 benchmarkNegate

   192 "

   193 	self measure: self anyStar on: sources petitParserPackage.

   194 "	

   195 	| parser |

   196 	parser := ('a' asParser negate star, 'a' asParser) star, #any asParser star.

   197 	self measure: parser on: (self changesSized: 1000*1000) name: #negate.

   198 !

   199 

   200 benchmarkOpalCompiler

   201 	| parser time input |

   202 	parser := OpalCompiler new.

   203 	input := sources smalltalkSourcesBig.

   204 	time := [ input do: [ :source | parser parse: source ]] timeToRun asMilliseconds.

   205 	

   206 	self reportInput: input time: time name: 'Opal'

   207 !

   208 

   209 benchmarkSmalltalkGrammar

   210 	| time |

   211 

   212 	parser := PPSmalltalkGrammar new.

   213 	context := PPContext new.

   214 	context initializeFor: parser.

   215 	input := sources smalltalkSourcesBig.

   216 

   217 	time := [ input do: [ :source | parser parse: source withContext: context ]] timeToRun asMilliSeconds.

   218 	

   219 	self reportInput: input time: time name: 'Smalltalk Grammar'.

   220 !

   221 

   222 benchmarkSmalltalkGrammarCompiled

   223 	| time  |

   224 	parser := PPSmalltalkGrammar new compile.

   225 	context := PPCContext new.

   226 	context initializeFor: parser.

   227 	input := sources smalltalkSourcesBig.

   228 

   229 	time := [ input do: [ :source | parser parse: source withContext: context ]] timeToRun asMilliSeconds.

   230 	

   231 	self reportInput: input time: time name: 'Compiled Grammar'.

   232 

   233 "	

   234 	size := input inject: 0 into: [:r :e | r + e size  ].

   235 	Transcript crShow: 'Compiled Grammar time: ', time asString.

   236 	Transcript crShow: 'Time per character: ', (time / size * 1000.0) asString, ' microseconds'.

   237 "

   238 !

   239 

   240 benchmarkSmalltalkObject

   241 	| parser |

   242 	parser := PPSmalltalkGrammar new.

   243 	self measure: parser onSources: sources smalltalkObjectMethods name: #smalltalkObject.

   244 !

   245 

   246 benchmarkSmalltalkParser

   247 	| time |

   248 	parser := PPSmalltalkParser new.

   249 	context := PPContext new.

   250 	context initializeFor: parser.

   251 	input := sources smalltalkSourcesBig.

   252 

   253 	time := [ input do: [ :source | parser parse: source withContext: context ]] timeToRun asMilliSeconds.

   254 	

   255 	self reportInput: input time: time name: 'Smalltalk Parser'.

   256 !

   257 

   258 benchmarkSmalltalkParserCompiled

   259 	| time |

   260 	parser := PPSmalltalkParser new compile.

   261 	context := PPCContext new.

   262 	context initializeFor: parser.

   263 	input := sources smalltalkSourcesBig.

   264 

   265 	time := [ input do: [ :source | parser parse: source withContext: context ]] timeToRun asMilliSeconds.

   266 	

   267 		self reportInput: input time: time name: 'Smalltalk Parser Compiled'.

   268 !

   269 

   270 benchmarkToken

   271 "

   272 	self measure: self anyStar on: sources petitParserPackage.

   273 "	

   274 	| parser |

   275 	parser := (self tokenParser / #any asParser) star.

   276 	self measure: parser on: (self changesSized: 1000*1000) name: #token.

   277 !

   278 

   279 reportInput: input time: time name: name

   280 	| size |

   281 	size := input inject: 0 into: [:r :e | r + e size  ].

   282 	Transcript crShow: 'Size: ', size asString.

   283 	Transcript crShow: name, ' time: ', time asString.

   284 	Transcript crShow: 'Time per character: ', (time / size * 1000.0) asString, ' microseconds'.

   285 ! !

   286 

   287 !PPCBenchmark methodsFor:'benchmarks-CalipeL'!

   288 

   289 benchmarkRBParserC

   290 	<setup: #setupRBParserC>

   291 	<benchmark: 'RB Smalltalk Parser'>

   292 	

   293 	input do: [ :source | RBParser parseMethod: source ]

   294 !

   295 

   296 benchmarkSmalltalkParserC

   297 	<setup: #setupSmalltalkParserC>

   298 	<benchmark: 'Petit Smalltalk Parser - Standard'>

   299 	

   300 	input do: [ :source | parser parse: source withContext: context ]

   301 !

   302 

   303 benchmarkSmalltalkParserCompiledC

   304 	<setup: #setupSmalltalkParserCompiledC>

   305 	<teaddown: #teardownSmalltalkParserCompiledC>

   306 	<benchmark: 'Petit Smalltalk Parser - Compiled'>

   307 	

   308 	input do: [ :source | parser parse: source withContext: context ]

   309 	

   310 ! !

   311 

   312 !PPCBenchmark methodsFor:'meta'!

   313 

   314 getMetaInfo: key

   315 	| info |

   316 	info := self metaInfo select: [ :each | each key = key ].

   317 	info isEmpty ifTrue: [ ^ 'unknown benchmark' ].

   318 	^ info anyOne value

   319 !

   320 

   321 metaInfo

   322 	^ { 

   323 		#anyStar -> '.* Parser'.

   324 		#token -> 'Token Parser'.

   325 		#anyStarBlock -> 'context next in loop'.

   326 	}

   327 ! !

   328 

   329 !PPCBenchmark methodsFor:'parsers'!

   330 

   331 anyStar

   332 	^ #any asParser star

   333 !

   334 

   335 anyStarBlock

   336 	^ [ :ctx | [ctx atEnd] whileFalse: [ ctx next ] ] asParser

   337 !

   338 

   339 tokenParser

   340 	^ #letter asParser, (#letter asParser / #digit asParser) star trim

   341 ! !

   342 

   343 !PPCBenchmark methodsFor:'settings'!

   344 

   345 compile: aBoolean

   346 	compile := aBoolean

   347 !

   348 

   349 contextClass: aClass

   350 	contextClass := aClass

   351 ! !

   352 

   353 !PPCBenchmark methodsFor:'setup & teardown-CalipeL'!

   354 

   355 setupJavaSyntaxCompiledC

   356 	parser := PPJavaSyntax new compile.

   357 	context := PPCContext new.

   358 	context initializeFor: parser.

   359 	input := sources javaSourcesBig.

   360 

   361 "	

   362 	size := input inject: 0 into: [:r :e | r + e size  ].

   363 	Transcript crShow: 'Compiled Grammar time: ', time asString.

   364 	Transcript crShow: 'Time per character: ', (time / size * 1000.0) asString, ' microseconds'.

   365 "

   366 !

   367 

   368 setupRBParserC

   369 	

   370 	input := sources smalltalkSourcesBig.

   371 !

   372 

   373 setupSmalltalkParserC

   374 	

   375 	parser := PPSmalltalkParser new.

   376 	context := PPCContext new.

   377 	context initializeFor: parser.

   378 	input := sources smalltalkSourcesBig.

   379 !

   380 

   381 setupSmalltalkParserCompiledC

   382 	parser := PPSmalltalkParser new compile.

   383 	context := PPCContext new.

   384 	context initializeFor: parser.

   385 	input := sources smalltalkSourcesBig.

   386 

   387 "	

   388 	size := input inject: 0 into: [:r :e | r + e size  ].

   389 	Transcript crShow: 'Compiled Grammar time: ', time asString.

   390 	Transcript crShow: 'Time per character: ', (time / size * 1000.0) asString, ' microseconds'.

   391 "

   392 !

   393 

   394 teardownJavaSyntaxCompiledC

   395 	parser class removeFromSystem.

   396 "	

   397 	size := input inject: 0 into: [:r :e | r + e size  ].

   398 	Transcript crShow: 'Compiled Grammar time: ', time asString.

   399 	Transcript crShow: 'Time per character: ', (time / size * 1000.0) asString, ' microseconds'.

   400 "

   401 !

   402 

   403 teardownSmalltalkParserCompiledC

   404 	parser class removeFromSystem.

   405 "	

   406 	size := input inject: 0 into: [:r :e | r + e size  ].

   407 	Transcript crShow: 'Compiled Grammar time: ', time asString.

   408 	Transcript crShow: 'Time per character: ', (time / size * 1000.0) asString, ' microseconds'.

   409 "

   410 ! !

   411 

   412 !PPCBenchmark methodsFor:'sources'!

   413 

   414 changesSized: size

   415 	| string changes |

   416 	changes := PharoFilesOpener default changesFileOrNil contents.

   417 	string :=  changes copyFrom: 1 to: size.

   418 	^ string

   419 	

   420 ! !

   421 

   422 !PPCBenchmark methodsFor:'suites'!

   423 

   424 suite1

   425 	self startSuite.

   426 	

   427 	self benchmarkNegate.

   428 	self benchmarkBacktrack.

   429 	self benchmarkToken.

   430 	self benchmarkAnyStar.

   431 	self benchmarkJava.

   432 	

   433 	self endSuite.

   434 ! !

   435