"{ 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
	super updateContext: aPPContext.
"	
	aPPContext globalAt: #comment ifAbsentPut: [ self comment ].
	aPPContext globalAt: #whitespace ifAbsentPut: [  PPSmalltalkWhitespaceParser new ].
"
! !

!PPSmalltalkGrammar methodsFor:'*petitcompiler'!

whitespace
	^ #space asParser plus
! !

!PPSmalltalkTokenParser methodsFor:'*petitcompiler'!

compileWith: aPetitCompiler

	^ aPetitCompiler compileSmalltalkToken: self.
! !

!PPSmalltalkTokenParser methodsFor:'*petitcompiler'!

parseOnX: aPPContext
	| memento comments token |

	memento := aPPContext remember.
	comments := self
		parseComments: #()
		on: aPPContext.
	token := super parseOn: aPPContext.
	token isPetitFailure ifTrue: [
		aPPContext restore: memento.
		^ token ].
	comments := self
		parseComments: comments
		on: aPPContext.
	^ token comments: comments
! !

!PPSmalltalkTokenParser methodsFor:'*petitcompiler'!

updateContext: aPPContext
	aPPContext globalAt: #whitespace ifAbsentPut: PPSmalltalkWhitespaceParser new
! !

!PPSmalltalkTokenParser methodsFor:'*petitcompiler'!

whitespace
	^ PPSmalltalkWhitespaceParser new
! !

!PPSmalltalkWhitespaceParser methodsFor:'*petitcompiler'!

= anotherParser
	anotherParser == self ifTrue: [ ^ true ].
	anotherParser class = self class ifFalse: [ ^ false ].
 ^ anotherParser name = self name
! !

!PPSmalltalkWhitespaceParser methodsFor:'*petitcompiler'!

acceptsEpsilon
	^ true
! !

!PPSmalltalkWhitespaceParser methodsFor:'*petitcompiler'!

acceptsEpsilonOpenSet: set
	^ true
! !

!PPSmalltalkWhitespaceParser methodsFor:'*petitcompiler'!

firstCharSet
	^ PPCharSetPredicate on: [:e | false ] 
! !

!PPStream methodsFor:'*petitcompiler'!

peek: anInteger
	| endPosition |
	endPosition := position + anInteger  min:  readLimit.
	^ collection copyFrom: position+1 to: endPosition.
! !

!PPToken methodsFor:'*petitcompiler'!

= anObject
	^ self class = anObject class and: [ self inputValue = anObject inputValue ]
! !

!PPToken methodsFor:'*petitcompiler'!

hash
	^ self inputValue hash
! !

!PPToken methodsFor:'*petitcompiler'!

isToken
	^ true
! !

!PPTokenParser methodsFor:'*petitcompiler'!

asCompilerNode
	^ PPCTokenNode new
		name: self name;
		tokenClass: self tokenClass;
		child: parser;
		yourself
! !

!PPTokenParser methodsFor:'*petitcompiler'!

displayName
	^ 'TOKEN[', parser displayName, ']'
! !

!PPTokenParser methodsFor:'*petitcompiler'!

firstSets: aFirstDictionary into: aSet
	"Or keep empty, if token is a terminal"
	^ super firstSets: aFirstDictionary  into: aSet 
! !

!PPTokenParser methodsFor:'*petitcompiler'!

isFirstSetTerminal
	^ false
! !

!PPTokenParser methodsFor:'*petitcompiler'!

isTokenParser
	^ true
! !

!PPTokenParser methodsFor:'*petitcompiler'!

optimize
	^ self transform: [ :each | each optimized ]
! !

!PPTokenParser methodsFor:'*petitcompiler'!

parser
	^ parser
! !

!PPTokenParser methodsFor:'*petitcompiler'!

startsWith: aCharacter
	self first do: [:first | (first startsWith: aCharacter) ifTrue: [ ^ true ] ].
	^ false
! !

!PPTokenParser methodsFor:'*petitcompiler'!

whitespace
	^ self class whitespace 
! !

!PPTrimmingParser methodsFor:'*petitcompiler'!

asCompilerNode
	^ PPCTrimNode new
		child: parser;
		name: self name;
		yourself
! !

!PPTrimmingParser methodsFor:'*petitcompiler'!

compileWith: aPetitCompiler
	^ aPetitCompiler compileTrim: self.
! !

!PPTrimmingParser methodsFor:'*petitcompiler'!

firstSets: aFirstDictionary into: aSet
	super firstSets: aFirstDictionary into: aSet
! !

!UndefinedObject methodsFor:'*petitcompiler'!

asInteger
	^ 256
! !

!UndefinedObject methodsFor:'*petitcompiler'!

isAlphaNumeric
	^ false
! !

!UndefinedObject methodsFor:'*petitcompiler'!

isDigit
	^ false
! !

!UndefinedObject methodsFor:'*petitcompiler'!

isLetter
	^ false
! !

!UndefinedObject methodsFor:'*petitcompiler'!

isSeparator
	^ false
! !

!stx_goodies_petitparser_compiler class methodsFor:'documentation'!

extensionsVersion_HG

    ^ '$Changeset: <not expanded> $'
! !