PPPredicateObjectParser.st
changeset 427 a7f5e6de19d2
parent 405 0470a5e6e712
child 650 4c6ed0a28d18
--- 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