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

!Character methodsFor:'*petitcompiler'!

ppcPrintable

	^ self asInteger > 31 and: [ self asInteger < 127 ]

! !

!Object methodsFor:'*petitcompiler'!

isInlinedMethod

	^ false

! !

!PPActionParser methodsFor:'*petitcompiler'!

asCompilerNode

	^ PPCActionNode new

		name: self name;

		block: block;

		child: parser;

		properties: properties;

		yourself

! !

!PPActionParser methodsFor:'*petitcompiler'!

compileWith: aPetitCompiler

	block isSymbol ifTrue: [  

		^ aPetitCompiler compileSymbolBlock: block for: self 

	].

	^ aPetitCompiler compileBlock: block for: self

! !

!PPAndParser methodsFor:'*petitcompiler'!

asCompilerNode

	^ PPCAndNode new

		name: self name;

		child: parser;

		yourself

! !

!PPCharSetPredicate methodsFor:'*petitcompiler'!

block

	^ block

! !

!PPCharSetPredicate methodsFor:'*petitcompiler'!

classification

	^ classification

! !

!PPCharSetPredicate methodsFor:'*petitcompiler'!

equals: anotherPredicate

	self == anotherPredicate ifTrue: [ ^ true ].

	self class == anotherPredicate class ifFalse: [ ^ false ].

	^ classification  = anotherPredicate classification.

! !

!PPChoiceParser methodsFor:'*petitcompiler'!

asCompilerNode

	^ PPCChoiceNode new

		name: self name;

		children: parsers;

		yourself

! !

!PPChoiceParser methodsFor:'*petitcompiler'!

compileWith: aPetitCompiler

	^ aPetitCompiler compileChoice: self

! !

!PPContext methodsFor:'*petitcompiler'!

asCompiledParserContext

	^ PPCContext new

		stream: stream;

		yourself

! !

!PPContext methodsFor:'*petitcompiler'!

comment

	^ self globalAt: #comment ifAbsent: [ nil ].

! !

!PPContext methodsFor:'*petitcompiler'!

comment: value

	^ self globalAt: #comment put: value

! !

!PPContext methodsFor:'*petitcompiler'!

compiledParser

	^ self globalAt: #compiledParser

! !

!PPContext methodsFor:'*petitcompiler'!

compiledParser: aPPParser

	^ self globalAt: #compiledParser put: aPPParser

! !

!PPContext methodsFor:'*petitcompiler'!

lwRemember

	^ self position

! !

!PPContext methodsFor:'*petitcompiler'!

lwRestore: position

	^ self position: position

! !

!PPContext methodsFor:'*petitcompiler'!

peek: anInteger

	^ stream peek: anInteger

! !

!PPContext methodsFor:'*petitcompiler'!

whitespace

	^ self globalAt: #whitespace ifAbsent: [ nil ].

! !

!PPContext methodsFor:'*petitcompiler'!

whitespace: value

	^ self globalAt: #whitespace put: value

! !

!PPDelegateParser methodsFor:'*petitcompiler'!

asCompilerNode

	self class == PPDelegateParser ifTrue: [ 

		^ PPCForwardNode new

			name: self name;

			child: parser;

			yourself

	].

	^ super asCompilerNode 

! !

!PPDelegateParser methodsFor:'*petitcompiler'!

compileWith: aPetitCompiler

	(self class == PPDelegateParser) ifTrue: [ 

		(self name notNil and: [ parser name isNil ]) ifTrue: [ 

			parser name: self name.

			^ parser compileWith: aPetitCompiler.

		].

		(self name notNil and: [ parser name notNil ]) ifTrue: [ 

			^ aPetitCompiler compileDelegate: self.

		]

	].

	^ super compileWith: aPetitCompiler.

! !

!PPEpsilonParser methodsFor:'*petitcompiler'!

asCompilerNode

	^ PPCNilNode new

! !

!PPEpsilonParser methodsFor:'*petitcompiler'!

compileWith: aPetitCompiler

	^ aPetitCompiler compileNil

! !

