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

"{ NameSpace: Smalltalk }"

Object subclass:#PPCBenchmarkResources

	instanceVariableNames:''

	classVariableNames:'javaCache'

	poolDictionaries:''

	category:'PetitCompiler-Benchmarks-Core'

!

!PPCBenchmarkResources methodsFor:'as yet unclassified'!

changesSized: size

	| string changes |

	changes := PharoFilesOpener default changesFileOrNil contents.

	string :=  changes copyFrom: 1 to: size.

	^ string

!

javaInDirectory: directory

	| files |

	files := self readDirectory: directory.

	files := self files: files withExtension: 'java'.

!

javaLangClass

!

javaLangMath

!

javaSourcesBig

	^ self javaInDirectory: '../java-src/java/util'.

	"^ self workingJavaInDirectory: '../java-src/java/util'"

!

petitParserPackage

^ '

Object subclass: #PPCharSetPredicate

	instanceVariableNames: ''block classification''

	classVariableNames: ''''

	poolDictionaries: ''''

	category: ''PetitParser-Tools''!!

!!PPCharSetPredicate commentStamp: ''<historical>'' prior: 0!!

!!

!!PPCharSetPredicate methodsFor: ''initialization'' stamp: ''lr 8/30/2010 12:19''!!

initializeOn: aBlock

	block := aBlock.

	classification := Array new: 255.

	1 to: classification size do: [ :index |

		classification at: index put: (block

			value: (Character value: index)) ]!! !!

!!PPCharSetPredicate methodsFor: ''evaluating'' stamp: ''lr 8/30/2010 12:19''!!

value: aCharacter

	| index |

	index := aCharacter asInteger.

	index == 0

		ifTrue: [ ^ block value: aCharacter ].

	index > 255

		ifTrue: [ ^ block value: aCharacter ].

	^ classification at: index!! !!

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!

