SystemOrganization addCategory: #'PetitParser-Core'! SystemOrganization addCategory: #'PetitParser-Tests'! !String methodsFor: '*petitparser' stamp: 'lr 4/18/2008 10:48'! asLiteral ^ PPStringLiteral on: self! ! Object subclass: #PPFail instanceVariableNames: 'message reason' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPFail class methodsFor: 'instance-creation' stamp: 'lr 4/18/2008 12:03'! reason: aString ^ self basicNew setReason: aString! ! !PPFail methodsFor: 'printing' stamp: 'lr 4/18/2008 12:04'! printOn: aStream aStream nextPutAll: reason! ! !PPFail methodsFor: 'initialize-release' stamp: 'lr 4/18/2008 12:04'! setReason: aString reason := aString! ! Object subclass: #PPParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! PPParser subclass: #PPEnd instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPEnd commentStamp: 'lr 4/18/2008 11:42' prior: 0! A parser that succeeds if we are at the end of the input stream.! !PPEnd methodsFor: 'parsing' stamp: 'lr 4/18/2008 12:05'! parse: aStream ^ aStream atEnd ifFalse: [ PPFail reason: 'End expected' ]! ! PPParser subclass: #PPEpsilon instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPEpsilon commentStamp: 'lr 4/18/2008 11:43' prior: 0! A parser that does nothing and always succeeds.! !PPEpsilon methodsFor: 'parsing' stamp: 'lr 4/18/2008 11:47'! parse: aStream ^ nil! ! PPParser subclass: #PPList instanceVariableNames: 'parsers' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! PPList subclass: #PPAlternative instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPAlternative methodsFor: 'parsing' stamp: 'lr 4/18/2008 12:06'! parse: aStream | item | parsers do: [ :parser | item := parser parse: aStream. item class = PPFail ifFalse: [ ^ item ] ]. ^ item! ! !PPAlternative methodsFor: 'printing' stamp: 'lr 4/18/2008 10:53'! printOn: aStream parsers do: [ :each | aStream print: each ] separatedBy: [ aStream nextPutAll: ' | ' ]! ! !PPAlternative methodsFor: 'operations' stamp: 'lr 4/18/2008 10:53'! | aRule parsers add: aRule! ! !PPList methodsFor: 'initialization' stamp: 'lr 4/18/2008 10:53'! initialize super initialize. parsers := OrderedCollection new! ! PPList subclass: #PPSequence instanceVariableNames: 'lower upper' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPSequence methodsFor: 'operations' stamp: 'lr 4/18/2008 10:53'! , aRule parsers add: aRule! ! !PPSequence methodsFor: 'parsing' stamp: 'lr 4/18/2008 12:19'! parse: aStream | position items item | position := aStream position. items := OrderedCollection new: parsers size. parsers do: [ :parser | item := parser parse: aStream. item class = PPFail ifFalse: [ items add: item ] ifTrue: [ aStream position: position. ^ item ] ]. ^ items asArray! ! !PPSequence methodsFor: 'printing' stamp: 'lr 4/18/2008 10:53'! printOn: aStream parsers do: [ :each | aStream print: each ] separatedBy: [ aStream space ]! ! PPParser subclass: #PPLiteral instanceVariableNames: 'value' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! PPLiteral subclass: #PPCharacterLiteral instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPCharacterLiteral methodsFor: 'parsing' stamp: 'lr 4/18/2008 12:17'! parse: aStream ^ aStream peek = value ifTrue: [ aStream next ] ifFalse: [ PPFail reason: value printString , ' expected' ]! ! !PPLiteral class methodsFor: 'instance creation' stamp: 'lr 4/18/2008 10:52'! on: anObject ^ self new setValue: anObject! ! !PPLiteral methodsFor: 'printing' stamp: 'lr 4/18/2008 10:52'! printOn: aStream aStream print: value! ! !PPLiteral methodsFor: 'initialization' stamp: 'lr 4/18/2008 10:49'! setValue: anObject value := anObject! ! PPLiteral subclass: #PPStringLiteral instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPStringLiteral methodsFor: 'parsing' stamp: 'lr 4/18/2008 12:15'! parse: aStream | position item | position := aStream position. item := aStream next: value size. item = value ifTrue: [ ^ item ]. aStream position: position. ^ PPFail reason: value , ' expected'! ! PPParser subclass: #PPMany instanceVariableNames: 'parser' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPMany class methodsFor: 'instance creation' stamp: 'lr 4/18/2008 12:52'! on: aParser ^ self new setParser: aParser! ! !PPMany methodsFor: 'parsing' stamp: 'lr 4/18/2008 12:57'! parse: aStream | position items item | items := OrderedCollection new. [ position := aStream position. item := parser parse: aStream. item class = PPFail ifTrue: [ aStream position: position. ^ items asArray ]. items add: item ] repeat! ! !PPMany methodsFor: 'initialization' stamp: 'lr 4/18/2008 12:58'! setParser: aParser parser := aParser! ! !PPParser class methodsFor: 'instance creation' stamp: 'lr 4/18/2008 10:35'! new ^ self basicNew initialize! ! !PPParser methodsFor: 'operations' stamp: 'lr 4/18/2008 10:42'! , aParser "Answer a new parser that parses the receiver followed by aParser." ^ PPSequence new , self , aParser! ! !PPParser methodsFor: 'initialization' stamp: 'lr 4/18/2008 10:35'! initialize! ! !PPParser methodsFor: 'operations' stamp: 'lr 4/18/2008 12:52'! many "Answer a new parser that parses the receiver zero or more times." ^ PPMany on: self! ! !PPParser methodsFor: 'operations' stamp: 'lr 4/18/2008 12:52'! many1 "Answer a new parser that parses the receiver one or more times." ^ self , self many! ! !PPParser methodsFor: 'operations' stamp: 'lr 4/18/2008 12:51'! optional "Answer a new parser that parses the receiver, if possible." ^ self | PPEpsilon new! ! !PPParser methodsFor: 'parsing' stamp: 'lr 4/18/2008 11:46'! parse: aStream self subclassResponsabily! ! !PPParser methodsFor: 'operations' stamp: 'lr 4/18/2008 10:42'! | aParser "Answer a new parser that either parses the receiver or aParser." ^ PPAlternative new | self | aParser! ! Object subclass: #PPStream instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !Character methodsFor: '*petitparser' stamp: 'lr 4/18/2008 10:49'! asLiteral ^ PPCharacterLiteral on: self! ! TestCase subclass: #PPParserTest instanceVariableNames: 'parser' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Tests'! !PPParserTest methodsFor: 'utilities' stamp: 'lr 4/18/2008 12:14'! assert: aString gives: anObject | result | result := parser parse: aString readStream. self assert: result = anObject! ! !PPParserTest methodsFor: 'utilities' stamp: 'lr 4/18/2008 12:14'! assertFail: aString | result | result := parser parse: aString readStream. self assert: result class == PPFail! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 4/18/2008 12:20'! testAlternative parser := $a asLiteral | $b asLiteral. self assert: 'a' gives: $a. self assert: 'b' gives: $b. self assertFail: ''. self assertFail: 'c'. self assertFail: 'ca'! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 4/18/2008 12:30'! testCharacter parser := $a asLiteral. self assert: 'a' gives: $a. self assertFail: ''. self assertFail: 'b'. self assertFail: 'ba'! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 4/18/2008 12:28'! testMany parser := $a asLiteral many. self assert: '' gives: #(). self assert: 'a' gives: #($a). self assert: 'aa' gives: #($a $a). self assert: 'aaa' gives: #($a $a $a). self assert: 'aaab' gives: #($a $a $a)! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 4/18/2008 12:28'! testMany1 parser := $a asLiteral many1. self assert: 'a' gives: #($a). self assert: 'aa' gives: #($a $a). self assert: 'aaa' gives: #($a $a $a). self assert: 'aaab' gives: #($a $a $a). self assertFail: ''. self assertFail: 'b'! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 4/18/2008 12:51'! testOptional parser := $a asLiteral optional. self assert: '' gives: nil. self assert: 'a' gives: $a. self assert: 'aa' gives: $a! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 4/18/2008 12:19'! testSequence parser := $a asLiteral , $b asLiteral. self assert: 'ab' gives: #( $a $b ). self assertFail: ''. self assertFail: 'a'. self assertFail: 'aa'. self assertFail: 'aab'! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 4/18/2008 12:30'! testString parser := 'abc' asLiteral. self assert: 'abc' gives: 'abc'. self assert: 'abc ' gives: 'abc'. self assertFail: 'ab'. self assertFail: 'ab'. self assertFail: 'abd' ! !