!PPFailure methodsFor:'*petitcompiler'!

context: aPPContext

	context := aPPContext

! !

!PPFailure methodsFor:'*petitcompiler'!

message: text

	message := text

! !

!PPFailure methodsFor:'*petitcompiler'!

position: anInteger

	position := anInteger

! !

!PPLiteralObjectParser methodsFor:'*petitcompiler'!

asCompilerNode

	^ PPCCharacterNode new

		character: literal;

		name: self name;

		yourself

! !

!PPLiteralObjectParser methodsFor:'*petitcompiler'!

compileWith: aPetitCompiler

	^ aPetitCompiler compileCharacter: literal.

! !

!PPLiteralParser methodsFor:'*petitcompiler'!

id

	^ literal printString

! !

!PPLiteralSequenceParser methodsFor:'*petitcompiler'!

asCompilerNode

	^ PPCLiteralNode new

		literal: literal;

		name: self name;

		yourself

! !

!PPLiteralSequenceParser methodsFor:'*petitcompiler'!

compileWith: aPetitCompiler

	^ aPetitCompiler compileLiteral: literal.

! !

!PPNotParser methodsFor:'*petitcompiler'!

asCompilerNode

	^ PPCNotNode new 

		child: parser;

		name: self name;

		yourself

! !

!PPNotParser methodsFor:'*petitcompiler'!

compileWith: aPetitCompiler

	^ aPetitCompiler compileNot: self

! !

!PPOptionalParser methodsFor:'*petitcompiler'!

asCompilerNode

	^ PPCOptionalNode new

		name: self name;

		child: parser;

		yourself

"	^ super asCompilerNode "

! !

!PPOptionalParser methodsFor:'*petitcompiler'!

compileWith: aPetitCompiler

	^ aPetitCompiler compileOptional: self

! !

!PPParser methodsFor:'*petitcompiler'!

asCompilerNode

	^ PPCUnknownNode new

		parser: self;

		name: self name;

		yourself

! !

!PPParser methodsFor:'*petitcompiler'!

asCompilerTree

	^ self transform: [ :p | p asCompilerNode  ]

! !

!PPParser methodsFor:'*petitcompiler'!

bridge

	^ self

! !

!PPParser methodsFor:'*petitcompiler'!

compile

	^ self compile: #PPGeneratedParser

! !

!PPParser methodsFor:'*petitcompiler'!

compile: name

	^ self compile: name parameters: #()

! !

!PPParser methodsFor:'*petitcompiler'!

compile: name andParse: input

	^ (self compile: name) parse: input

! !

!PPParser methodsFor:'*petitcompiler'!

compile: name parameters: params

	^ (PPCCompiler new parameters: params; compile: self as: name) new

! !

!PPParser methodsFor:'*petitcompiler'!

compileWith: aPetitCompiler

	| compiled |

	self children do: [ :child |

		compiled := child compileWith: aPetitCompiler.

		self replace: child with: compiled bridge.

	].

	^ aPetitCompiler compileBridgeTo: self

! !

!PPParser methodsFor:'*petitcompiler'!

compileWithParameters: params

	^ self compile: #PPGeneratedParser parameters: params

! !

!PPParser methodsFor:'*petitcompiler'!

firstSetSuchThat: block

	^ self firstSetSuchThat: block into: (OrderedCollection new) openSet: IdentitySet new.

! !

!PPParser methodsFor:'*petitcompiler'!

firstSetSuchThat: block into: aCollection openSet: aSet

	(aSet includes: self) ifTrue: [ ^ aCollection ].

	aSet add: self.

	(block value: self) ifTrue: [aCollection add: self. ^ aCollection ].

	self children do: [ :child | 

		child firstSetSuchThat: block into: aCollection openSet: aSet 

	].

	^ aCollection

! !

!PPParser methodsFor:'*petitcompiler'!

id

	self name ifNotNil: [ ^ self name ].

	^ self hash asString

! !

!PPParser methodsFor:'*petitcompiler'!

isCompiled

	^ false

! !

