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

     2 

     3 Object subclass:#PetitBenchmark

     4 	instanceVariableNames:'sources report contextClass compile'

     5 	classVariableNames:''

     6 	poolDictionaries:''

     7 	category:'PetitCompiler-Benchmarks'

     8 !

     9 

    10 !PetitBenchmark class methodsFor:'instance creation'!

    11 

    12 new

    13     "return an initialized instance"

    14 

    15     ^ self basicNew initialize.

    16 ! !

    17 

    18 !PetitBenchmark methodsFor:'benchmark support'!

    19 

    20 createContext

    21 	^ contextClass new

    22 !

    23 

    24 endSuite

    25 !

    26 

    27 initialize

    28 	super initialize.

    29 	sources := PetitBenchmarkSources new.

    30 	contextClass := PPCContext.

    31 	compile := false.

    32 !

    33 

    34 measure: parser on: input

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

    36 !

    37 

    38 measure: parser on: input name: aString

    39 	| time result context p |

    40 	context := self createContext.

    41 	

    42 	compile 	ifTrue: [ 

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

    44 				] ifFalse: [ 

    45 					p := parser end. 

    46 				].

    47 

    48 	

    49 	time := Time millisecondsToRun: [ result := p parse: input withContext: context ].

    50 

    51 	self assert: result isPetitFailure not.

    52 	self reportFor: parser context: context input: input time: time name: aString.

    53 !

    54 

    55 measure: parser onSources: inputs name: aString

    56 	| time result context p totalInput |

    57 	

    58 	compile 	ifTrue: [ 

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

    60 				] ifFalse: [ 

    61 					p := parser end. 

    62 				].

    63 			

    64 	totalInput := ''.

    65 	time := 0.

    66 	inputs do: [:input | 

    67 		context := self createContext.

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

    69 		totalInput := totalInput, input.

    70 		self assert: result isPetitFailure not.

    71 	].

    72 	

    73 	

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

    75 !

    76 

    77 reportFor: parser context: context input: input time: time

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

    79 !

    80 

    81 reportFor: parser context: context input: input time: time name: name

    82 	Transcript crShow: (self getMetaInfo: name).

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

    84 	

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

    86 		

    87 	Transcript crShow: '	Time per character: ', 

    88 	(((time / input size) asFloat * 1000) asString truncateTo: 6), 

    89 	' microseconds'.

    90 	

    91 	Transcript crShow: '	Backtrack per character: ',

    92 	((context backtrackCount / input size) asFloat asString truncateTo: 6),

    93 	'.'.

    94 	

    95 	Transcript crShow: '	Remembers per character: ',

    96 	((context rememberCount / input size) asFloat asString truncateTo: 6),

    97 	'.'.

    98 !

    99 

   100 startSuite

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

   102 ! !

   103 

   104 !PetitBenchmark methodsFor:'benchmarks'!

   105 

   106 benchmarkAnyStar

   107 "

   108 	self measure: self anyStar on: sources petitParserPackage.

   109 "	

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

   111 !

   112 

   113 benchmarkAttributes

   114 	| string text allStyles |

   115 	string := (self changesSized: 60000).

   116 	text := string asText.

   117 	allStyles := {

   118 		'Announcement' -> TextColor green. 

   119 		'Collections' -> TextColor blue.

   120 		'File' -> TextColor blue.

   121  		'Metacello' -> TextColor red.

   122 		'Monticello' -> TextColor magenta.

   123 		'Morphic' -> TextColor orange.

   124 		'Mooose' -> TextColor green.

   125 		'FAMIX' -> TextColor green.

   126 		'Roassal' -> TextColor green.

   127 	}.

   128 	

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

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

   131 		time := Time millisecondsToRun: [

   132 			result := parser matchingRangesIn: string.

   133 		].

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

   135 	].

   136 !

   137 

   138 benchmarkBacktrack

   139 "

   140 	self measure: self anyStar on: sources petitParserPackage.

   141 "	

   142 	| parser |

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

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

   145 !

   146 

   147 benchmarkJava

   148 	| parser |

   149 	parser := PPJavaParser new.

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

   151 !

   152 

   153 benchmarkNegate

   154 "

   155 	self measure: self anyStar on: sources petitParserPackage.

   156 "	

   157 	| parser |

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

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

   160 !

   161 

   162 benchmarkOpalCompiler

   163 	| parser time input |

   164 	parser := OpalCompiler new.

   165 	input := sources smalltalkSourcesBig.

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

   167 	

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

   169 !

   170 

   171 benchmarkSmalltalkGrammar

   172 	| parser time input context |

   173 	parser := PPSmalltalkGrammar new.

   174 	context := PPContext new.

   175 	context initializeFor: parser.

   176 	input := sources smalltalkSourcesBig.

   177 

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

   179 	

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

   181 !

   182 

   183 benchmarkSmalltalkGrammarCompiled

   184 	| parser time input context  |

   185 	parser := PPSmalltalkGrammar new compile.

   186 	context := PPCContext new.

   187 	context initializeFor: parser.

   188 	input := sources smalltalkSourcesBig.

   189 

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

   191 	

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

   193 

   194 "	

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

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

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

   198 "

   199 !

   200 

   201 benchmarkSmalltalkObject

   202 	| parser |

   203 	parser := PPSmalltalkGrammar new.

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

   205 !

   206 

   207 benchmarkSmalltalkParser

   208 	| parser time input context |

   209 	parser := PPSmalltalkParser new.

   210 	context := PPContext new.

   211 	context initializeFor: parser.

   212 	input := sources smalltalkSourcesBig.

   213 

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

   215 	

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

   217 !

   218 

   219 benchmarkSmalltalkParserCompiled

   220 	| parser time input context |

   221 	parser := PPSmalltalkParser new compile.

   222 	context := PPCContext new.

   223 	context initializeFor: parser.

   224 	input := sources smalltalkSourcesBig.

   225 

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

   227 	

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

   229 !

   230 

   231 benchmarkToken

   232 "

   233 	self measure: self anyStar on: sources petitParserPackage.

   234 "	

   235 	| parser |

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

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

   238 !

   239 

   240 reportInput: input time: time name: name

   241 	| size |

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

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

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

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

   246 ! !

   247 

   248 !PetitBenchmark methodsFor:'meta'!

   249 

   250 getMetaInfo: key

   251 	| info |

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

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

   254 	^ info anyOne value

   255 !

   256 

   257 metaInfo

   258 	^ { 

   259 		#anyStar -> '.* Parser'.

   260 		#token -> 'Token Parser'.

   261 		#backtrack -> 'Backtracking Parser'.

   262 		#negate -> 'Negate Parser'.

   263 		#java -> 'Standard Java Parser'.

   264 		#smalltalkObject -> 'All Smalltalk Object methods'

   265 	}

   266 ! !

   267 

   268 !PetitBenchmark methodsFor:'parsers'!

   269 

   270 anyStar

   271 	^ #any asParser star

   272 !

   273 

   274 tokenParser

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

   276 ! !

   277 

   278 !PetitBenchmark methodsFor:'settings'!

   279 

   280 compile: aBoolean

   281 	compile := aBoolean

   282 !

   283 

   284 contextClass: aClass

   285 	contextClass := aClass

   286 ! !

   287 

   288 !PetitBenchmark methodsFor:'sources'!

   289 

   290 changesSized: size

   291 	| string changes |

   292 	changes := PharoFilesOpener default changesFileOrNil contents.

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

   294 	^ string

   295 	

   296 ! !

   297 

   298 !PetitBenchmark methodsFor:'suites'!

   299 

   300 suite1

   301 	self startSuite.

   302 	

   303 	self benchmarkNegate.

   304 	self benchmarkBacktrack.

   305 	self benchmarkToken.

   306 	self benchmarkAnyStar.

   307 	self benchmarkJava.

   308 	

   309 	self endSuite.

   310 ! !

   311