compiler/PPCBenchmark.st
changeset 414 0eaf09920532
parent 413 5389e6fbb3bc
--- a/compiler/PPCBenchmark.st	Wed Nov 05 21:40:01 2014 +0000
+++ b/compiler/PPCBenchmark.st	Wed Nov 05 23:05:19 2014 +0000
@@ -1,7 +1,7 @@
 "{ Package: 'stx:goodies/petitparser/compiler' }"
 
 Object subclass:#PPCBenchmark
-	instanceVariableNames:'sources report contextClass compile'
+	instanceVariableNames:'sources report contextClass compile parser context input'
 	classVariableNames:''
 	poolDictionaries:''
 	category:'PetitCompiler-Benchmarks'
@@ -15,6 +15,36 @@
     ^ 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'!
 
 createContext
@@ -25,31 +55,31 @@
 !
 
 initialize
-    super initialize.
-    sources := PPCBenchmarkResources new.
-    contextClass := PPCContext.
-    compile := false.
+	super initialize.
+	sources := PPCBenchmarkResources 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 |
+measure: aParser on: anInput name: aString
+	| time result p |
 	context := self createContext.
 	
 	compile 	ifTrue: [ 
-					p := (parser end compile: #TmpBenchmark) 
+					p := (aParser end compile: #TmpBenchmark) 
 				] ifFalse: [ 
-					p := parser end. 
+					p := aParser end. 
 				].
 
 	
-	time := Time millisecondsToRun: [ result := p parse: input withContext: context ].
+	time := Time millisecondsToRun: [ result := p parse: anInput withContext: context ].
 
 	self assert: result isPetitFailure not.
-	self reportFor: parser context: context input: input time: time name: aString.
+	self reportFor: aParser context: context input: anInput time: time name: aString.
 !
 
 measure: parser onSources: inputs name: aString
@@ -78,23 +108,24 @@
 	self reportFor: parser context: context input: input time: time name: #unknown
 !
 
-reportFor: parser context: context input: input time: time name: name
+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 / input size) asFloat * 1000) asString truncateTo: 6), 
+	(((time / anInput size) asFloat * 1000) asString truncateTo: 6), 
 	' microseconds'.
 	
-	Transcript crShow: '	Backtrack per character: ',
-	((context backtrackCount / input size) asFloat asString truncateTo: 6),
+"	Transcript crShow: '	Backtrack per character: ',
+	((aContext backtrackCount / anInput size) asFloat asString truncateTo: 6),
 	'.'.
 	
 	Transcript crShow: '	Remembers per character: ',
-	((context rememberCount / input size) asFloat asString truncateTo: 6),
+	((aContext rememberCount / input size) asFloat asString truncateTo: 6),
 	'.'.
+"
 !
 
 startSuite
@@ -107,7 +138,14 @@
 "
 	self measure: self anyStar on: sources petitParserPackage.
 "	
-	self measure: self anyStar on: (self changesSized: 1000*1000) name: #anyStar.
+	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.
 !
 
 benchmarkAttributes
@@ -169,7 +207,8 @@
 !
 
 benchmarkSmalltalkGrammar
-	| parser time input context |
+	| time |
+
 	parser := PPSmalltalkGrammar new.
 	context := PPContext new.
 	context initializeFor: parser.
@@ -181,7 +220,7 @@
 !
 
 benchmarkSmalltalkGrammarCompiled
-	| parser time input context  |
+	| time  |
 	parser := PPSmalltalkGrammar new compile.
 	context := PPCContext new.
 	context initializeFor: parser.
@@ -205,7 +244,7 @@
 !
 
 benchmarkSmalltalkParser
-	| parser time input context |
+	| time |
 	parser := PPSmalltalkParser new.
 	context := PPContext new.
 	context initializeFor: parser.
@@ -217,7 +256,7 @@
 !
 
 benchmarkSmalltalkParserCompiled
-	| parser time input context |
+	| time |
 	parser := PPSmalltalkParser new compile.
 	context := PPCContext new.
 	context initializeFor: parser.
@@ -245,6 +284,31 @@
 	Transcript crShow: 'Time per character: ', (time / size * 1000.0) asString, ' microseconds'.
 ! !
 
+!PPCBenchmark methodsFor:'benchmarks-CalipeL'!
+
+benchmarkRBParserC
+	<setup: #setupRBParserC>
+	<benchmark: 'RB Smalltalk Parser'>
+	
+	input do: [ :source | RBParser parseMethod: source ]
+!
+
+benchmarkSmalltalkParserC
+	<setup: #setupSmalltalkParserC>
+	<benchmark: 'Petit Smalltalk Parser - Standard'>
+	
+	input do: [ :source | parser parse: source withContext: context ]
+!
+
+benchmarkSmalltalkParserCompiledC
+	<setup: #setupSmalltalkParserCompiledC>
+	<teaddown: #teardownSmalltalkParserCompiledC>
+	<benchmark: 'Petit Smalltalk Parser - Compiled'>
+	
+	input do: [ :source | parser parse: source withContext: context ]
+	
+! !
+
 !PPCBenchmark methodsFor:'meta'!
 
 getMetaInfo: key
@@ -258,10 +322,7 @@
 	^ { 
 		#anyStar -> '.* Parser'.
 		#token -> 'Token Parser'.
-		#backtrack -> 'Backtracking Parser'.
-		#negate -> 'Negate Parser'.
-		#java -> 'Standard Java Parser'.
-		#smalltalkObject -> 'All Smalltalk Object methods'
+		#anyStarBlock -> 'context next in loop'.
 	}
 ! !
 
@@ -271,6 +332,10 @@
 	^ #any asParser star
 !
 
+anyStarBlock
+	^ [ :ctx | [ctx atEnd] whileFalse: [ ctx next ] ] asParser
+!
+
 tokenParser
 	^ #letter asParser, (#letter asParser / #digit asParser) star trim
 ! !
@@ -285,6 +350,65 @@
 	contextClass := aClass
 ! !
 
+!PPCBenchmark methodsFor:'setup & teardown-CalipeL'!
+
+setupJavaSyntaxCompiledC
+	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'.
+"
+!
+
+setupRBParserC
+	
+	input := sources smalltalkSourcesBig.
+!
+
+setupSmalltalkParserC
+	
+	parser := PPSmalltalkParser new.
+	context := PPCContext new.
+	context initializeFor: parser.
+	input := sources smalltalkSourcesBig.
+!
+
+setupSmalltalkParserCompiledC
+	parser := PPSmalltalkParser new compile.
+	context := PPCContext new.
+	context initializeFor: parser.
+	input := sources smalltalkSourcesBig.
+
+"	
+	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'.
+"
+!
+
+teardownJavaSyntaxCompiledC
+	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'.
+"
+!
+
+teardownSmalltalkParserCompiledC
+	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 methodsFor:'sources'!
 
 changesSized: size