Remove Pharoisms to make code more portable and running on Smalltalk/X
* Use ANSI `(Character codePoint: 13)` (`10`) instead of `Character cr` (`lf`), This is more portable
and does not depend on dialects interpretation of `#cr` - Smalltalk/X convert it according to
platform line end convention (UNIX/Windows/Mac)
* Do not assume exact value of a printstring in tests, i.e., instead of
`msg includesSubstring: '$a'
code
`msg includesSubstring: $a printString.
This way, the test is independent on the printString value, which may differ among dialects.
Q: Is printString value of String and/or Character defined in ANSI?
* In assestions, instead of `#equals:` use plain old `#=`, which is more portable.
* Removed Character>>- used to create range parser. Use portable `(Interval from: $a to: $z) asParser`
instead of just `$a - $z`. Do not use ($a to: $z) asParser as in Pharo, Character>>to:
does not create an Interval but an Array (sigh).
"{ 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
^ PPStartOfLine 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'
"Modified: / 03-10-2014 / 23:56:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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 lf
!
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'
"Modified: / 03-10-2014 / 23:56:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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'
!
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_SVN
^ '$Id: PPPredicateObjectParser.st,v 1.5 2014-03-04 14:33:20 cg Exp $'
! !