--- a/PPPredicateObjectParser.st Mon Apr 13 14:19:55 2015 +0100
+++ b/PPPredicateObjectParser.st Mon Apr 13 22:00:44 2015 +0100
@@ -1,5 +1,7 @@
"{ Package: 'stx:goodies/petitparser' }"
+"{ NameSpace: Smalltalk }"
+
PPPredicateParser subclass:#PPPredicateObjectParser
instanceVariableNames:''
classVariableNames:''
@@ -7,6 +9,13 @@
category:'PetitParser-Parsers'
!
+PPPredicateObjectParser class instanceVariableNames:'cache'
+
+"
+ No other class instance variables are inherited by this class.
+"
+!
+
!PPPredicateObjectParser class methodsFor:'instance creation'!
@@ -23,10 +32,33 @@
^ 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 chars: (String with: Character space with: Character tab) message: 'blank expected'
+ ^self
+ cacheAt: #'blank'
+ ifAbsentPut: [ self
+ chars: (String with: Character space with: Character tab) message: 'blank expected' ]
!
char: aCharacter
@@ -42,64 +74,90 @@
!
cr
- ^ self char: (Character codePoint: 13) message: 'carriage return expected'
+ ^self
+ cacheAt: #'cr'
+ ifAbsentPut: [ self char: (Character codePoint: 13) message: 'carriage return expected' ]
!
digit
- ^ self on: (PPCharSetPredicate on: [ :char | char isDigit ]) message: 'digit expected'
+ ^self
+ cacheAt: #'digit'
+ ifAbsentPut: [ self on: (PPCharSetPredicate on: [ :char | char isDigit ]) message: 'digit expected' ]
!
hex
- ^ self
+ ^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'
+ message: 'hex digit expected' ]
!
letter
- ^ self on: (PPCharSetPredicate on: [ :char | char isLetter ]) message: 'letter expected'
+ ^self
+ cacheAt: #'letter'
+ ifAbsentPut: [ self on: (PPCharSetPredicate on: [ :char | char isLetter ]) message: 'letter expected' ]
!
lf
- ^ self char: (Character codePoint: 10)
+ ^self
+ cacheAt: #'lf'
+ ifAbsentPut: [ self char: (Character codePoint: 10) ]
!
lowercase
- ^ self on: (PPCharSetPredicate on: [ :char | char isLowercase ]) message: 'lowercase letter expected'
+ ^self
+ cacheAt: #'lowercase'
+ ifAbsentPut: [ 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'
+ ^self
+ cacheAt: #'newline'
+ ifAbsentPut: [ self chars: (String with: (Character codePoint: 13) with: (Character codePoint: 10)) message: 'newline expected' ]
!
punctuation
- ^ self chars: '.,"''?!!;:#$%&()*+-/<>=@[]\^_{}|~' message: 'punctuation expected'
+ ^self
+ cacheAt: #'punctuation'
+ ifAbsentPut: [ self chars: '.,"''?!!;:#$%&()*+-/<>=@[]\^_{}|~' message: 'punctuation expected' ]
!
space
- ^ self on: (PPCharSetPredicate on: [ :char | char isSeparator ]) message: 'separator expected'
+ ^self
+ cacheAt: #'space'
+ ifAbsentPut: [ self on: (PPCharSetPredicate on: [ :char | char isSeparator ]) message: 'separator expected' ]
!
tab
- ^ self char: Character tab message: 'tab expected'
+ ^self
+ cacheAt: #'tab'
+ ifAbsentPut: [ self char: Character tab message: 'tab expected' ]
!
uppercase
- ^ self on: (PPCharSetPredicate on: [ :char | char isUppercase ]) message: 'uppercase letter expected'
+ ^self
+ cacheAt: #'uppercase'
+ ifAbsentPut: [ self on: (PPCharSetPredicate on: [ :char | char isUppercase ]) message: 'uppercase letter expected' ]
!
word
- ^ self on: (PPCharSetPredicate on: [ :char | char isAlphaNumeric ]) message: 'letter or digit expected'
+ ^self
+ cacheAt: #'word'
+ ifAbsentPut: [ 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'
+ ^self
+ cacheAt: #'any'
+ ifAbsentPut: [ self
+ on: [ :each | true ] message: 'input expected'
+ negated: [ :each | false ] message: 'no input expected' ]
!
anyExceptAnyOf: aCollection
@@ -125,6 +183,11 @@
^ PPEndOfLineParser new.
!
+eof
+
+ ^ PPEndOfFileParser new
+!
+
expect: anObject
^ self expect: anObject message: anObject printString , ' expected'
!
@@ -133,9 +196,18 @@
^ 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