SystemOrganization addCategory: #'PetitBeta-Parser'! SystemOrganization addCategory: #'PetitBeta-Bindings'! SystemOrganization addCategory: #'PetitBeta-Compound'! SystemOrganization addCategory: #'PetitBeta-Optimizer'! SystemOrganization addCategory: #'PetitBeta-Writer'! !PPChoiceParser methodsFor: '*petitbeta-bindings' stamp: 'lr 5/6/2011 23:12'! basicAccessor: aString named: aSymbol seen: aSet 1 to: self children size do: [ :index | ((self children at: index) accessor: '(' , aString , ') at: ' , index asNumber asString named: aSymbol seen: aSet) ifNotNil: [ :accessor | ^ accessor ] ]. ^ super basicAccessor: aString named: aSymbol seen: aSet! ! !PPChoiceParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 18:01'! writeDartOn: aWriter aWriter write: parsers first. parsers allButFirst do: [ :each | aWriter stream nextPutAll: '.or('. aWriter write: each. aWriter stream nextPutAll: ')' ]! ! !PPChoiceParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 18:01'! writeJavaOn: aWriter aWriter write: parsers first. parsers allButFirst do: [ :each | aWriter stream nextPutAll: '.or('. aWriter write: each. aWriter stream nextPutAll: ')' ]! ! !PPChoiceParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 18:01'! writeSmalltalkOn: aWriter aWriter stream nextPut: $(. aWriter write: parsers first. parsers allButFirst do: [ :each | aWriter stream nextPutAll: ' / '. aWriter write: each ]. aWriter stream nextPut: $) ! ! PPCompositeParserTest subclass: #PPArithmeticEvaluatorTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Compound'! !PPArithmeticEvaluatorTest methodsFor: 'events' stamp: 'lr 5/8/2011 14:50'! add: anObject and: aCollection ^ aCollection inject: anObject into: [ :a :b | a + b ] ! ! !PPArithmeticEvaluatorTest methodsFor: 'events' stamp: 'lr 5/8/2011 14:50'! mul: anObject and: aCollection ^ aCollection inject: anObject into: [ :a :b | a * b ] ! ! !PPArithmeticEvaluatorTest methodsFor: 'events' stamp: 'lr 5/8/2011 14:54'! number: anObject ^ anObject asNumber! ! !PPArithmeticEvaluatorTest methodsFor: 'events' stamp: 'lr 5/8/2011 14:50'! parens: anObject ^ anObject! ! !PPArithmeticEvaluatorTest methodsFor: 'accessing' stamp: 'lr 5/8/2011 19:42'! parserInstance ^ (PPArithmeticCompoundParser on: self) optimize! ! !PPArithmeticEvaluatorTest methodsFor: 'testing' stamp: 'lr 5/8/2011 15:10'! testAddition self assert: parser parse: '1 + 2' to: 3! ! !PPArithmeticEvaluatorTest methodsFor: 'testing' stamp: 'lr 5/8/2011 15:11'! testMixed self assert: parser parse: '1 + 2 * 3' to: 7! ! !PPArithmeticEvaluatorTest methodsFor: 'testing' stamp: 'lr 5/8/2011 15:11'! testMultiplication self assert: parser parse: '2 * 3' to: 6! ! !PPArithmeticEvaluatorTest methodsFor: 'testing' stamp: 'lr 5/8/2011 15:10'! testNumber self assert: parser parse: '123' to: 123! ! PPCompositeParserTest subclass: #PPArithmeticPrinterTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Compound'! !PPArithmeticPrinterTest methodsFor: 'events' stamp: 'lr 5/8/2011 14:51'! add: anObject and: aCollection ^ aCollection inject: anObject into: [ :a :b | a , ' + ' , b ] ! ! !PPArithmeticPrinterTest methodsFor: 'events' stamp: 'lr 5/8/2011 14:51'! mul: anObject and: aCollection ^ aCollection inject: anObject into: [ :a :b | a , ' * ' , b ] ! ! !PPArithmeticPrinterTest methodsFor: 'events' stamp: 'lr 5/8/2011 14:54'! parens: anObject ^ '(' , anObject , ')'! ! !PPArithmeticPrinterTest methodsFor: 'accessing' stamp: 'lr 5/8/2011 15:09'! parserInstance ^ PPArithmeticCompoundParser on: self! ! !PPArithmeticPrinterTest methodsFor: 'testing' stamp: 'lr 5/8/2011 15:11'! testAddition self assert: parser parse: '1 + 2' to: '1 + 2'! ! !PPArithmeticPrinterTest methodsFor: 'testing' stamp: 'lr 5/8/2011 15:11'! testMixed self assert: parser parse: '1 + 2 * 3' to: '1 + 2 * 3'! ! !PPArithmeticPrinterTest methodsFor: 'testing' stamp: 'lr 5/8/2011 15:11'! testMultiplication self assert: parser parse: '2 * 3' to: '2 * 3'! ! !PPArithmeticPrinterTest methodsFor: 'testing' stamp: 'lr 5/8/2011 15:11'! testNumber self assert: parser parse: '123' to: '123'! ! PPActionParser subclass: #PPCaptureParser instanceVariableNames: 'arguments collections bindings' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Bindings'! !PPCaptureParser commentStamp: 'lr 5/7/2011 15:47' prior: 0! The capture parser has no special parsing behavior and just delegates to another parser. It however captures the result of the parse and makes it avialable to other users. Instance Variables: variables ! !PPCaptureParser methodsFor: 'private' stamp: 'lr 5/7/2011 21:03'! argumentNames "Answer a collection of block argument names as symbols. Other Smalltalk implementation might need to patch this method." ^ block decompile arguments collect: [ :each | each name asSymbol ]! ! !PPCaptureParser methodsFor: 'private' stamp: 'lr 5/8/2011 19:57'! evaluateBindings 1 to: bindings size do: [ :index | (collections at: index) ifTrue: [ bindings at: index put: (bindings at: index) asArray ] ]. ^ block valueWithArguments: bindings! ! !PPCaptureParser methodsFor: 'private' stamp: 'lr 5/8/2011 19:59'! find: aParser many: aBoolean seen: aSet | many index | (aParser class = PPBindParser and: [ (index := arguments indexOf: aParser variable) > 0 ]) ifTrue: [ collections at: index put: (aBoolean or: [ collections at: index ]). aParser setCapture: self ]. (aParser class = self class or: [ aSet includes: aParser ]) ifTrue: [ ^ self ]. aSet add: aParser. many := aBoolean or: [ aParser isKindOf: PPRepeatingParser ]. aParser children do: [ :child | self find: child many: many seen: aSet ]! ! !PPCaptureParser methodsFor: 'parsing' stamp: 'lr 5/8/2011 19:58'! parseOn: aStream | previous result | previous := bindings. bindings := collections collect: [ :each | each ifTrue: [ OrderedCollection new ] ]. result := parser parseOn: aStream. result isPetitFailure ifFalse: [ result := self evaluateBindings ]. bindings := previous. ^ result! ! !PPCaptureParser methodsFor: 'private' stamp: 'lr 5/8/2011 19:59'! set: aSymbol to: anObject 1 to: arguments size do: [ :index | (arguments at: index) == aSymbol ifTrue: [ (collections at: index) ifTrue: [ (bindings at: index) addLast: anObject ] ifFalse: [ bindings at: index put: anObject ]. ^ self ] ]! ! !PPCaptureParser methodsFor: 'initialization' stamp: 'lr 5/8/2011 19:58'! setBlock: aBlock super setBlock: aBlock. arguments := self argumentNames. collections := Array new: arguments size withAll: false. arguments isEmpty ifFalse: [ self find: parser many: false seen: IdentitySet new ]! ! !PPLiteralSequenceParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 23:26'! writeDartOn: aWriter aWriter stream nextPutAll: 'string('. (literal isKindOf: String) ifTrue: [ aWriter writeString: literal ] ifFalse: [ aWriter stream nextPutAll: '/* TODO: '; print: literal; nextPutAll: ' */' ]. aWriter stream nextPutAll: ', '. aWriter writeString: message. aWriter stream nextPutAll: ')'! ! !PPLiteralSequenceParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 23:26'! writeJavaOn: aWriter aWriter stream nextPutAll: 'Parsers.string('. (literal isKindOf: String) ifTrue: [ aWriter writeString: literal ] ifFalse: [ aWriter stream nextPutAll: '/* TODO: '; print: literal; nextPutAll: ' */' ]. aWriter stream nextPutAll: ', '. aWriter writeString: message. aWriter stream nextPutAll: ')'! ! !PPPredicateObjectParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 23:31'! writeDartOn: aWriter predicateMessage = 'input expected' ifTrue: [ aWriter stream nextPutAll: 'any(' ] ifFalse: [ predicateMessage = 'digit expected' ifTrue: [ aWriter stream nextPutAll: 'digit(' ] ifFalse: [ predicateMessage = 'letter expected' ifTrue: [ aWriter stream nextPutAll: 'letter(' ] ifFalse: [ predicateMessage = 'lowercase letter expected' ifTrue: [ aWriter stream nextPutAll: 'lowercase(' ] ifFalse: [ predicateMessage = 'separator expected' ifTrue: [ aWriter stream nextPutAll: 'whitespace(' ] ifFalse: [ predicateMessage = 'uppercase letter expected' ifTrue: [ aWriter stream nextPutAll: 'uppercase(' ] ifFalse: [ predicateMessage = 'letter or digit expected' ifTrue: [ aWriter stream nextPutAll: 'word(' ] ifFalse: [ aWriter stream nextPutAll: 'pattern('. aWriter writeString: (Character allCharacters select: [ :char | self matches: (String with: char) ]). aWriter stream nextPutAll: ', ' ] ] ] ] ] ] ]. aWriter writeString: predicateMessage. aWriter stream nextPutAll: ')'! ! !PPPredicateObjectParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 23:33'! writeJavaOn: aWriter predicateMessage = 'input expected' ifTrue: [ aWriter stream nextPutAll: 'Chars.any(' ] ifFalse: [ predicateMessage = 'digit expected' ifTrue: [ aWriter stream nextPutAll: 'Chars.digit(' ] ifFalse: [ predicateMessage = 'letter expected' ifTrue: [ aWriter stream nextPutAll: 'Chars.letter(' ] ifFalse: [ predicateMessage = 'lowercase letter expected' ifTrue: [ aWriter stream nextPutAll: 'Chars.lowerCase(' ] ifFalse: [ predicateMessage = 'separator expected' ifTrue: [ aWriter stream nextPutAll: 'Chars.whitespace(' ] ifFalse: [ predicateMessage = 'uppercase letter expected' ifTrue: [ aWriter stream nextPutAll: 'Chars.upperCase(' ] ifFalse: [ predicateMessage = 'letter or digit expected' ifTrue: [ aWriter stream nextPutAll: 'Chars.word(' ] ifFalse: [ aWriter stream nextPutAll: 'Chars.pattern('. aWriter writeString: (Character allCharacters select: [ :char | self matches: (String with: char) ]). aWriter stream nextPutAll: ', ' ] ] ] ] ] ] ]. aWriter writeString: predicateMessage. aWriter stream nextPutAll: ')'! ! !PPPredicateObjectParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 23:41'! writeSmalltalkOn: aWriter predicateMessage = 'input expected' ifTrue: [ ^ aWriter stream nextPutAll: '#any asParser' ]. predicateMessage = 'digit expected' ifTrue: [ ^ aWriter stream nextPutAll: '#digit asParser' ]. predicateMessage = 'letter expected' ifTrue: [ ^ aWriter stream nextPutAll: '#letter asParser' ]. predicateMessage = 'lowercase letter expected' ifTrue: [ ^ aWriter stream nextPutAll: '#lowercase asParser' ]. predicateMessage = 'separator expected' ifTrue: [ ^ aWriter stream nextPutAll: '#whitespace asParser' ]. predicateMessage = 'uppercase letter expected' ifTrue: [ ^ aWriter stream nextPutAll: '#uppercase asParser' ]. predicateMessage = 'letter or digit expected' ifTrue: [ ^ aWriter stream nextPutAll: '#word asParser' ]. aWriter stream nextPutAll: '(PPPredicateObjectParser on: '; store: predicate; nextPutAll: ' message: '; store: predicateMessage; nextPutAll: ')'! ! !PPFlattenParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 17:49'! writeDartOn: aWriter aWriter write: parser. aWriter stream nextPutAll: '.flatten()'! ! !PPFlattenParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 17:49'! writeJavaOn: aWriter aWriter write: parser. aWriter stream nextPutAll: '.flatten()'! ! !PPFlattenParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 17:49'! writeSmalltalkOn: aWriter aWriter write: parser. aWriter stream nextPutAll: ' flatten'! ! !PPEndOfInputParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 17:48'! writeDartOn: aWriter aWriter write: parser. aWriter stream nextPutAll: '.end()'! ! !PPEndOfInputParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 17:49'! writeJavaOn: aWriter aWriter write: parser. aWriter stream nextPutAll: '.end()'! ! !PPEndOfInputParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 17:49'! writeSmalltalkOn: aWriter aWriter write: parser. aWriter stream nextPutAll: ' end'! ! !PPOptionalParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 17:51'! writeDartOn: aWriter aWriter write: parser. aWriter stream nextPutAll: '.optional()'! ! !PPOptionalParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 17:51'! writeJavaOn: aWriter aWriter write: parser. aWriter stream nextPutAll: '.optional()'! ! !PPOptionalParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 17:51'! writeSmalltalkOn: aWriter aWriter write: parser. aWriter stream nextPutAll: ' optional'! ! !PPLiteralObjectParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 23:27'! writeDartOn: aWriter aWriter stream nextPutAll: 'char('. (literal isKindOf: Character) ifTrue: [ aWriter writeString: (String with: literal) ] ifFalse: [ aWriter stream nextPutAll: '/* TODO: '; print: literal; nextPutAll: ' */' ]. aWriter stream nextPutAll: ', '. aWriter writeString: message. aWriter stream nextPutAll: ')'! ! !PPLiteralObjectParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 23:33'! writeJavaOn: aWriter aWriter stream nextPutAll: 'Chars.character('. (literal isKindOf: Character) ifTrue: [ aWriter writeCharacter: literal ] ifFalse: [ aWriter stream nextPutAll: '/* TODO: '; print: literal; nextPutAll: ' */' ]. aWriter stream nextPutAll: ', '. aWriter writeString: message. aWriter stream nextPutAll: ')'! ! !PPTrimmingParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 17:53'! writeDartOn: aWriter aWriter write: parser. aWriter stream nextPutAll: '.trim('. aWriter write: trimmer. aWriter stream nextPutAll: ')'! ! !PPTrimmingParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 17:53'! writeJavaOn: aWriter aWriter write: parser. aWriter stream nextPutAll: '.trim('. aWriter write: trimmer. aWriter stream nextPutAll: ')'! ! !PPTrimmingParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 17:53'! writeSmalltalkOn: aWriter aWriter stream nextPut: $(. aWriter write: parser. aWriter stream nextPutAll: ' trim: '. aWriter write: trimmer. aWriter stream nextPut: $)! ! !PPNotParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 17:51'! writeDartOn: aWriter aWriter write: parser. aWriter stream nextPutAll: '.not()'! ! !PPNotParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 17:51'! writeJavaOn: aWriter aWriter write: parser. aWriter stream nextPutAll: '.not()'! ! !PPNotParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 17:51'! writeSmalltalkOn: aWriter aWriter write: parser. aWriter stream nextPutAll: ' not'! ! !PPMemoizedParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 17:50'! writeDartOn: aWriter aWriter write: parser. aWriter stream nextPutAll: '/* .memoized() */'! ! !PPMemoizedParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 17:50'! writeJavaOn: aWriter aWriter write: parser. aWriter stream nextPutAll: '/* .memoized() */'! ! !PPMemoizedParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 17:50'! writeSmalltalkOn: aWriter aWriter write: parser. aWriter stream nextPutAll: ' memoized'! ! !PPSequenceParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 23:10'! writeDartOn: aWriter aWriter write: parsers first. (aWriter isSeparatedBy: self) ifTrue: [ aWriter stream nextPutAll: '.separatedBy('. aWriter write: parsers second children first children first. aWriter stream nextPutAll: ')' ] ifFalse: [ parsers allButFirst do: [ :each | aWriter stream nextPutAll: '.seq('. aWriter write: each. aWriter stream nextPutAll: ')' ] ]! ! !PPSequenceParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 23:10'! writeJavaOn: aWriter aWriter write: parsers first. (aWriter isSeparatedBy: self) ifTrue: [ aWriter stream nextPutAll: '.separatedBy('. aWriter write: parsers second children first children first. aWriter stream nextPutAll: ')' ] ifFalse: [ parsers allButFirst do: [ :each | aWriter stream nextPutAll: '.seq('. aWriter write: each. aWriter stream nextPutAll: ')' ] ]! ! !PPSequenceParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/22/2013 17:37'! writeSmalltalkOn: aWriter aWriter stream nextPut: $(. aWriter write: parsers first. (aWriter isSeparatedBy: self) ifTrue: [ aWriter stream nextPutAll: ' separatedBy: '. aWriter write: parsers second children first children first ] ifFalse: [ parsers allButFirst do: [ :each | aWriter stream nextPutAll: ' , '. aWriter write: each ] ]. aWriter stream nextPut: $) ! ! !PPPluggableParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 19:06'! writeDartOn: aWriter aWriter stream nextPutAll: '/* TODO: '; print: self; nextPutAll: ' */'! ! !PPPluggableParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 19:06'! writeJavaOn: aWriter aWriter stream nextPutAll: '/* TODO: '; print: self; nextPutAll: ' */'! ! !PPPluggableParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 19:06'! writeSmalltalkOn: aWriter aWriter stream storeOn: self! ! PPListParser subclass: #PPLongestChoiceParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Parser'! !PPLongestChoiceParser methodsFor: 'operators' stamp: 'lr 7/28/2011 09:44'! /> aRule ^ self copyWith: aRule! ! !PPLongestChoiceParser methodsFor: 'parsing' stamp: 'lr 7/26/2011 12:54'! parseOn: aStream "This is optimized code that avoids unnecessary block activations, do not change. When all choices fail, the last failure is answered." | start element longestEnd longestElement | start := aStream position. 1 to: parsers size do: [ :index | element := (parsers at: index) parseOn: aStream. (longestEnd isNil or: [ longestEnd < aStream position ]) ifTrue: [ longestEnd := aStream position. longestElement := element ]. aStream position: start ]. aStream position: longestEnd. ^ longestElement! ! !PPTokenParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 17:49'! writeDartOn: aWriter aWriter write: parser. aWriter stream nextPutAll: '.token()'! ! !PPTokenParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 17:49'! writeJavaOn: aWriter aWriter write: parser. aWriter stream nextPutAll: '.token()'! ! !PPTokenParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 17:49'! writeSmalltalkOn: aWriter aWriter write: parser. aWriter stream nextPutAll: ' token'! ! !PPAndParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 17:48'! writeDartOn: aWriter aWriter write: parser. aWriter stream nextPutAll: '.and()'! ! !PPAndParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 17:48'! writeJavaOn: aWriter aWriter write: parser. aWriter stream nextPutAll: '.and()'! ! !PPAndParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 17:48'! writeSmalltalkOn: aWriter aWriter write: parser. aWriter stream nextPutAll: ' and'! ! !PPRepeatingParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 18:25'! writeDartOn: aWriter aWriter write: parser. (min = 0 and: [ max = SmallInteger maxVal ]) ifTrue: [ ^ aWriter stream nextPutAll: '.star()' ]. (min = 1 and: [ max = SmallInteger maxVal ]) ifTrue: [ ^ aWriter stream nextPutAll: '.plus()' ]. min = max ifTrue: [ ^ aWriter stream nextPutAll: '.times('; print: min; nextPutAll: ')' ]. aWriter stream nextPutAll: 'repeat('; print: min; nextPutAll: ', '; print: max; nextPutAll: ')'! ! !PPRepeatingParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 18:26'! writeJavaOn: aWriter aWriter write: parser. (min = 0 and: [ max = SmallInteger maxVal ]) ifTrue: [ ^ aWriter stream nextPutAll: '.star()' ]. (min = 1 and: [ max = SmallInteger maxVal ]) ifTrue: [ ^ aWriter stream nextPutAll: '.plus()' ]. min = max ifTrue: [ ^ aWriter stream nextPutAll: '.times('; print: min; nextPutAll: ')' ]. aWriter stream nextPutAll: 'repeat('; print: min; nextPutAll: ', '; print: max; nextPutAll: ')'! ! !PPRepeatingParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 18:26'! writeSmalltalkOn: aWriter aWriter stream nextPutAll: '('. aWriter write: parser. (min = 0 and: [ max = SmallInteger maxVal ]) ifTrue: [ ^ aWriter stream nextPutAll: ' star)' ]. (min = 1 and: [ max = SmallInteger maxVal ]) ifTrue: [ ^ aWriter stream nextPutAll: ' plus)' ]. min = max ifTrue: [ ^ aWriter stream nextPutAll: '.times: '; print: min; nextPutAll: ')' ]. aWriter stream nextPutAll: 'min: '; print: min; nextPutAll: ' max: '; print: max; nextPutAll: ')' ! ! !PPFailingParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 23:01'! writeDartOn: aWriter aWriter stream nextPutAll: 'failure('. aWriter writeString: message. aWriter stream nextPutAll: ')'! ! !PPFailingParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 23:01'! writeJavaOn: aWriter aWriter stream nextPutAll: 'Parsers.failure('. aWriter writeString: message. aWriter stream nextPutAll: ')'! ! !PPFailingParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 23:02'! writeSmalltalkOn: aWriter aWriter stream nextPutAll: '(PPFailingParser message: '; store: message; nextPutAll: ')' ! ! PPAbstractParserTest subclass: #PPCaptureTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Bindings'! !PPCaptureTest methodsFor: 'tests' stamp: 'lr 5/7/2011 17:17'! testCharacter | parser | parser := ($a asParser bind: #a) capture: [ :a | a ]. self assert: parser parse: 'a' to: $a! ! !PPCaptureTest methodsFor: 'tests' stamp: 'lr 5/7/2011 18:46'! testChoice | parser | parser := ($a asParser bind: #a) / ($b asParser bind: #b) / ($c asParser bind: #b) capture: [ :a :b | Array with: a with: b ]. self assert: parser parse: 'a' to: #($a nil). self assert: parser parse: 'b' to: #(nil $b). self assert: parser parse: 'c' to: #(nil $c)! ! !PPCaptureTest methodsFor: 'tests' stamp: 'lr 5/7/2011 20:36'! testFailed | parser | parser := (($a asParser bind: #a) , (PPFailingParser message: 'oops')) / ($a asParser bind: #b) capture: [ :a :b | Array with: a with: b ]. "$a successfully matched, thus it is bound:" self assert: parser parse: 'a' to: #($a $a)! ! !PPCaptureTest methodsFor: 'tests' stamp: 'lr 5/7/2011 20:34'! testHiding | parser | parser := (($a asParser bind: #a) capture: [ :a | a ]) capture: [ :a | a ]. self assert: parser parse: 'a' to: nil! ! !PPCaptureTest methodsFor: 'tests' stamp: 'lr 5/7/2011 20:18'! testNested | parser | parser := ((#word asParser plus bind: #a) flatten bind: #b) capture: [ :a :b | Array with: a with: b ]. self assert: parser parse: 'a' to: #(#($a) 'a'). self assert: parser parse: 'ab' to: #(#($a $b) 'ab'). self assert: parser parse: 'abc' to: #(#($a $b $c) 'abc')! ! !PPCaptureTest methodsFor: 'tests' stamp: 'lr 5/7/2011 17:17'! testOptional | parser | parser := ($a asParser bind: #a) optional capture: [ :a | a ]. self assert: parser parse: '' to: nil. self assert: parser parse: 'a' to: $a! ! !PPCaptureTest methodsFor: 'tests' stamp: 'lr 5/7/2011 17:17'! testRepetition | parser | parser := ($a asParser bind: #a) star capture: [ :a | a ]. self assert: parser parse: '' to: #(). self assert: parser parse: 'a' to: #($a). self assert: parser parse: 'aa' to: #($a $a)! ! !PPCaptureTest methodsFor: 'tests' stamp: 'lr 5/7/2011 18:55'! testSeparated | ap bp sp | ap := $a asParser bind: #a. bp := $b asParser bind: #b. sp := (ap , (bp , ap) star) capture: [ :a :b | Array with: a with: b ]. self assert: sp parse: 'a' to: #(#($a) #()). self assert: sp parse: 'aba' to: #(#($a $a) #($b)). self assert: sp parse: 'ababa' to: #(#($a $a $a) #($b $b))! ! !PPCaptureTest methodsFor: 'tests' stamp: 'lr 5/7/2011 17:17'! testSequence | parser | parser := ($a asParser bind: #a) , ($b asParser bind: #b) capture: [ :a :b | Array with: a with: b ]. self assert: parser parse: 'ab' to: #($a $b)! ! !PPCaptureTest methodsFor: 'tests' stamp: 'lr 5/7/2011 19:35'! testSequence2 | parser | parser := ($a asParser bind: #a) , ($b asParser bind: #b) capture: [ :b :a | Array with: a with: b ]. self assert: parser parse: 'ab' to: #($a $b)! ! !PPCaptureTest methodsFor: 'tests' stamp: 'lr 7/28/2011 10:17'! testWroms | parser | parser := (($a asParser bind: #a) , (PPFailingParser message: 'worm') bind: #fail) / ($a asParser bind: #b) capture: [ :a :b :fail | Array with: (fail notNil ifTrue: [ a ]) with: b ]. self assert: parser parse: 'a' to: #(nil $a)! ! PPAbstractParserTest subclass: #PPLongestChoiceParserTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Parser'! !PPLongestChoiceParserTest methodsFor: 'tests' stamp: 'lr 7/28/2011 10:12'! testAaa | parser | parser := ('a' asParser answer: 1) /> ('aa' asParser answer: 2) /> ('aaa' asParser answer: 3). self assert: parser fail: ''. self assert: parser fail: 'b'. self assert: parser parse: 'a' to: 1. self assert: parser parse: 'aa' to: 2. self assert: parser parse: 'aaa' to: 3! ! !PPLongestChoiceParserTest methodsFor: 'tests' stamp: 'lr 7/28/2011 10:13'! testBbb | parser | parser := ('bbb' asParser answer: 1) /> ('bb' asParser answer: 2) /> ('b' asParser answer: 3). self assert: parser fail: ''. self assert: parser fail: 'a'. self assert: parser parse: 'b' to: 3. self assert: parser parse: 'bb' to: 2. self assert: parser parse: 'bbb' to: 1! ! PPAbstractParserTest subclass: #PPOptimizerTest instanceVariableNames: 'a b c' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Optimizer'! !PPOptimizerTest class methodsFor: 'accessing' stamp: 'lr 5/31/2010 18:50'! packageNamesUnderTest ^ #('PetitBeta')! ! !PPOptimizerTest methodsFor: 'utilities' stamp: 'lr 8/26/2010 10:58'! assert: aParser equals: anotherParser self assert: (aParser match: anotherParser inContext: Dictionary new) description: (self comparingStringBetween: aParser and: anotherParser)! ! !PPOptimizerTest methodsFor: 'utilities' stamp: 'lr 10/30/2011 11:39'! comparingStringBetween: anExpectedString and: anActualString ^ 'Expected ' , anExpectedString printString , ' but was ' , anActualString printString! ! !PPOptimizerTest methodsFor: 'utilities' stamp: 'lr 4/29/2010 23:21'! optimize: aParser ^ aParser optimize! ! !PPOptimizerTest methodsFor: 'running' stamp: 'lr 8/26/2010 11:08'! setUp super setUp. a := $a asParser. b := $b asParser. c := $c asParser! ! !PPOptimizerTest methodsFor: 'testing' stamp: 'lr 5/8/2011 20:32'! testDuplicates | grammar | grammar := self optimize: $a asParser , $a asParser. self assert: grammar children first = grammar children last. self deny: $a asParser = $a asParser! ! !PPOptimizerTest methodsFor: 'testing-choice' stamp: 'lr 8/26/2010 10:57'! testEmptyChoice | grammar | grammar := self optimize: PPChoiceParser new. self assert: grammar equals: PPFailingParser new! ! !PPOptimizerTest methodsFor: 'testing-choice' stamp: 'lr 8/26/2010 10:59'! testNestedChoice | grammar | grammar := self optimize: a / (b / c). self assert: grammar equals: a / b / c. grammar := self optimize: (a / b) / c. self assert: grammar equals: a / b / c! ! !PPOptimizerTest methodsFor: 'testing-choice' stamp: 'lr 8/26/2010 11:00'! testNulledChoice | grammar | grammar := self optimize: a / nil asParser / b / c. self assert: grammar equals: a optional. grammar := self optimize: a / b / nil asParser / c. self assert: grammar equals: a / b / nil asParser. grammar := self optimize: a / b / c / nil asParser. self assert: grammar equals: a / b / c / nil asParser! ! !PPOptimizerTest methodsFor: 'testing-operators' stamp: 'lr 8/26/2010 11:10'! testOptionalChoice | grammar | grammar := self optimize: a optional / a. self assert: grammar equals: a optional! ! !PPOptimizerTest methodsFor: 'testing-epsilon' stamp: 'lr 8/26/2010 11:09'! testOptionalEpsilon | grammar | grammar := self optimize: nil asParser optional. self assert: grammar equals: nil asParser! ! !PPOptimizerTest methodsFor: 'testing-operators' stamp: 'lr 8/26/2010 11:10'! testOptionalOptional | grammar | grammar := self optimize: a optional optional. self assert: grammar equals: a optional! ! !PPOptimizerTest methodsFor: 'testing-operators' stamp: 'lr 8/26/2010 11:11'! testOptionalPlus | grammar | grammar := self optimize: a optional plus. self assert: grammar equals: a star! ! !PPOptimizerTest methodsFor: 'testing-operators' stamp: 'lr 8/26/2010 11:11'! testOptionalPlusChoice | grammar | grammar := self optimize: a optional / a plus. self assert: grammar equals: a star! ! !PPOptimizerTest methodsFor: 'testing-operators' stamp: 'lr 8/26/2010 11:11'! testOptionalStar | grammar | grammar := self optimize: a optional star. self assert: grammar equals: a star! ! !PPOptimizerTest methodsFor: 'testing-operators' stamp: 'lr 8/26/2010 11:11'! testOptionalStarChoice | grammar | grammar := self optimize: a optional / a star. self assert: grammar equals: a star! ! !PPOptimizerTest methodsFor: 'testing-operators' stamp: 'lr 8/26/2010 11:12'! testPlusChoice | grammar | grammar := self optimize: a plus / a. self assert: grammar equals: a plus! ! !PPOptimizerTest methodsFor: 'testing-epsilon' stamp: 'lr 8/26/2010 11:09'! testPlusEpsilon | grammar | grammar := self optimize: nil asParser plus. self assert: grammar equals: nil asParser! ! !PPOptimizerTest methodsFor: 'testing-operators' stamp: 'lr 8/26/2010 11:13'! testPlusOptional | grammar | grammar := self optimize: a plus optional. self assert: grammar equals: a star! ! !PPOptimizerTest methodsFor: 'testing-operators' stamp: 'lr 8/26/2010 11:14'! testPlusOptionalChoice | grammar | grammar := self optimize: a plus / a optional. self assert: grammar equals: a star! ! !PPOptimizerTest methodsFor: 'testing-operators' stamp: 'lr 8/26/2010 11:13'! testPlusPlus | grammar | grammar := self optimize: a plus plus. self assert: grammar equals: a plus! ! !PPOptimizerTest methodsFor: 'testing-operators' stamp: 'lr 8/26/2010 11:13'! testPlusStar | grammar | grammar := self optimize: a plus star. self assert: grammar equals: a star! ! !PPOptimizerTest methodsFor: 'testing-operators' stamp: 'lr 8/26/2010 11:14'! testPlusStarChoice | grammar | grammar := self optimize: a plus / a star. self assert: grammar equals: a star! ! !PPOptimizerTest methodsFor: 'testing-choice' stamp: 'lr 8/26/2010 11:00'! testPostfixChoice | grammar | grammar := self optimize: (a , b) / (c , b). self assert: grammar equals: (a / c) , b! ! !PPOptimizerTest methodsFor: 'testing-choice' stamp: 'lr 8/26/2010 11:00'! testPrefixChoice | grammar | grammar := self optimize: (a , b) / (a , c). self assert: grammar equals: a , (b / c)! ! !PPOptimizerTest methodsFor: 'testing-delegate' stamp: 'lr 7/17/2011 12:25'! testReduceDelegate | grammar | grammar := self optimize: (PPAndParser on: (PPAndParser on: a)). self assert: grammar equals: a and. grammar := self optimize: (PPFlattenParser on: (PPFlattenParser on: a)). self assert: grammar equals: a flatten. grammar := self optimize: (PPMemoizedParser on: (PPMemoizedParser on: a)). self assert: grammar equals: a memoized. grammar := self optimize: (PPNotParser on: (PPNotParser on: a)). self assert: grammar equals: a not not! ! !PPOptimizerTest methodsFor: 'testing-delegate' stamp: 'lr 8/26/2010 11:03'! testRemoveDelegate | grammar | grammar := self optimize: a wrapped. self assert: grammar equals: a. grammar := self optimize: a wrapped wrapped. self assert: grammar equals: a. grammar := self optimize: a wrapped / b wrapped wrapped. self assert: grammar equals: a / b! ! !PPOptimizerTest methodsFor: 'testing-delegate' stamp: 'lr 5/8/2011 20:40'! testRemoveUnbound | grammar block | grammar := self optimize: (a bind: #v1). self assert: grammar equals: a. grammar := self optimize: (a bind: #v1) , (b bind: #v2). self assert: grammar equals: a , b. grammar := self optimize: ((a bind: #v1) , (b bind: #v2) capture: (block := [ :v1 | ])). self assert: grammar equals: (((a bind: #v1) , b) capture: block). grammar := self optimize: ((a bind: #v1) , (b bind: #v2) capture: (block := [ :v2 | ])). self assert: grammar equals: (a , (b bind: #v2) capture: block). grammar := self optimize: ((a bind: #v1) , (b bind: #v2) capture: (block := [ :v1 :v2 | ])). self assert: grammar equals: ((a bind: #v1) , (b bind: #v2) capture: block)! ! !PPOptimizerTest methodsFor: 'testing-choice' stamp: 'lr 8/26/2010 11:02'! testRepeatedChoice | grammar | grammar := self optimize: a / a / b / c. self assert: grammar equals: a / b / c. grammar := self optimize: a / b / a / a. self assert: grammar equals: a / b. grammar := self optimize: a / a / a / a. self assert: grammar equals: a! ! !PPOptimizerTest methodsFor: 'testing-choice' stamp: 'lr 8/26/2010 11:02'! testSingleChoice | grammar | grammar := self optimize: (PPChoiceParser with: a). self assert: grammar equals: a! ! !PPOptimizerTest methodsFor: 'testing-operators' stamp: 'lr 8/26/2010 11:15'! testStarChoice | grammar | grammar := self optimize: a star / a. self assert: grammar equals: a star! ! !PPOptimizerTest methodsFor: 'testing-epsilon' stamp: 'lr 8/26/2010 11:09'! testStarEpsilon | grammar | grammar := self optimize: nil asParser star. self assert: grammar equals: nil asParser! ! !PPOptimizerTest methodsFor: 'testing-operators' stamp: 'lr 8/26/2010 11:15'! testStarOptional | grammar | grammar := self optimize: a star optional. self assert: grammar equals: a star! ! !PPOptimizerTest methodsFor: 'testing-operators' stamp: 'lr 8/26/2010 11:15'! testStarOptionalChoice | grammar | grammar := self optimize: a star / a optional. self assert: grammar equals: a star! ! !PPOptimizerTest methodsFor: 'testing-operators' stamp: 'lr 8/26/2010 11:16'! testStarPlus | grammar | grammar := self optimize: a star plus. self assert: grammar equals: a star! ! !PPOptimizerTest methodsFor: 'testing-operators' stamp: 'lr 8/26/2010 11:16'! testStarPlusChoice | grammar | grammar := self optimize: a star / a plus. self assert: grammar equals: a star! ! !PPOptimizerTest methodsFor: 'testing-operators' stamp: 'lr 8/26/2010 11:16'! testStarStar | grammar | grammar := self optimize: a star star. self assert: grammar equals: a star! ! !PPParser methodsFor: '*petitbeta-operators' stamp: 'lr 7/28/2011 09:46'! /> aParser "Answer a new parser that parses the receiver and aParser that returns the longest successful match." ^ PPLongestChoiceParser with: self with: aParser! ! !PPParser methodsFor: '*petitbeta-bindings' stamp: 'lr 5/8/2011 20:21'! bind: aSymbol "Answer a parser that binds the result of the receiver parser to the variable aSymbol." ^ PPBindParser on: self variable: aSymbol! ! !PPParser methodsFor: '*petitbeta-bindings' stamp: 'lr 5/7/2011 17:16'! capture: aBlock "Answer a parser that captures bound results in the scope of the receiver and binds them to the arguments of aBlock." ^ PPCaptureParser on: self block: aBlock! ! !PPParser methodsFor: '*petitbeta-operators' stamp: 'lr 8/8/2011 22:18'! dynamicChoice: aParser | dynamicChoice | ^ dynamicChoice := self | aParser / [ :stream | | resolution | resolution := UIManager default chooseFrom: (Array with: self name with: aParser name) values: (Array with: self with: aParser) title: 'Resolve ambiguity'. dynamicChoice def: resolution. resolution parseOn: stream ] asParser! ! !PPParser methodsFor: '*petitbeta-querying' stamp: 'lr 8/8/2011 22:18'! optimize "Optimizes the receiving parser for speed, size and correctness." ^ PPOptimizer new optimize: self! ! !PPParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 17:35'! writeDartOn: aWriter self subclassResponsibility! ! !PPParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 17:35'! writeJavaOn: aWriter self subclassResponsibility! ! !PPParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 17:37'! writeSmalltalkOn: aWriter self subclassResponsibility! ! !PPEpsilonParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 17:55'! writeDartOn: aWriter aWriter stream nextPutAll: 'epsilon()'! ! !PPEpsilonParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 17:55'! writeJavaOn: aWriter aWriter stream nextPutAll: 'Parsers.epsilon()'! ! !PPEpsilonParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 17:54'! writeSmalltalkOn: aWriter aWriter stream nextPutAll: 'nil asParser' ! ! PPDelegateParser subclass: #PPBindParser instanceVariableNames: 'capture variable' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Bindings'! !PPBindParser class methodsFor: 'instance creation' stamp: 'lr 5/8/2011 20:21'! on: aParser variable: aSymbol ^ (self on: aParser) setVariable: aSymbol! ! !PPBindParser methodsFor: 'accessing' stamp: 'lr 5/8/2011 20:19'! capture ^ capture! ! !PPBindParser methodsFor: 'accessing' stamp: 'lr 5/8/2011 19:54'! children ^ capture isNil ifTrue: [ super children ] ifFalse: [ super children copyWith: capture ]! ! !PPBindParser methodsFor: 'matching' stamp: 'lr 5/8/2011 20:17'! copyInContext: aDictionary seen: aSeenDictionary | copy | aSeenDictionary at: self ifPresent: [ :value | ^ value ]. copy := (aSeenDictionary at: self put: self copy) setParser: (parser copyInContext: aDictionary seen: aSeenDictionary); yourself. capture isNil ifFalse: [ copy replace: capture with: (capture copyInContext: aDictionary seen: aSeenDictionary) ]. ^ copy! ! !PPBindParser methodsFor: 'matching' stamp: 'lr 5/8/2011 20:21'! match: aParser inContext: aDictionary seen: anIdentitySet ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self variable = aParser variable ]! ! !PPBindParser methodsFor: 'parsing' stamp: 'lr 5/8/2011 20:23'! parseOn: aParser | result | result := super parseOn: aParser. (result isPetitFailure or: [ capture isNil ]) ifFalse: [ capture set: variable to: result ]. ^ result! ! !PPBindParser methodsFor: 'transforming' stamp: 'lr 5/8/2011 19:55'! replace: aParser with: anotherParser super replace: aParser with: anotherParser. capture == aParser ifTrue: [ capture := anotherParser ]! ! !PPBindParser methodsFor: 'initialization' stamp: 'lr 5/8/2011 10:25'! setCapture: aCaptureParser capture == aCaptureParser ifTrue: [ ^ self ]. capture isNil ifFalse: [ ^ self error: self printString , ' is already captured by ' , capture printString ]. capture := aCaptureParser! ! !PPBindParser methodsFor: 'initialization' stamp: 'lr 5/8/2011 20:22'! setVariable: aSymbol variable := aSymbol! ! !PPBindParser methodsFor: 'accessing' stamp: 'lr 5/8/2011 20:22'! variable ^ variable! ! PPDelegateParser subclass: #PPCompoundParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Compound'! PPCompoundParser subclass: #PPArithmeticCompoundParser instanceVariableNames: 'terms addition factors multiplication primary parentheses number' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Compound'! !PPArithmeticCompoundParser methodsFor: 'grammar' stamp: 'lr 5/8/2011 14:58'! addition ^ (factors bind: #a) , ($+ asParser token trim , (factors bind: #b)) star! ! !PPArithmeticCompoundParser methodsFor: 'grammar' stamp: 'lr 5/8/2011 11:37'! factors ^ multiplication / primary! ! !PPArithmeticCompoundParser methodsFor: 'grammar' stamp: 'lr 5/8/2011 14:58'! multiplication ^ (primary bind: #a) , ($* asParser token trim , (primary bind: #b)) star! ! !PPArithmeticCompoundParser methodsFor: 'grammar' stamp: 'lr 5/8/2011 14:54'! number ^ ($- asParser optional , #digit asParser plus , ($. asParser , #digit asParser plus) optional) flatten bind: #number! ! !PPArithmeticCompoundParser methodsFor: 'grammar' stamp: 'lr 5/8/2011 11:41'! parentheses ^ $( asParser flatten trim , (terms bind: #a) , $) asParser flatten trim! ! !PPArithmeticCompoundParser methodsFor: 'grammar' stamp: 'lr 5/8/2011 11:10'! primary ^ number / parentheses! ! !PPArithmeticCompoundParser methodsFor: 'accessing' stamp: 'lr 5/8/2011 11:11'! start ^ terms end! ! !PPArithmeticCompoundParser methodsFor: 'grammar' stamp: 'lr 5/8/2011 11:36'! terms ^ addition / factors! ! !PPCompoundParser class methodsFor: 'accessing' stamp: 'lr 5/8/2011 12:50'! ignoredNames "Answer a collection of instance-variables that should not be automatically initialized with productions, but that are used internal to the composite parser." ^ PPCompoundParser allInstVarNames! ! !PPCompoundParser class methodsFor: 'instance creation' stamp: 'lr 5/8/2011 12:38'! new self error: self name , ' is instantiated with #on: or #on:startingAt:'! ! !PPCompoundParser class methodsFor: 'instance creation' stamp: 'lr 5/8/2011 11:45'! on: aHandler ^ self on: aHandler startingAt: self startSymbol! ! !PPCompoundParser class methodsFor: 'instance creation' stamp: 'lr 5/8/2011 13:20'! on: aHandler startingAt: aSymbol ^ (self basicNew initializeStartingAt: aSymbol) setHandler: aHandler! ! !PPCompoundParser class methodsFor: 'accessing' stamp: 'lr 5/8/2011 11:43'! startSymbol "Answer the method that represents the default start symbol." ^ #start! ! !PPCompoundParser methodsFor: 'initialization' stamp: 'lr 5/8/2011 15:26'! initializeStartingAt: aSymbol | productionNames | self initialize. productionNames := self productionNames. parser := PPCompoundProductionParser named: aSymbol. productionNames keysAndValuesDo: [ :key :value | self instVarAt: key put: (PPCompoundProductionParser named: value) ]. parser setParser: (self perform: aSymbol). productionNames keysAndValuesDo: [ :key :value | (self instVarAt: key) setParser: (self perform: value) ]! ! !PPCompoundParser methodsFor: 'private' stamp: 'lr 5/8/2011 14:43'! install: aProductionSelector on: aHandler send: aSelector arguments: anArray | index | (self class ignoredNames includes: aProductionSelector) ifTrue: [ self error: 'Production ' , aProductionSelector printString , ' not found' ]. index := self class allInstVarNames indexOf: aProductionSelector asString ifAbsent: [ self error: 'Production ' , aProductionSelector printString , ' not found' ]. (self instVarAt: index) setTarget: aHandler selector: aSelector arguments: anArray! ! !PPCompoundParser methodsFor: 'private' stamp: 'lr 5/8/2011 15:45'! productionNames "Answer a dictionary of slot indexes and production names." | productionNames ignoredNames | productionNames := Dictionary new. ignoredNames := self class ignoredNames collect: [ :each | each asSymbol ]. self class allInstVarNames keysAndValuesDo: [ :key :value | (ignoredNames includes: value asSymbol) ifFalse: [ productionNames at: key put: value asSymbol ] ]. ^ productionNames! ! !PPCompoundParser methodsFor: 'initialization' stamp: 'lr 5/8/2011 14:51'! setHandler: aHandler self productionNames keysDo: [ :key | (self instVarAt: key) reset ]. (Pragma allNamed: #production:arguments: in: aHandler class) do: [ :pragma | self install: pragma arguments first on: aHandler send: pragma selector arguments: pragma arguments second ]! ! !PPCompoundParser methodsFor: 'accessing' stamp: 'lr 5/8/2011 11:45'! start "Answer the default production to start this parser with." self subclassResponsibility! ! PPDelegateParser subclass: #PPCompoundProductionParser instanceVariableNames: 'target selector arguments collections bindings' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Compound'! !PPCompoundProductionParser methodsFor: 'private' stamp: 'lr 5/8/2011 14:53'! evaluateBindings 1 to: bindings size do: [ :index | (collections at: index) ifTrue: [ bindings at: index put: (bindings at: index) asArray ] ]. ^ target perform: selector withArguments: bindings! ! !PPCompoundProductionParser methodsFor: 'private' stamp: 'lr 5/8/2011 14:52'! find: aParser many: aBoolean seen: aSet | many index | (aParser class = PPBindParser and: [ (index := arguments indexOf: aParser variable) > 0 ]) ifTrue: [ collections at: index put: (aBoolean or: [ collections at: index ]). aParser setCapture: self ]. (aParser class = self class or: [ aSet includes: aParser ]) ifTrue: [ ^ self ]. aSet add: aParser. many := aBoolean or: [ aParser isKindOf: PPRepeatingParser ]. aParser children do: [ :child | self find: child many: many seen: aSet ]! ! !PPCompoundProductionParser methodsFor: 'parsing' stamp: 'lr 5/8/2011 14:53'! parseOn: aStream | previous result | collections isNil ifTrue: [ ^ super parseOn: aStream ]. previous := bindings. bindings := collections collect: [ :each | each ifTrue: [ OrderedCollection new ] ]. result := parser parseOn: aStream. result isPetitFailure ifFalse: [ result := self evaluateBindings ]. bindings := previous. ^ result! ! !PPCompoundProductionParser methodsFor: 'actions' stamp: 'lr 5/8/2011 14:47'! reset target := selector := arguments := bindings := collections := nil! ! !PPCompoundProductionParser methodsFor: 'private' stamp: 'lr 5/8/2011 14:54'! set: aSymbol to: anObject 1 to: arguments size do: [ :index | (arguments at: index) == aSymbol ifTrue: [ (collections at: index) ifTrue: [ (bindings at: index) addLast: anObject ] ifFalse: [ bindings at: index put: anObject ]. ^ self ] ]! ! !PPCompoundProductionParser methodsFor: 'initialization' stamp: 'lr 5/8/2011 19:58'! setTarget: anObject selector: aSelector arguments: anArray target := anObject. selector := aSelector. arguments := anArray. collections := Array new: arguments size withAll: false. arguments isEmpty ifFalse: [ self find: parser many: false seen: IdentitySet new ]! ! !PPDelegateParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 18:43'! writeDartOn: aWriter aWriter write: parser! ! !PPDelegateParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 18:43'! writeJavaOn: aWriter aWriter write: parser! ! !PPDelegateParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 18:43'! writeSmalltalkOn: aWriter aWriter write: parser! ! !PPLiteralParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 18:16'! writeSmalltalkOn: aWriter aWriter stream store: literal; nextPutAll: ' asParser'! ! !PPPredicateSequenceParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 18:27'! writeDartOn: aWriter aWriter write: parser. aWriter stream nextPutAll: '.trim('. aWriter write: trimmer. aWriter stream nextPutAll: ')'! ! !PPPredicateSequenceParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 18:27'! writeJavaOn: aWriter aWriter write: parser. aWriter stream nextPutAll: '.trim('. aWriter write: trimmer. aWriter stream nextPutAll: ')'! ! !PPPredicateSequenceParser methodsFor: '*petitbeta-writing' stamp: 'lr 4/16/2013 18:29'! writeSmalltalkOn: aWriter aWriter stream nextPutAll: '(PPPredicateSequenceParser on: '; store: predicate; nextPutAll: ' message: '; store: predicateMessage; nextPutAll: ' size: '; print: size; nextPutAll: ')'! ! Object subclass: #PPOptimizer instanceVariableNames: 'rewriter' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Optimizer'! !PPOptimizer commentStamp: '' prior: 0! PPOptimizer improves the internal structure of a grammar without touching its behavior. Instance Variables: rewriter The rewriter that knows how to optimize a grammar.! !PPOptimizer class methodsFor: 'instance creation' stamp: 'lr 10/30/2011 11:36'! new ^ self basicNew initialize! ! !PPOptimizer methodsFor: 'optimizations-choice' stamp: 'lr 8/26/2010 08:36'! emptyChoice rewriter replace: PPChoiceParser new with: PPFailingParser new! ! !PPOptimizer methodsFor: 'optimizations' stamp: 'lr 9/15/2010 13:53'! foldDuplicates: aParser "Merges duplicated parsers into one single instance, what reduces the memory and enables many of the other optimizations to perform better. For efficiency reasons this optimization is implemented imperatively." | uniques | uniques := IdentitySet with: aParser. aParser allParsersDo: [ :parent | parent children do: [ :child | | duplicate | duplicate := uniques detect: [ :each | child ~~ each and: [ child match: each inContext: Dictionary new ] ] ifNone: [ nil ]. duplicate isNil ifTrue: [ uniques add: child ] ifFalse: [ parent replace: child with: duplicate ] ] ]. ^ aParser ! ! !PPOptimizer methodsFor: 'optimizations-delegate' stamp: 'lr 3/16/2013 21:46'! identityWrapper rewriter replace: (PPPattern class: PPDelegateParser) withValueFrom: [ :parser | parser children first ]! ! !PPOptimizer methodsFor: 'optimizations-delegate' stamp: 'lr 7/17/2011 12:25'! idepotentDelegate rewriter replace: PPPattern any withValueFrom: [ :parser | parser children first ] when: [ :parser | parser children size = 1 and: [ parser class = parser children first class and: [ #(PPAndParser PPEndOfInputParser PPFlattenParser PPMemoizedParser) includes: parser class name ] ] ]! ! !PPOptimizer methodsFor: 'initialization' stamp: 'lr 4/29/2010 21:01'! initialize rewriter := PPRewriter new. (Pragma allNamed: #optimize in: self class) do: [ :each | self perform: each selector ]! ! !PPOptimizer methodsFor: 'optimizations-choice' stamp: 'lr 5/3/2010 21:50'! nestedChoice | before inside after | before := PPListPattern any. inside := PPListPattern any. after := PPListPattern any. rewriter replace: before / (PPChoiceParser with: inside) / after with: before / inside / after! ! !PPOptimizer methodsFor: 'optimizations-choice' stamp: 'lr 12/31/2012 09:22'! nilledChoice | parser | parser := PPPattern any. rewriter replace: parser / nil asParser with: parser optional! ! !PPOptimizer methodsFor: 'optimizations-choice' stamp: 'lr 9/1/2010 22:07'! nulledChoice | before parser after | before := PPListPattern any. parser := PPPattern any. after := PPListPattern any. rewriter replace: before / nil asParser / parser / after with: before / nil asParser! ! !PPOptimizer methodsFor: 'public' stamp: 'lr 5/8/2011 15:24'! optimize: aParser "Transform aParser by applying all the matching optimization rules. Repeatedly apply the rules until no more changes can be done." | current | current := self foldDuplicates: aParser. [ current := rewriter execute: current. rewriter hasChanged ] whileTrue. ^ current! ! !PPOptimizer methodsFor: 'optimizations-operators' stamp: 'lr 8/26/2010 10:00'! optionalChoice | parser | parser := PPPattern any. rewriter replace: parser optional / parser with: parser optional! ! !PPOptimizer methodsFor: 'optimizations-epsilon' stamp: 'lr 8/26/2010 09:39'! optionalEpsilon rewriter replace: nil asParser optional with: nil asParser! ! !PPOptimizer methodsFor: 'optimizations-operators' stamp: 'lr 8/26/2010 09:46'! optionalOptional | parser | parser := PPPattern any. rewriter replace: parser optional optional with: parser optional! ! !PPOptimizer methodsFor: 'optimizations-operators' stamp: 'lr 8/26/2010 09:46'! optionalPlus | parser | parser := PPPattern any. rewriter replace: parser optional plus with: parser star! ! !PPOptimizer methodsFor: 'optimizations-operators' stamp: 'lr 8/26/2010 10:02'! optionalPlusChoice | parser | parser := PPPattern any. rewriter replace: parser optional / parser plus with: parser star! ! !PPOptimizer methodsFor: 'optimizations-operators' stamp: 'lr 8/26/2010 09:46'! optionalStar | parser | parser := PPPattern any. rewriter replace: parser optional star with: parser star! ! !PPOptimizer methodsFor: 'optimizations-operators' stamp: 'lr 8/26/2010 10:02'! optionalStarChoice | parser | parser := PPPattern any. rewriter replace: parser optional / parser star with: parser star! ! !PPOptimizer methodsFor: 'optimizations-operators' stamp: 'lr 8/26/2010 10:00'! plusChoice | parser | parser := PPPattern any. rewriter replace: parser plus / parser with: parser plus! ! !PPOptimizer methodsFor: 'optimizations-epsilon' stamp: 'lr 8/26/2010 11:09'! plusEpsilon rewriter replace: nil asParser plus with: nil asParser! ! !PPOptimizer methodsFor: 'optimizations-operators' stamp: 'lr 8/26/2010 09:46'! plusOptional | parser | parser := PPPattern any. rewriter replace: parser plus optional with: parser star! ! !PPOptimizer methodsFor: 'optimizations-operators' stamp: 'lr 8/26/2010 10:03'! plusOptionalChoice | parser | parser := PPPattern any. rewriter replace: parser plus / parser optional with: parser star! ! !PPOptimizer methodsFor: 'optimizations-operators' stamp: 'lr 8/26/2010 09:46'! plusPlus | parser | parser := PPPattern any. rewriter replace: parser plus plus with: parser plus! ! !PPOptimizer methodsFor: 'optimizations-operators' stamp: 'lr 8/26/2010 09:46'! plusStar | parser | parser := PPPattern any. rewriter replace: parser plus star with: parser star! ! !PPOptimizer methodsFor: 'optimizations-operators' stamp: 'lr 8/26/2010 10:03'! plusStarChoice | parser | parser := PPPattern any. rewriter replace: parser plus / parser star with: parser star! ! !PPOptimizer methodsFor: 'optimizations-choice' stamp: 'lr 4/29/2010 23:19'! prefixedChoice | before prefix body1 body2 postfix after | before := PPListPattern any. prefix := PPPattern any. body1 := PPListPattern any. body2 := PPListPattern any. postfix := PPPattern any. after := PPListPattern any. rewriter replace: before / (prefix , body1) / (prefix , body2) / after with: before / (prefix , (body1 / body2)) / after. rewriter replace: before / (body1 , postfix) / (body2 , postfix) / after with: before / ((body1 / body2) , postfix) / after! ! !PPOptimizer methodsFor: 'optimizations-choice' stamp: 'lr 4/29/2010 21:41'! repeatedChoice | before parser between after | before := PPListPattern any. parser := PPPattern any. between := PPListPattern any. after := PPListPattern any. rewriter replace: before / parser / between / parser / after with: before / parser / between / after! ! !PPOptimizer methodsFor: 'optimizations-choice' stamp: 'lr 5/3/2010 21:50'! singleChoice | parser | parser := PPPattern any. rewriter replace: (PPChoiceParser with: parser) with: parser! ! !PPOptimizer methodsFor: 'optimizations-operators' stamp: 'lr 8/26/2010 10:00'! starChoice | parser | parser := PPPattern any. rewriter replace: parser star / parser with: parser star! ! !PPOptimizer methodsFor: 'optimizations-epsilon' stamp: 'lr 8/26/2010 11:09'! starEpsilon rewriter replace: nil asParser star with: nil asParser! ! !PPOptimizer methodsFor: 'optimizations-operators' stamp: 'lr 8/26/2010 09:47'! starOptional | parser | parser := PPPattern any. rewriter replace: parser star optional with: parser star! ! !PPOptimizer methodsFor: 'optimizations-operators' stamp: 'lr 8/26/2010 10:03'! starOptionalChoice | parser | parser := PPPattern any. rewriter replace: parser star / parser optional with: parser star! ! !PPOptimizer methodsFor: 'optimizations-operators' stamp: 'lr 8/26/2010 09:47'! starPlus | parser | parser := PPPattern any. rewriter replace: parser star plus with: parser star! ! !PPOptimizer methodsFor: 'optimizations-operators' stamp: 'lr 8/26/2010 10:03'! starPlusChoice | parser | parser := PPPattern any. rewriter replace: parser star / parser plus with: parser star! ! !PPOptimizer methodsFor: 'optimizations-operators' stamp: 'lr 8/26/2010 09:47'! starStar | parser | parser := PPPattern any. rewriter replace: parser star star with: parser star! ! !PPOptimizer methodsFor: 'optimizations-delegate' stamp: 'lr 3/16/2013 21:46'! unusedBinding rewriter replace: (PPPattern class: PPBindParser) withValueFrom: [ :parser | parser children first ] when: [ :parser | parser capture isNil ]! ! Object subclass: #PPWriter instanceVariableNames: 'stream' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Writer'! PPWriter subclass: #PPDartWriter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Writer'! !PPDartWriter methodsFor: 'writing-custom' stamp: 'lr 4/16/2013 17:40'! writeParser: aParser aParser writeDartOn: self! ! !PPDartWriter methodsFor: 'writing-custom' stamp: 'lr 4/16/2013 23:38'! writeProduction: aParser stream tab; tab; nextPutAll: 'def('. self writeString: aParser name. stream nextPutAll: ', '. self writeParser: aParser. stream nextPutAll: ');'; cr! ! !PPDartWriter methodsFor: 'writing-custom' stamp: 'lr 4/16/2013 23:39'! writeReference: aParser stream nextPutAll: 'ref('. self writeString: aParser name. stream nextPutAll: ')'! ! !PPDartWriter methodsFor: 'converting' stamp: 'lr 4/16/2013 23:45'! writeString: aString stream nextPut: $'. aString do: [ :char | (char = $' or: [ char = $$ or: [ char = $\ ] ]) ifTrue: [ stream nextPut: $\; nextPut: char ] ifFalse: [ (char isAlphaNumeric or: [ ' !!"#$%&''()*+,-./;<=>?@[\]^_`{}' includes: char ]) ifTrue: [ stream nextPut: char ] ifFalse: [ stream nextPutAll: '\u'; nextPutAll: (char asInteger printPaddedWith: $0 to: 4 base: 16) asLowercase ] ] ]. stream nextPut: $'! ! PPWriter subclass: #PPJavaWriter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Writer'! !PPJavaWriter methodsFor: 'converting' stamp: 'lr 4/16/2013 23:46'! writeCharacter: aCharacter stream nextPut: $'. (aCharacter = $' or: [ aCharacter = $\ ]) ifTrue: [ stream nextPut: $\; nextPut: aCharacter ] ifFalse: [ (aCharacter isAlphaNumeric or: [ ' !!"#$%&''()*+,-./;<=>?@[\]^_`{}' includes: aCharacter ]) ifTrue: [ stream nextPut: aCharacter ] ifFalse: [ stream nextPutAll: '\u'; nextPutAll: (aCharacter asInteger printPaddedWith: $0 to: 4 base: 16) asLowercase ] ]. stream nextPut: $'! ! !PPJavaWriter methodsFor: 'writing-custom' stamp: 'lr 4/16/2013 17:40'! writeParser: aParser aParser writeJavaOn: self! ! !PPJavaWriter methodsFor: 'writing-custom' stamp: 'lr 4/16/2013 23:39'! writeProduction: aParser stream tab; tab; nextPutAll: 'def('. self writeString: aParser name. stream nextPutAll: ', '. self writeParser: aParser. stream nextPutAll: ');'; cr! ! !PPJavaWriter methodsFor: 'writing-custom' stamp: 'lr 4/16/2013 23:39'! writeReference: aParser stream nextPutAll: 'ref('. self writeString: aParser name. stream nextPutAll: ')'! ! !PPJavaWriter methodsFor: 'converting' stamp: 'lr 4/16/2013 23:46'! writeString: aString stream nextPut: $". aString do: [ :char | (char = $" or: [ char = $\ ]) ifTrue: [ stream nextPut: $\; nextPut: char ] ifFalse: [ (char isAlphaNumeric or: [ ' !!"#$%&''()*+,-./;<=>?@[\]^_`{}' includes: char ]) ifTrue: [ stream nextPut: char ] ifFalse: [ stream nextPutAll: '\u'; nextPutAll: (char asInteger printPaddedWith: $0 to: 4 base: 16) asLowercase ] ] ]. stream nextPut: $"! ! PPWriter subclass: #PPSmalltalkWriter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitBeta-Writer'! !PPSmalltalkWriter methodsFor: 'converting' stamp: 'lr 4/16/2013 22:48'! toString: aString self subclassResponsibility! ! !PPSmalltalkWriter methodsFor: 'writing-custom' stamp: 'lr 4/16/2013 17:40'! writeParser: aParser aParser writeSmalltalkOn: self! ! !PPSmalltalkWriter methodsFor: 'writing-custom' stamp: 'lr 4/16/2013 18:45'! writeProduction: aParser stream nextPutAll: aParser name; cr; tab; nextPutAll: '^ '. self writeParser: aParser. stream cr; cr! ! !PPSmalltalkWriter methodsFor: 'writing-custom' stamp: 'lr 4/16/2013 17:46'! writeReference: aParser stream nextPutAll: aParser name! ! !PPWriter class methodsFor: 'instance creation' stamp: 'lr 4/16/2013 18:42'! write: aParser ^ self new start: aParser! ! !PPWriter methodsFor: 'utilities' stamp: 'lr 4/16/2013 23:13'! isSeparatedBy: aParser PPSearcher new matches: (PPPattern any separatedBy: PPPattern any) children first do: [ :match | ^ match = aParser ]; execute: aParser. ^ false! ! !PPWriter methodsFor: 'writing' stamp: 'lr 4/17/2013 00:00'! start: aParser aParser name: 'start'. stream := WriteStream on: String new. (aParser allNamedParsers sort: [ :a :b | a name < b name ]) do: [ :each | self writeProduction: each ]. ^ stream contents! ! !PPWriter methodsFor: 'accessing' stamp: 'lr 4/16/2013 17:46'! stream ^ stream! ! !PPWriter methodsFor: 'writing' stamp: 'lr 4/16/2013 17:34'! write: aParser aParser name isNil ifTrue: [ self writeParser: aParser ] ifFalse: [ self writeReference: aParser ]! ! !PPWriter methodsFor: 'writing-custom' stamp: 'lr 4/16/2013 17:34'! writeParser: aParser self subclassResponsibility! ! !PPWriter methodsFor: 'writing-custom' stamp: 'lr 4/16/2013 17:43'! writeProduction: aParser self subclassResponsibility! ! !PPWriter methodsFor: 'writing-custom' stamp: 'lr 4/16/2013 17:32'! writeReference: aParser self subclassResponsibility! !