PPCharSetPredicate class

	instanceVariableNames: ''''!!

!!PPCharSetPredicate class commentStamp: ''<historical>'' prior: 0!!

!!

!!PPCharSetPredicate class methodsFor: ''instance creation'' stamp: ''lr 8/25/2010 11:05''!!

on: aBlock

	^ self basicNew initializeOn: aBlock!! !!

PPDelegateParser subclass: #PPExpressionParser

	instanceVariableNames: ''operators''

	classVariableNames: ''''

	poolDictionaries: ''''

	category: ''PetitParser-Tools''!!

!!PPExpressionParser commentStamp: ''<historical>'' prior: 0!!

A PPExpressionParser is a parser to conveniently define an expression grammar with prefix, postfix, and left- and right-associative infix operators.

The following code initializes a parser for arithmetic expressions. First we instantiate an expression parser, a simple parser for expressions in parenthesis and a simple parser for integer numbers.

	expression := PPExpressionParser new.

	parens := $( asParser token trim , expression , $) asParser token trim 

		==> [ :nodes | nodes second ].

	integer := #digit asParser plus token trim

		==> [ :token | token value asInteger ].

Then we define on what term the expression grammar is built on:

	expression term: parens / integer.

Finally we define the operator-groups in descending precedence. Note, that the action blocks receive both, the terms and the parsed operator in the order they appear in the parsed input. 

	expression

		group: [ :g |

			g prefix: $- asParser token trim do: [ :op :a | a negated ] ];

		group: [ :g |

			g postfix: ''++'' asParser token trim do: [ :a :op | a + 1 ].

			g postfix: ''--'' asParser token trim do: [ :a :op | a - 1 ] ];

		group: [ :g |

			g right: $^ asParser token trim do: [ :a :op :b | a raisedTo: b ] ];

		group: [ :g |

			g left: $* asParser token trim do: [ :a :op :b | a * b ].

			g left: $/ asParser token trim do: [ :a :op :b | a / b ] ];

		group: [ :g |

			g left: $+ asParser token trim do: [ :a :op :b | a + b ].

			g left: $- asParser token trim do: [ :a :op :b | a - b ] ].

After evaluating the above code the ''expression'' is an efficient parser that evaluates examples like:

	expression parse: ''-8++''.

	expression parse: ''1+2*3''.

	expression parse: ''1*2+3''.

	expression parse: ''(1+2)*3''.

	expression parse: ''8/4/2''.

	expression parse: ''8/(4/2)''.

	expression parse: ''2^2^3''.

	expression parse: ''(2^2)^3''.

Instance Variables:

	operators	<Dictionary>	The operators defined in the current group.!!

!!PPExpressionParser methodsFor: ''private'' stamp: ''FirstnameLastname 11/26/2009 20:48''!!

build: aParser right: aChoiceParser

	^ (aParser separatedBy: aChoiceParser) foldRight: [ :a :op :b | op first value: a value: op second value: b ]!! !!

!!PPExpressionParser methodsFor: ''private'' stamp: ''FirstnameLastname 11/26/2009 20:48''!!

build: aParser left: aChoiceParser

	^ (aParser separatedBy: aChoiceParser) foldLeft: [ :a :op :b | op first value: a value: op second value: b ]!! !!

!!PPExpressionParser methodsFor: ''private'' stamp: ''lr 12/4/2009 17:38''!!

build: aParser postfix: aChoiceParser

	^ aParser , aChoiceParser star map: [ :term :ops | ops inject: term into: [ :result :operator | operator first value: result value: operator second ] ]!! !!

!!PPExpressionParser methodsFor: ''private'' stamp: ''FirstnameLastname 11/26/2009 21:15''!!

buildOn: aParser

	^ self buildSelectors inject: aParser into: [ :term :selector |

		| list |

		list := operators at: selector ifAbsent: [ #() ].

		list isEmpty

			ifTrue: [ term ]

			ifFalse: [

				self

					perform: selector with: term 

					with: (list size = 1

						ifTrue: [ list first first ==> [ :operator | Array with: list first second with: operator ] ]

						ifFalse: [ 

							list

								inject: PPChoiceParser new

								into: [ :choice :each | choice / (each first ==> [ :operator | Array with: each second with: operator ]) ] ]) ] ]!! !!

!!PPExpressionParser methodsFor: ''private'' stamp: ''lr 12/4/2009 17:39''!!

build: aParser prefix: aChoiceParser

	^ aChoiceParser star , aParser map: [ :ops :term | ops reversed inject: term into: [ :result :operator | operator first value: operator second value: result ] ]!! !!

!!PPExpressionParser methodsFor: ''private'' stamp: ''FirstnameLastname 11/26/2009 20:48''!!

buildSelectors

	^ #(build:prefix: build:postfix: build:right: build:left:)!! !!

!!PPExpressionParser methodsFor: ''private'' stamp: ''lr 2/7/2010 23:23''!!

operator: aSymbol parser: aParser do: aBlock

	parser isNil

		ifTrue: [ ^ self error: ''You did not specify a term when creating the receiver.'' ].

	operators isNil

		ifTrue: [ ^ self error: ''Use #group: to define precedence groups in descending order.'' ].

	(operators at: aSymbol ifAbsentPut: [ OrderedCollection new ])

		addLast: (Array with: aParser asParser with: aBlock)!! !!

!!PPExpressionParser methodsFor: ''specifying'' stamp: ''FirstnameLastname 11/26/2009 21:26''!!

term: aParser

	"Defines the initial term aParser of the receiver."

	parser isNil

		ifTrue: [ parser := aParser ]

		ifFalse: [ self error: ''Unable to redefine the term.'' ]!! !!

!!PPExpressionParser methodsFor: ''specifying'' stamp: ''FirstnameLastname 11/26/2009 20:49''!!

postfix: aParser do: aTwoArgumentBlock

	"Define a postfix operator aParser. Evaluate aTwoArgumentBlock with the term and the operator."

	self operator: #build:postfix: parser: aParser do: aTwoArgumentBlock!! !!

!!PPExpressionParser methodsFor: ''specifying'' stamp: ''FirstnameLastname 11/26/2009 20:49''!!

left: aParser do: aThreeArgumentBlock

	"Define an operator aParser that is left-associative. Evaluate aThreeArgumentBlock with the first term, the operator, and the second term."

	self operator: #build:left: parser: aParser do: aThreeArgumentBlock!! !!

!!PPExpressionParser methodsFor: ''specifying'' stamp: ''FirstnameLastname 11/26/2009 20:49''!!

prefix: aParser do: aTwoArgumentBlock

	"Define a prefix operator aParser. Evaluate aTwoArgumentBlock with the operator and the term."

	self operator: #build:prefix: parser: aParser do: aTwoArgumentBlock!! !!

!!PPExpressionParser methodsFor: ''specifying'' stamp: ''FirstnameLastname 11/26/2009 20:49''!!

right: aParser do: aThreeArgumentBlock

	"Define an operator aParser that is right-associative. Evaluate aThreeArgumentBlock with the first term, the operator, and the second term."

	self operator: #build:right: parser: aParser do: aThreeArgumentBlock!! !!

!!PPExpressionParser methodsFor: ''specifying'' stamp: ''lr 2/7/2010 23:20''!!

group: aOneArgumentBlock

	"Defines a priority group by evaluating aOneArgumentBlock."

	operators := Dictionary new.

	parser := [ 

		aOneArgumentBlock value: self.

	 	self buildOn: parser ]

			ensure: [ operators := nil ]!! !!

PPDelegateParser subclass: #PPCompositeParser

	instanceVariableNames: ''dependencies''

	classVariableNames: ''''

	poolDictionaries: ''''

	category: ''PetitParser-Tools''!!

!!PPCompositeParser commentStamp: ''lr 12/4/2009 18:38'' prior: 0!!

A PPCompositeParser is composed parser built from various primitive parsers. 

Every production in the receiver is specified as a method that returns its parser. Note that every production requires an instance variable of the same name, otherwise the production is not cached and cannot be used in recursive grammars. Productions should refer to each other by reading the respective inst-var. Note: these inst-vars are typically not written, as the assignment happens in the initialize method using reflection.

The start production is defined in the method start. It is aliased to the inst-var parser defined in the superclass of PPCompositeParser.!!

!!PPCompositeParser methodsFor: ''querying'' stamp: ''lr 6/4/2010 13:37''!!

productionAt: aSymbol ifAbsent: aBlock

	"Answer the production named aSymbol, if there is no such production answer the result of evaluating aBlock."

	(self class ignoredNames includes: aSymbol asString)

		ifTrue: [ ^ aBlock value ].

	(self class startSymbol = aSymbol)

		ifTrue: [ ^ parser ].

	^ self instVarAt: (self class allInstVarNames

		indexOf: aSymbol asString

		ifAbsent: [ ^ aBlock value ])!! !!

!!PPCompositeParser methodsFor: ''querying'' stamp: ''lr 5/8/2011 15:45''!!

productionNames

	"Answer a dictionary of slot indexes and production names."

	| productionNames ignoredNames |

	productionNames := Dictionary new.

	ignoredNames := self class ignoredNames

		collect: [ :each | each asSymbol ].

	self class allInstVarNames keysAndValuesDo: [ :key :value |

		(ignoredNames includes: value asSymbol)

			ifFalse: [ productionNames at: key put: value asSymbol ] ].

	^ productionNames!! !!

!!PPCompositeParser methodsFor: ''querying'' stamp: ''lr 3/16/2013 21:41''!!

dependencyAt: aClass

	"Answer the dependent parser aClass. Throws an error if this parser class is not declared in the method #dependencies on the class-side of the receiver."

	^ dependencies at: aClass ifAbsent: [ self error: ''Undeclared dependency in '' , self class name , '' to '' , aClass name ]!! !!

!!PPCompositeParser methodsFor: ''querying'' stamp: ''lr 12/4/2009 18:39''!!

productionAt: aSymbol

	"Answer the production named aSymbol."

	^ self productionAt: aSymbol ifAbsent: [ nil ]!! !!

!!PPCompositeParser methodsFor: ''initialization'' stamp: ''lr 3/16/2013 17:15''!!

initializeStartingAt: aSymbol dependencies: aDictionary

	self initialize.

	parser := PPDelegateParser named: aSymbol.

	self productionNames keysAndValuesDo: [ :key :value |

		self instVarAt: key put: (PPDelegateParser named: value) ].

	dependencies := aDictionary!! !!

!!PPCompositeParser methodsFor: ''accessing'' stamp: ''lr 5/16/2008 17:32''!!

start

	"Answer the production to start this parser with."

	self subclassResponsibility!! !!

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!

PPCompositeParser class

	instanceVariableNames: ''''!!