!PPParser methodsFor:'*petitcompiler'!

isContextFree

	^ self propertyAt: #isContextFree ifAbsentPut: 

		[ self allParsers allSatisfy: [ :p | p isContextFreePrim ] ].

! !

!PPParser methodsFor:'*petitcompiler'!

isContextFreePrim

	^ true

! !

!PPParser methodsFor:'*petitcompiler'!

isToken

	^ false

! !

!PPParser methodsFor:'*petitcompiler'!

isTokenParser

	^ false

! !

!PPParser methodsFor:'*petitcompiler'!

optimize

	^ self copy

! !

!PPParser methodsFor:'*petitcompiler'!

optimized

	^ self copy

! !

!PPParser methodsFor:'*petitcompiler'!

trimmingToken

	| ws |

	ws := #space asParser star.

	^ ((ws, (PPTokenParser on: self), ws) ==> #second)

		propertyAt: #trimmingToken put: true;

		yourself

! !

!PPPluggableParser methodsFor:'*petitcompiler'!

acceptsEpsilon

	^ true

! !

!PPPluggableParser methodsFor:'*petitcompiler'!

asCompilerNode

	^ PPCPluggableNode new

		block: block;

		name: self name;

		yourself

! !

!PPPossessiveRepeatingParser methodsFor:'*petitcompiler'!

asCompilerNode

	((self min = 0) and: [ self max = SmallInteger maxVal ]) ifTrue: [

		^ PPCStarNode new

			name: self name;

			child: parser;

			yourself

	].

	((self min = 1) and: [ self max = SmallInteger maxVal ]) ifTrue: [

		^ PPCPlusNode new

			name: self name;

			child: parser;

			yourself

	].

	^ super asCompilerNode

! !

!PPPossessiveRepeatingParser methodsFor:'*petitcompiler'!

compileWith: aPetitCompiler

	((self min = 1) and: [ self max = SmallInteger maxVal ]) ifTrue: [

		^ aPetitCompiler compilePlus: self.

	].	

	((self min = 0) and: [ self max = SmallInteger maxVal ]) ifTrue: [

		^ aPetitCompiler compileStar: self.

	].

	^ super compileWith: aPetitCompiler.

! !

!PPPredicateObjectParser methodsFor:'*petitcompiler'!

asCompilerNode

	^ PPCPredicateNode new

		name: self name;

		predicate: predicate;

		yourself

! !

!PPPredicateObjectParser methodsFor:'*petitcompiler'!

compileWith: aPetitCompiler

	(predicateMessage  = 'input expected') ifTrue: [  

		^ aPetitCompiler compileAny.

	].

	^ aPetitCompiler compilePredicate: predicate.

! !

!PPPredicateObjectParser methodsFor:'*petitcompiler'!

firstCharSet

	^ predicate

! !

!PPPredicateObjectParser methodsFor:'*petitcompiler'!

firstCharSetCached

	^ predicate

! !

!PPSequenceParser methodsFor:'*petitcompiler'!

asCompilerNode

	^ PPCSequenceNode new

		children: parsers;

		name: self name;

		properties: properties;

		yourself

! !

!PPSequenceParser methodsFor:'*petitcompiler'!

compileWith: aPetitCompiler

	^ aPetitCompiler compileSequence: self.

! !

!PPSequenceParser methodsFor:'*petitcompiler'!

firstSetSuchThat: block into: aCollection openSet: aSet

	(aSet includes: self) ifTrue: [ ^ aCollection ].

	aSet add: self.

	(block value: self) ifTrue: [ aCollection add: self. ^ aCollection ].

	self children do: [ :child | 

		child firstSetSuchThat: block into: aCollection openSet: aSet.

		child acceptsEpsilon ifFalse: [ ^ aCollection ]

	].

	^ aCollection

! !

!PPSmalltalkGrammar methodsFor:'*petitcompiler'!

comment

 	^ $" asParser, $" asParser negate star, $" asParser.	

! !

!PPSmalltalkGrammar methodsFor:'*petitcompiler'!

updateContext: aPPContext