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

"{ NameSpace: Smalltalk }"

PPPredicateParser subclass:#PPPredicateObjectParser

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	category:'PetitParser-Parsers'

!

PPPredicateObjectParser class instanceVariableNames:'cache'

"

 No other class instance variables are inherited by this class.

"

!

!PPPredicateObjectParser class methodsFor:'instance creation'!

on: aBlock message: aString

	^ self on: aBlock message: aString negated: [ :each | (aBlock value: each) not ] message: 'no ' , aString

!

on: aBlock message: aString negated: aNegatedBlock message: aNegatedString

	^ self new initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString

!

startOfLine

	^ PPStartOfLineParser new.

! !

!PPPredicateObjectParser class methodsFor:'cache'!

cacheAt: aSymbol ifAbsentPut: aBlock

	cache ifNil: [ ^aBlock value ].

	^(cache

		at: aSymbol

		ifAbsentPut: aBlock) copy

!

useCache: aBoolean

"

	PPPredicateObjectParser useCache: true.

	PPPredicateObjectParser useCache: false.

"

	cache := aBoolean 

		ifTrue: [ Dictionary new ]

		ifFalse: [ nil ]

! !

!PPPredicateObjectParser class methodsFor:'factory-chars'!

blank

	^self

		cacheAt: #'blank'

		ifAbsentPut: [ self

			chars: (String with: Character space with: Character tab) message: 'blank expected' ]

!

char: aCharacter

	^ self expect: aCharacter message: (String with: $" with: aCharacter with: $") , ' expected'

!

char: aCharacter message: aString

	^ self expect: aCharacter message: aString

!

chars: aCollection message: aString

	^ self on: (PPCharSetPredicate on: [ :char | aCollection includes: char ]) message: aString

!

cr

	^self

		cacheAt: #'cr'

		ifAbsentPut: [ self char: (Character codePoint: 13) message: 'carriage return expected' ]

!

digit

	^self

		cacheAt: #'digit'

		ifAbsentPut: [ self on: (PPCharSetPredicate on: [ :char | char isDigit ]) message: 'digit expected' ]

!

hex

	^self

		cacheAt: #'hex'

		ifAbsentPut: [ self

		on: (PPCharSetPredicate on: [ :char | 

			(char between: $0 and: $9) 

				or: [ (char between: $a and: $f) 

				or: [ (char between: $A and: $F) ] ] ])

		message: 'hex digit expected' ]

!

letter

	^self

		cacheAt: #'letter'

		ifAbsentPut: [ self on: (PPCharSetPredicate on: [ :char | char isLetter ]) message: 'letter expected' ]

!

lf

	^self

		cacheAt: #'lf'

		ifAbsentPut: [ self char: (Character codePoint: 10) ]

!

lowercase

	^self

		cacheAt: #'lowercase'

		ifAbsentPut: [ self on: (PPCharSetPredicate on: [ :char | char isLowercase ]) message: 'lowercase letter expected' ]

!

newline

	^self

		cacheAt: #'newline'

		ifAbsentPut: [ self chars: (String with: (Character codePoint: 13) with: (Character codePoint: 10)) message: 'newline expected' ]

!

punctuation

	^self

		cacheAt: #'punctuation'

		ifAbsentPut: [ self chars: '.,"''?!!;:#$%&()*+-/<>=@[]\^_{}|~' message: 'punctuation expected' ]

!

space

	^self

		cacheAt: #'space'

		ifAbsentPut: [ self on: (PPCharSetPredicate on: [ :char | char isSeparator ]) message: 'separator expected' ]

!

tab

	^self

		cacheAt: #'tab'

		ifAbsentPut: [ self char: Character tab message: 'tab expected' ]

!

uppercase

	^self

		cacheAt: #'uppercase'

		ifAbsentPut: [ self on: (PPCharSetPredicate on: [ :char | char isUppercase ]) message: 'uppercase letter expected' ]

!

word

	^self

		cacheAt: #'word'

		ifAbsentPut: [ self on: (PPCharSetPredicate on: [ :char | char isAlphaNumeric ]) message: 'letter or digit expected' ]

! !

!PPPredicateObjectParser class methodsFor:'factory-objects'!

any

	^self

		cacheAt: #'any'

		ifAbsentPut: [ self

			on: [ :each | true ] message: 'input expected'

			negated: [ :each | false ] message: 'no input expected' ]

!

anyExceptAnyOf: aCollection

	^ self

		on: [ :each | (aCollection includes: each) not ] message: 'any except ' , aCollection printString , ' expected'

		negated: [ :each | aCollection includes: each ] message: aCollection printString ,  ' not expected'

!

anyOf: aCollection

	^ self

		on: [ :each | aCollection includes: each ] message: 'any of ' , aCollection printString , ' expected'

		negated: [ :each | (aCollection includes: each) not ] message: 'none of ' , aCollection printString ,  'expected'

!

between: min and: max

	^ self

		on: [ :each | each >= min and: [ each <= max ] ] message: min printString , '..' , max printString , ' expected'

		negated: [ :each | each < min or: [ each > max ] ] message: min printString , '..' , max printString , ' not expected'

!

endOfLine

	^ PPEndOfLineParser new.

!

eof

	^ PPEndOfFileParser new

!

expect: anObject

	^ self expect: anObject message: anObject printString , ' expected'

!

expect: anObject message: aString

	^ self 

		on: [ :each | each = anObject ] message: aString

		negated: [ :each | each ~= anObject ] message: 'no ' , aString

!

startOfLogicalLine

	^ PPStartOfLogicalLineParser new.

!

startOfWord

	^ PPStartOfWordParser new.

! !

!PPPredicateObjectParser methodsFor:'initialization'!

initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString

	predicate := aBlock.

	predicateMessage := aString.

	negated := aNegatedBlock.

	negatedMessage := aNegatedString

! !

!PPPredicateObjectParser methodsFor:'operators'!

negate

	"Answer a parser that is the negation of the receiving predicate parser."

	^ self class 

		on: negated message: negatedMessage 

		negated: predicate message: predicateMessage

! !

!PPPredicateObjectParser methodsFor:'parsing'!

parseOn: aPPContext

	^ (aPPContext atEnd not and: [ predicate value: aPPContext uncheckedPeek ])

		ifFalse: [ PPFailure message: predicateMessage context: aPPContext ]

		ifTrue: [ aPPContext next ]

! !

!PPPredicateObjectParser class methodsFor:'documentation'!

version

    ^ '$Header: /cvs/stx/stx/goodies/petitparser/PPPredicateObjectParser.st,v 1.5 2014-03-04 14:33:20 cg Exp $'

!

version_CVS

    ^ '$Header: /cvs/stx/stx/goodies/petitparser/PPPredicateObjectParser.st,v 1.5 2014-03-04 14:33:20 cg Exp $'

!

version_HG

    ^ '$Changeset: <not expanded> $'

!

version_SVN

    ^ '$Id: PPPredicateObjectParser.st,v 1.5 2014-03-04 14:33:20 cg Exp $'

! !