!!PPCompositeParser class commentStamp: ''<historical>'' prior: 0!!

!!

!!PPCompositeParser class methodsFor: ''accessing'' stamp: ''lr 1/29/2010 11:35''!!

ignoredNames

	"Answer a collection of instance-variables that should not be automatically initialized with productions, but that are used internal to the composite parser."

	^ PPCompositeParser allInstVarNames!! !!

!!PPCompositeParser class methodsFor: ''accessing'' stamp: ''lr 12/7/2009 08:20''!!

startSymbol

	"Answer the method that represents the default start symbol."

	^ #start!! !!

!!PPCompositeParser class methodsFor: ''accessing'' stamp: ''lr 3/16/2013 21:42''!!

dependencies

	"Answer a collection of PPCompositeParser classes that this parser directly dependends on. Override this method in subclasses to declare dependent parsers. The default implementation does not depend on other PPCompositeParser."

	^ #()!! !!

!!PPCompositeParser class methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 12/19/2013 15:40''!!

debug: anObject startingAt: aSymbol onError: aBlock

	^ (self newStartingAt: aSymbol) debug: anObject onError: aBlock!! !!

!!PPCompositeParser class methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 12/19/2013 15:39''!!

debug: anObject startingAt: aSymbol

	^ (self newStartingAt: aSymbol) debug: anObject!! !!

