Mercurial Mercurial > hg > stx-goodies-petitparser / diff
summary | shortlog | changelog | graph | tags | bookmarks | branches | files | changeset | file | latest | revisions | annotate | diff | comparison | raw | help
Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
compiler/benchmarks/PPCBenchmark.st
changeset 438 20598d7ce9fa
parent 434 840942b96eea
child 452 9f4558b3be66 
--- a/compiler/benchmarks/PPCBenchmark.st	Tue Apr 21 17:20:11 2015 +0100
+++ b/compiler/benchmarks/PPCBenchmark.st	Thu Apr 30 23:43:14 2015 +0200
@@ -50,13 +50,14 @@
 
 !PPCBenchmark methodsFor:'benchmark support'!
 
+compile: value
+	compile := value
+!
+
 createContext
 	^ contextClass new
 !
 
-endSuite
-!
-
 initialize
 	super initialize.
 	sources := PPCBenchmarkResources new.
@@ -64,19 +65,15 @@
 	compile := false.
 !
 
-measure: parser on: input
-	self measure: parser on: input name: #unknown
-!
-
 measure: aParser on: anInput name: aString
 	| time result p |
 	context := self createContext.
 	
-	compile 	ifTrue: [ 
-					p := (aParser end compile: #TmpBenchmark) 
-				] ifFalse: [ 
-					p := aParser end. 
-				].
+	p := compile ifTrue: [ 
+		aParser end compile
+	] ifFalse: [ 
+		aParser end
+	].
 
 	
 	time := Time millisecondsToRun: [ result := p parse: anInput withContext: context ].
@@ -85,32 +82,6 @@
 	self reportFor: aParser context: context input: anInput time: time name: aString.
 !
 
-measure: parser onSources: inputs name: aString
-	| time result context p totalInput |
-	
-	compile 	ifTrue: [ 
-					p := (parser end compile: #TmpBenchmark) 
-				] ifFalse: [ 
-					p := parser end. 
-				].
-			
-	totalInput := ''.
-	time := 0.
-	inputs do: [:input | 
-		context := self createContext.
-		time := time + (Time millisecondsToRun: [ result := p parse: input withContext: context ]).
-		totalInput := totalInput, input.
-		self assert: result isPetitFailure not.
-	].
-	
-	
-	self reportFor: parser context: context input: totalInput time: time name: aString.
-!
-
-reportFor: parser context: context input: input time: time
-	self reportFor: parser context: context input: input time: time name: #unknown
-!
-
 reportFor: aParser context: aContext input: anInput time: time name: name
 	Transcript crShow: (self getMetaInfo: name).
 	Transcript crShow: '	Compile: ', compile asString.	
@@ -131,66 +102,16 @@
 "
 !
 
-startSuite
-	Transcript crShow: Date current asString, ' ', Time current asString.
+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'!
 
-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.
-!
-
-benchmarkAttributes
-	| string text allStyles |
-	string := (self changesSized: 60000).
-	text := string asText.
-	allStyles := {
-		'Announcement' -> TextColor green. 
-		'Collections' -> TextColor blue.
-		'File' -> TextColor blue.
- 		'Metacello' -> TextColor red.
-		'Monticello' -> TextColor magenta.
-		'Morphic' -> TextColor orange.
-		'Mooose' -> TextColor green.
-		'FAMIX' -> TextColor green.
-		'Roassal' -> TextColor green.
-	}.
-	
-	allStyles do: [ :assoc | | parser result time |
-		parser := (assoc key asParser, #newline asParser negate star).
-		time := Time millisecondsToRun: [
-			result := parser matchingRangesIn: string.
-		].
-		self reportFor: parser input: string time: time.
-	].
-!
-
-benchmarkBacktrack
-"
-	self measure: self anyStar on: sources petitParserPackage.
-"	
-	| parser |
-	parser := ((#any asParser, 'foo' asParser) / self tokenParser / #any asParser) plus.
-	self measure: parser on: (self changesSized: 100*1000) name: #backtrack.
-!
-
-benchmarkJava
-	| parser |
-	parser := PPJavaParser new.
-	self measure: parser on: sources javaLangMath name: #java.
-!
-
 benchmarkJavaSyntax
 	| time |
 	
@@ -221,15 +142,6 @@
 	self reportInput: input time: time name: 'Java Syntax Compiled'.
 !
 
-benchmarkNegate
-"
-	self measure: self anyStar on: sources petitParserPackage.
-"	
-	| parser |
-	parser := ('a' asParser negate star, 'a' asParser) star, #any asParser star.
-	self measure: parser on: (self changesSized: 1000*1000) name: #negate.
-!
-
 benchmarkOpalCompiler
 	| parser time input |
 	parser := OpalCompiler new.
@@ -270,12 +182,6 @@
 "
 !
 
-benchmarkSmalltalkObject
-	| parser |
-	parser := PPSmalltalkGrammar new.
-	self measure: parser onSources: sources smalltalkObjectMethods name: #smalltalkObject.
-!
-
 benchmarkSmalltalkParser
 	| time |
 	parser := PPSmalltalkParser new.
@@ -298,23 +204,30 @@
 	time := [ input do: [ :source | parser parse: source withContext: context ]] timeToRun asMilliSeconds.
 	
 		self reportInput: input time: time name: 'Smalltalk Parser Compiled'.
+! !
+
+!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 |
 	parser := (self tokenParser / #any asParser) star.
-	self measure: parser on: (self changesSized: 1000*1000) name: #token.
-!
-
-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'.
+	self measure: parser on: (sources changesSized: 1000*1000) name: #token.
 ! !
 
 !PPCBenchmark methodsFor:'benchmarks-CalipeL'!
@@ -374,79 +287,27 @@
 	
 ! !
 
-!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'.
-		#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:'settings'!
-
-compile: aBoolean
-	compile := aBoolean
-!
-
-contextClass: aClass
-	contextClass := aClass
-! !
-
-!PPCBenchmark methodsFor:'setup & teardown-CalipeL'!
+!PPCBenchmark methodsFor:'benchmarks-CalipeL- setup & teardown'!
 
 setupJavaSyntaxC
-
-        ((Smalltalk respondsTo:#isSmalltalkX) and:[Smalltalk isSmalltalkX]) ifTrue:[ 
-            BenchmarkSkipRequest signal.
-        ].
-        
-        parser := PPJavaSyntax new.
-        context := PPCContext new.
-        context initializeFor: parser.
-        input := sources javaSourcesBig.
-
-    "Modified: / 20-04-2015 / 12:55:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+	
+	parser := PPJavaSyntax new.
+	context := PPCContext new.
+	context initializeFor: parser.
+	input := sources javaSourcesBig.
 !
 
 setupJavaSyntaxCompiledC
-        ((Smalltalk respondsTo:#isSmalltalkX) and:[Smalltalk isSmalltalkX]) ifTrue:[ 
-            BenchmarkSkipRequest signal.
-        ]. 
-        parser := PPJavaSyntax new compile.
-        context := PPCContext new.
-        context initializeFor: parser.
-        input := sources javaSourcesBig.
+	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'.
+"	
+	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'.
 "
-
-    "Modified: / 20-04-2015 / 12:55:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 setupRBParserC
@@ -497,9 +358,7 @@
 !
 
 teardownJavaSyntaxCompiledC
-	parser notNil ifTrue:[
-	    parser class removeFromSystem.
-	].	
+	parser class removeFromSystem.
 "	
 	size := input inject: 0 into: [:r :e | r + e size  ].
 	Transcript crShow: 'Compiled Grammar time: ', time asString.
@@ -508,9 +367,7 @@
 !
 
 teardownSmalltalkGrammarCompiledC
-	parser notNil ifTrue:[
-	    parser class removeFromSystem.
-	].
+	parser class removeFromSystem.
 "	
 	size := input inject: 0 into: [:r :e | r + e size  ].
 	Transcript crShow: 'Compiled Grammar time: ', time asString.
@@ -527,28 +384,36 @@
 "
 ! !
 
-!PPCBenchmark methodsFor:'sources'!
+!PPCBenchmark methodsFor:'meta'!
 
-changesSized: size
-	| string changes |
-	changes := PharoFilesOpener default changesFileOrNil contents.
-	string :=  changes copyFrom: 1 to: size.
-	^ string
-	
+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:'suites'!
+!PPCBenchmark methodsFor:'parsers'!
+
+anyStar
+	^ #any asParser star
+!
 
-suite1
-	self startSuite.
-	
-	self benchmarkNegate.
-	self benchmarkBacktrack.
-	self benchmarkToken.
-	self benchmarkAnyStar.
-	self benchmarkJava.
-	
-	self endSuite.
+anyStarBlock
+	^ [ :ctx | [ctx atEnd] whileFalse: [ ctx next ] ] asParser
+!
+
+tokenParser
+	^ #letter asParser, (#letter asParser / #digit asParser) star trim
 ! !
 
 !PPCBenchmark class methodsFor:'documentation'!
hg/stx-goodies-petitparser