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 comment:''

    11 !

    12 

    13 !PetitBenchmark methodsFor:'benchmark support'!

    14 

    15 createContext

    16 	^ contextClass new

    17 !

    18 

    19 endSuite

    20 !

    21 

    22 initialize

    23 	super initialize.

    24 	sources := PetitBenchmarkSources new.

    25 	contextClass := PPCContext.

    26 	compile := false.

    27 !

    28 

    29 measure: parser on: input

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

    31 !

    32 

    33 measure: parser on: input name: aString

    34 	| time result context p |

    35 	context := self createContext.

    36 	

    37 	compile 	ifTrue: [ 

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

    39 				] ifFalse: [ 

    40 					p := parser end. 

    41 				].

    42 

    43 	

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

    45 

    46 	self assert: result isPetitFailure not.

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

    48 !

    49 

    50 measure: parser onSources: inputs name: aString

    51 	| time result context p totalInput |

    52 	

    53 	compile 	ifTrue: [ 

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

    55 				] ifFalse: [ 

    56 					p := parser end. 

    57 				].

    58 			

    59 	totalInput := ''.

    60 	time := 0.

    61 	inputs do: [:input | 

    62 		context := self createContext.

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

    64 		totalInput := totalInput, input.

    65 		self assert: result isPetitFailure not.

    66 	].

    67 	

    68 	

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

    70 !

    71 

    72 reportFor: parser context: context input: input time: time

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

    74 !

    75 

    76 reportFor: parser context: context input: input time: time name: name

    77 	Transcript crShow: (self getMetaInfo: name).

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

    79 	

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

    81 		

    82 	Transcript crShow: '	Time per character: ', 

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

    84 	' microseconds'.

    85 	

    86 	Transcript crShow: '	Backtrack per character: ',

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

    88 	'.'.

    89 	

    90 	Transcript crShow: '	Remembers per character: ',

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

    92 	'.'.

    93 !

    94 

    95 startSuite

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

    97 ! !

    98 

    99 !PetitBenchmark methodsFor:'benchmarks'!

   100 

   101 benchmarkAnyStar

   102 "

   103 	self measure: self anyStar on: sources petitParserPackage.

   104 "	

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

   106 !

   107 

   108 benchmarkAttributes

   109 	| string text allStyles |

   110 	string := (self changesSized: 60000).

   111 	text := string asText.

   112 	allStyles := {

   113 		'Announcement' -> TextColor green. 

   114 		'Collections' -> TextColor blue.

   115 		'File' -> TextColor blue.

   116  		'Metacello' -> TextColor red.

   117 		'Monticello' -> TextColor magenta.

   118 		'Morphic' -> TextColor orange.

   119 		'Mooose' -> TextColor green.

   120 		'FAMIX' -> TextColor green.

   121 		'Roassal' -> TextColor green.

   122 	}.

   123 	

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

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

   126 		time := Time millisecondsToRun: [

   127 			result := parser matchingRangesIn: string.

   128 		].

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

   130 	].

   131 !

   132 

   133 benchmarkBacktrack

   134 "

   135 	self measure: self anyStar on: sources petitParserPackage.

   136 "	

   137 	| parser |

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

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

   140 !

   141 

   142 benchmarkJava

   143 	| parser |

   144 	parser := PPJavaParser new.

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

   146 !

   147 

   148 benchmarkNegate

   149 "

   150 	self measure: self anyStar on: sources petitParserPackage.

   151 "	

   152 	| parser |

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

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

   155 !

   156 

   157 benchmarkOpalCompiler

   158 	| parser time input |

   159 	parser := OpalCompiler new.

   160 	input := sources smalltalkSourcesBig.

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

   162 	

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

   164 !

   165 

   166 benchmarkSmalltalkGrammar

   167 	| parser time input context |

   168 	parser := PPSmalltalkGrammar new.

   169 	context := PPContext new.

   170 	context initializeFor: parser.

   171 	input := sources smalltalkSourcesBig.

   172 

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

   174 	

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

   176 !

   177 

   178 benchmarkSmalltalkGrammarCompiled

   179 	| parser time input context  |

   180 	parser := PPSmalltalkGrammar new compile.

   181 	context := PPCContext new.

   182 	context initializeFor: parser.

   183 	input := sources smalltalkSourcesBig.

   184 

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

   186 	

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

   188 

   189 "	

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

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

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

   193 "

   194 !

   195 

   196 benchmarkSmalltalkObject

   197 	| parser |

   198 	parser := PPSmalltalkGrammar new.

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

   200 !

   201 

   202 benchmarkSmalltalkParser

   203 	| parser time input context |

   204 	parser := PPSmalltalkParser new.

   205 	context := PPContext new.

   206 	context initializeFor: parser.

   207 	input := sources smalltalkSourcesBig.

   208 

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

   210 	

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

   212 !

   213 

   214 benchmarkSmalltalkParserCompiled

   215 	| parser time input context |

   216 	parser := PPSmalltalkParser new compile.

   217 	context := PPCContext new.

   218 	context initializeFor: parser.

   219 	input := sources smalltalkSourcesBig.

   220 

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

   222 	

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

   224 !

   225 

   226 benchmarkToken

   227 "

   228 	self measure: self anyStar on: sources petitParserPackage.

   229 "	

   230 	| parser |

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

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

   233 !

   234 

   235 reportInput: input time: time name: name

   236 	| size |

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

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

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

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

   241 ! !

   242 

   243 !PetitBenchmark methodsFor:'meta'!

   244 

   245 getMetaInfo: key

   246 	| info |

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

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

   249 	^ info anyOne value

   250 !

   251 

   252 metaInfo

   253 	^ { 

   254 		#anyStar -> '.* Parser'.

   255 		#token -> 'Token Parser'.

   256 		#backtrack -> 'Backtracking Parser'.

   257 		#negate -> 'Negate Parser'.

   258 		#java -> 'Standard Java Parser'.

   259 		#smalltalkObject -> 'All Smalltalk Object methods'

   260 	}

   261 ! !

   262 

   263 !PetitBenchmark methodsFor:'parsers'!

   264 

   265 anyStar

   266 	^ #any asParser star

   267 !

   268 

   269 tokenParser

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

   271 ! !

   272 

   273 !PetitBenchmark methodsFor:'settings'!

   274 

   275 compile: aBoolean

   276 	compile := aBoolean

   277 !

   278 

   279 contextClass: aClass

   280 	contextClass := aClass

   281 ! !

   282 

   283 !PetitBenchmark methodsFor:'sources'!

   284 

   285 changesSized: size

   286 	| string changes |

   287 	changes := PharoFilesOpener default changesFileOrNil contents.

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

   289 	^ string

   290 	

   291 ! !

   292 

   293 !PetitBenchmark methodsFor:'suites'!

   294 

   295 suite1

   296 	self startSuite.

   297 	

   298 	self benchmarkNegate.

   299 	self benchmarkBacktrack.

   300 	self benchmarkToken.

   301 	self benchmarkAnyStar.

   302 	self benchmarkJava.

   303 	

   304 	self endSuite.

   305 ! !

   306