!!PPCompositeParser class methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 12/19/2013 15:40''!!

debug: anObject onError: aBlock

	^ self debug: anObject startingAt: self startSymbol onError: aBlock!! !!

!!PPCompositeParser class methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 12/19/2013 15:39''!!

debug: anObject

	^ self debug: anObject startingAt: self startSymbol!! !!

!!PPCompositeParser class methodsFor: ''instance creation'' stamp: ''lr 3/16/2013 21:21''!!

newStartingAt: aSymbol

	"Answer a new parser starting at aSymbol. The code makes sure to resolve all dependent parsers correctly."

	| parsers remaining |

	parsers := IdentityDictionary new.

	remaining := OrderedCollection with: self.

	[ remaining isEmpty ] whileFalse: [

		| dependency |

		dependency := remaining removeLast.

		(parsers includesKey: dependency) ifFalse: [

			parsers at: dependency put: dependency basicNew.

			remaining addAll: dependency dependencies ] ].

	parsers keysAndValuesDo: [ :class :parser |

		| dependencies |

		dependencies := IdentityDictionary new.

		class dependencies 

			do: [ :dependency | dependencies at: dependency put: (parsers at: dependency) ].

		parser 

			initializeStartingAt: (class == self

				ifTrue: [ aSymbol ]

				ifFalse: [ class startSymbol ]) 

			dependencies: dependencies ].

	parsers keysAndValuesDo: [ :class :parser |

		parser setParser: (parser perform: parser children first name).

		parser productionNames keysAndValuesDo: [ :key :value |

			(parser instVarAt: key) setParser: (parser perform: value) ] ].

	^ parsers at: self!! !!

!!PPCompositeParser class methodsFor: ''instance creation'' stamp: ''lr 12/7/2009 08:24''!!

new

	"Answer a new parser starting at the default start symbol."

	^ self newStartingAt: self startSymbol!! !!

!!PPCompositeParser class methodsFor: ''parsing'' stamp: ''lr 2/7/2010 21:02''!!

parse: anObject onError: aBlock

	^ self parse: anObject startingAt: self startSymbol onError: aBlock!! !!

!!PPCompositeParser class methodsFor: ''parsing'' stamp: ''lr 2/7/2010 21:02''!!

parse: anObject startingAt: aSymbol onError: aBlock

	^ (self newStartingAt: aSymbol) parse: anObject onError: aBlock!! !!

!!PPCompositeParser class methodsFor: ''parsing'' stamp: ''lr 2/7/2010 20:57''!!

parse: anObject startingAt: aSymbol

	^ (self newStartingAt: aSymbol) parse: anObject!! !!

!!PPCompositeParser class methodsFor: ''parsing'' stamp: ''lr 2/7/2010 20:57''!!

parse: anObject

	^ self parse: anObject startingAt: self startSymbol!! !!

