Merged PetitParser and PetitTests
Name: PetitParser-JanKurs.253
Author: JanKurs
Time: 30-10-2014, 03:55:46 AM
UUID: c7100f9c-e875-4453-8f26-e0c91dd49b91
Name: PetitTests-JanKurs.63
Author: JanKurs
Time: 30-10-2014, 12:54:37 PM
UUID: 7afbeef7-eadf-4d65-bce5-7204e2727edb
"{ Package: 'stx:goodies/petitparser' }"
PPPredicateParser subclass:#PPPredicateObjectParser
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
category:'PetitParser-Parsers'
!
!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:'factory-chars'!
blank
^ 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 char: (Character codePoint: 13) message: 'carriage return expected'
!
digit
^ self on: (PPCharSetPredicate on: [ :char | char isDigit ]) message: 'digit expected'
!
hex
^ 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 on: (PPCharSetPredicate on: [ :char | char isLetter ]) message: 'letter expected'
!
lf
^ self char: (Character codePoint: 10)
!
lowercase
^ self on: (PPCharSetPredicate on: [ :char | char isLowercase ]) message: 'lowercase letter expected'
!
newline
^ self chars: (String with: (Character codePoint: 13) with: (Character codePoint: 10)) message: 'newline expected'
!
punctuation
^ self chars: '.,"''?!!;:#$%&()*+-/<>=@[]\^_{}|~' message: 'punctuation expected'
!
space
^ self on: (PPCharSetPredicate on: [ :char | char isSeparator ]) message: 'separator expected'
!
tab
^ self char: Character tab message: 'tab expected'
!
uppercase
^ self on: (PPCharSetPredicate on: [ :char | char isUppercase ]) message: 'uppercase letter expected'
!
word
^ self on: (PPCharSetPredicate on: [ :char | char isAlphaNumeric ]) message: 'letter or digit expected'
! !
!PPPredicateObjectParser class methodsFor:'factory-objects'!
any
^ 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.
!
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
! !
!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 $'
! !