PPParser subclass: #PPUnresolvedParser

	instanceVariableNames: ''''

	classVariableNames: ''''

	poolDictionaries: ''''

	category: ''PetitParser-Tools''!!

!!PPUnresolvedParser commentStamp: ''lr 11/28/2009 18:50'' prior: 0!!

This is a temporary placeholder or forward reference to a parser that has not been defined yet. If everything goes well it will eventually be replaced with the real parser instance.!!

!!PPUnresolvedParser methodsFor: ''parsing'' stamp: ''lr 2/7/2010 20:51''!!

parseOn: aStream

	self error: self printString , '' need to be resolved before execution.''!! !!

!!PPUnresolvedParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:15''!!

displayColor

	^ Color red!! !!

!!PPUnresolvedParser methodsFor: ''testing'' stamp: ''lr 10/27/2008 11:29''!!

isUnresolved

	^ true!! !!

Object subclass: #PPParser

	instanceVariableNames: ''properties''

	classVariableNames: ''''

	poolDictionaries: ''''

	category: ''PetitParser-Parsers''!!

!!PPParser commentStamp: ''<historical>'' prior: 0!!

An abstract parser for all parsers in PetitParser. Subclasses implement #parseOn: to perform the actual recursive-descent parsing. All parsers support a variety of methods to perform an actual parse, see the methods in the #parsing protocol. Parsers are combined with a series of operators that can be found in the #operations protocol.

Instance Variables:

	properties	<Dictionary>	Stores additional state in the parser object.!!

!!PPParser methodsFor: ''*petitjava-operations'' stamp: ''sback 9/2/2010 23:01''!!

javaToken

	^ PPJavaTokenParser on: self!! !!

!!PPParser methodsFor: ''*petitgui'' stamp: ''TudorGirba 12/18/2013 06:41''!!

gtInspectorParserInspectorIn: composite

	<gtInspectorPresentationOrder: 30>

	composite custom: (

		PPVerticalParserInspector new 

			title: ''Sampler'';

			startOn: self)!! !!

!!PPParser methodsFor: ''*petitgui'' stamp: ''AlexandreBergel 12/18/2013 16:40''!!

gtGraphViewIn: composite

	<gtInspectorPresentationOrder: 50>

	composite roassal

		title: ''Graph''; 

		painting: [ :view |

			self visualizeStructureInGraphOn: view.	

		].!! !!

!!PPParser methodsFor: ''*petitgui'' stamp: ''TudorGirba 6/24/2013 23:44''!!

gtNamedTreeViewIn: composite

	<gtInspectorPresentationOrder: 40>

	composite tree

		title: ''Named Tree'';

		children: [:n | n namedChildren ];

		format: [:n| n name ifNil: [ n asString ] ];

		shouldExpandToLevel: 3!! !!

!!PPParser methodsFor: ''*petitgui'' stamp: ''TudorGirba 6/24/2013 23:44''!!

gtTreeViewIn: composite

	<gtInspectorPresentationOrder: 40>

	composite tree

			title: ''Tree'';

			children: [:n | n children ];

			format: [:n| n name ifNil: [ n asString ] ifNotNil: [n name] ];

			shouldExpandToLevel: 6!! !!

!!PPParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 1/30/2013 19:35''!!

morphicShapeDefault

	^ self newRowMorph

		addMorphBack: (self newColumnMorph

			addMorphBack: (self newSpacerMorph);

			addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1)	

				makeForwardArrow;

			yourself);

		addMorphBack: (self newRowMorph

			borderWidth: 1;

			layoutInset: 3;

			color: Color white;

			addMorphBack: (StringMorph new

				contents: self displayName;

				color: self displayColor;

				yourself);

			yourself);

		yourself!! !!

!!PPParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 11/18/2009 10:56''!!

morphicProduction

	^ self newRowMorph

		layoutInset: 4;

		addMorphBack: (self newRowMorph

			layoutInset: 4;

			addMorphBack: (StringMorph new

				contents: self displayName;

				emphasis: TextEmphasis bold emphasisCode;

				yourself);

			yourself);

		addMorphBack: (self morphicShapeSeen: IdentitySet new depth: 0);

		addMorphBack: (self newColumnMorph

			addMorphBack: (self newSpacerMorph);

			addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1)	

				makeForwardArrow;

			yourself);

		yourself!! !!

!!PPParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 11/13/2009 13:24''!!

morphicShapeSeen: aSet depth: anInteger

	^ self morphicShapeDefault!! !!

!!PPParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 11/13/2009 13:43''!!

morphicShapeSeen: aSet depth: anInteger do: aBlock

	" avoid recursion "

	(aSet includes: self)

		ifTrue: [ ^ self morphicShapeDefault ].

	" display nice name when possible "

	(anInteger > 0 and: [ self name notNil ]) 

		ifTrue: [ ^ self morphicShapeDefault ].

	" don''t do it too deep "

	(anInteger > 10)

		ifTrue: [ ^ self morphicShapeDefault ].

	aSet add: self. 

	^ aBlock value: [ :parser |

		parser 

			morphicShapeSeen: aSet 

			depth: anInteger + 1 ]!! !!