SystemOrganization addCategory: #'PetitParser-Core'! SystemOrganization addCategory: #'PetitParser-Tools'! SystemOrganization addCategory: #'PetitParser-Tests'! !String methodsFor: '*petitparser-core-converting' stamp: 'lr 11/7/2009 13:32'! asParser ^ PPLiteralSequenceParser on: self! ! !Set methodsFor: '*petitparser-core-converting' stamp: 'lr 9/23/2008 16:26'! asParser ^ PPChoiceParser withAll: (self collect: [ :each | each asParser ])! ! !PositionableStream methodsFor: '*petitparser-core-converting' stamp: 'lr 3/27/2009 15:44'! asParserStream ^ PPStream on: collection from: position to: readLimit! ! !PositionableStream methodsFor: '*petitparser-core-accessing' stamp: 'lr 4/19/2008 13:17'! collection ^ collection! ! !BlockContext methodsFor: '*petitparser-core-converting' stamp: 'lr 7/4/2008 10:18'! asParser ^ PPPluggableParser on: self! ! !BlockClosure methodsFor: '*petitparser-core-converting' stamp: 'lr 6/18/2008 08:47'! asParser ^ PPPluggableParser on: self! ! !Text methodsFor: '*petitparser-core' stamp: 'lr 5/19/2008 15:10'! asParserStream ^ string asParserStream! ! !SequenceableCollection methodsFor: '*petitparser-core-converting' stamp: 'lr 9/17/2008 22:00'! asParser ^ PPSequenceParser withAll: (self collect: [ :each | each asParser ])! ! !SequenceableCollection methodsFor: '*petitparser-core-converting' stamp: 'lr 5/19/2008 15:22'! asParserStream ^ PPStream on: self! ! !Object methodsFor: '*petitparser-core-converting' stamp: 'lr 4/20/2008 16:06'! asParser ^ PPPredicateParser expect: self! ! !Object methodsFor: '*petitparser-core-testing' stamp: 'lr 4/18/2008 13:40'! isFailure ^ false! ! Object subclass: #PPFailure instanceVariableNames: 'reason position' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPFailure class methodsFor: 'instance creation' stamp: 'lr 1/8/2010 15:07'! at: anInteger ^ self basicNew position: anInteger; yourself! ! !PPFailure class methodsFor: 'instance creation' stamp: 'lr 1/8/2010 15:07'! reason: aString ^ self basicNew reason: aString; yourself! ! !PPFailure class methodsFor: 'instance creation' stamp: 'lr 3/18/2009 10:03'! reason: aString at: anInteger ^ self basicNew reason: aString; position: anInteger; yourself! ! !PPFailure methodsFor: 'testing' stamp: 'lr 4/18/2008 13:41'! isFailure ^ true! ! !PPFailure methodsFor: 'accessing' stamp: 'lr 4/21/2009 08:43'! position ^ position ifNil: [ 0 ]! ! !PPFailure methodsFor: 'accessing' stamp: 'lr 4/19/2008 09:24'! position: anInteger position := anInteger! ! !PPFailure methodsFor: 'printing' stamp: 'lr 7/2/2008 14:27'! printOn: aStream reason isNil ifTrue: [ super printOn: aStream ] ifFalse: [ aStream nextPutAll: reason ]. position isNil ifFalse: [ aStream nextPutAll: ' at '; print: position ]! ! !PPFailure methodsFor: 'accessing' stamp: 'lr 4/19/2008 09:24'! reason ^ reason! ! !PPFailure methodsFor: 'accessing' stamp: 'lr 4/18/2008 14:18'! reason: aString reason := aString! ! Object subclass: #PPMemento instanceVariableNames: 'result count position' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPMemento class methodsFor: 'instance creation' stamp: 'lr 4/22/2008 18:21'! new ^ self basicNew initialize! ! !PPMemento methodsFor: 'accessing-readonly' stamp: 'lr 4/22/2008 18:23'! count ^ count! ! !PPMemento methodsFor: 'actions' stamp: 'lr 4/22/2008 18:20'! increment count := count + 1! ! !PPMemento methodsFor: 'initialization' stamp: 'lr 4/22/2008 18:21'! initialize count := 0 ! ! !PPMemento methodsFor: 'accessing' stamp: 'lr 4/22/2008 18:23'! position ^ position! ! !PPMemento methodsFor: 'accessing' stamp: 'lr 4/26/2008 15:48'! position: anInteger position := anInteger! ! !PPMemento methodsFor: 'accessing' stamp: 'lr 4/24/2008 10:15'! result ^ result! ! !PPMemento methodsFor: 'accessing' stamp: 'lr 4/22/2008 18:23'! result: anObject result := anObject! ! Object subclass: #PPParser instanceVariableNames: 'name' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! PPParser subclass: #PPDelegateParser instanceVariableNames: 'parser' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPDelegateParser commentStamp: 'lr 4/19/2008 12:57' prior: 0! A parser that delegates to another parser.! PPDelegateParser subclass: #PPActionParser instanceVariableNames: 'block' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPActionParser commentStamp: 'lr 4/19/2008 12:55' prior: 0! A parser that performs an action on the delegate.! !PPActionParser class methodsFor: 'instance creation' stamp: 'lr 3/30/2009 10:19'! on: aParser block: aBlock ^ (self on: aParser) block: aBlock! ! !PPActionParser methodsFor: 'accessing' stamp: 'lr 11/19/2009 11:45'! block: aBlock block := aBlock! ! !PPActionParser methodsFor: 'parsing' stamp: 'lr 4/2/2009 18:39'! parse: aStream | element | ^ (element := super parse: aStream) isFailure ifFalse: [ block value: element ] ifTrue: [ element ]! ! PPDelegateParser subclass: #PPAndParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPAndParser commentStamp: 'lr 12/4/2009 18:38' prior: 0! The and-predicate, a parser that succeeds whenever its delegate does, but consumes the input stream [Parr 1994, 1995].! !PPAndParser methodsFor: 'parsing' stamp: 'lr 4/2/2009 18:39'! parse: aStream | element position | position := aStream position. element := super parse: aStream. aStream position: position. ^ element! ! PPAndParser subclass: #PPNotParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPNotParser commentStamp: 'lr 12/4/2009 18:38' prior: 0! The npt-predicate, a parser that succeeds whenever its delegate does not, but consumes no input [Parr 1994, 1995].! !PPNotParser methodsFor: 'operations' stamp: 'lr 7/2/2008 12:13'! not ^ parser! ! !PPNotParser methodsFor: 'parsing' stamp: 'lr 1/8/2010 15:02'! parse: aStream | element | ^ (element := super parse: aStream) isFailure ifFalse: [ PPFailure at: aStream position ]! ! PPDelegateParser subclass: #PPCompositeParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Tools'! !PPCompositeParser commentStamp: 'lr 12/4/2009 18:38' prior: 0! A PPCompositeParser is composed parser built from various primitive parsers. Every production in the receiver is specified as a method that returns its parser. Note that every production requires an instance variable of the same name, otherwise the production is not cached and cannot be used in recursive grammars. Productions should refer to each other by reading the respective inst-var. Note: these inst-vars are typically not written, as the assignment happens in the initialize method using reflection. The start production is defined in the method start. It is aliased to the inst-var parser defined in the superclass of PPCompositeParser.! PPCompositeParser subclass: #PPArithmeticParser instanceVariableNames: 'terms addition factors multiplication power primary parentheses number' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Tests'! !PPArithmeticParser methodsFor: 'grammar' stamp: 'lr 11/22/2009 13:11'! addition ^ (factors separatedBy: ($+ asParser / $- asParser) token) foldLeft: [ :a :op :b | a perform: op value asSymbol with: b ]! ! !PPArithmeticParser methodsFor: 'grammar' stamp: 'lr 9/15/2008 09:28'! factors ^ multiplication / power! ! !PPArithmeticParser methodsFor: 'grammar' stamp: 'lr 11/22/2009 13:11'! multiplication ^ (power separatedBy: ($* asParser / $/ asParser) token) foldLeft: [ :a :op :b | a perform: op value asSymbol with: b ]! ! !PPArithmeticParser methodsFor: 'grammar' stamp: 'lr 11/22/2009 13:11'! number ^ ($- asParser optional , #digit asParser plus , ($. asParser , #digit asParser plus) optional) token ==> [ :token | token value asNumber ]! ! !PPArithmeticParser methodsFor: 'grammar' stamp: 'lr 7/3/2008 16:28'! parentheses ^ $( asParser flatten , terms , $) asParser flatten ==> #second! ! !PPArithmeticParser methodsFor: 'grammar' stamp: 'lr 11/22/2009 13:11'! power ^ (primary separatedBy: $^ asParser token) foldRight: [ :a :op :b | a raisedTo: b ]! ! !PPArithmeticParser methodsFor: 'grammar' stamp: 'lr 9/15/2008 09:28'! primary ^ number / parentheses! ! !PPArithmeticParser methodsFor: 'accessing' stamp: 'lr 7/3/2008 17:06'! start ^ terms end! ! !PPArithmeticParser methodsFor: 'grammar' stamp: 'lr 9/15/2008 09:29'! terms ^ addition / factors! ! !PPCompositeParser class methodsFor: 'accessing' stamp: 'lr 1/29/2010 11:35'! ignoredNames "Answer a collection of instance-variables that should not be automatically initialized with productions, but that are used internal to the composite parser." ^ PPCompositeParser allInstVarNames! ! !PPCompositeParser class methodsFor: 'instance creation' stamp: 'lr 12/7/2009 08:24'! new "Answer a new parser starting at the default start symbol." ^ self newStartingAt: self startSymbol! ! !PPCompositeParser class methodsFor: 'instance creation' stamp: 'lr 12/7/2009 08:24'! newStartingAt: aSymbol "Answer a new parser starting at aSymbol." ^ self basicNew initializeStartingAt: aSymbol! ! !PPCompositeParser class methodsFor: 'parsing' stamp: 'lr 12/7/2009 08:25'! parse: aString ^ self parse: aString startingAt: self startSymbol! ! !PPCompositeParser class methodsFor: 'parsing' stamp: 'lr 12/7/2009 08:27'! parse: aString onError: aBlock ^ self result: (self parse: aString) onError: aBlock! ! !PPCompositeParser class methodsFor: 'parsing' stamp: 'lr 12/7/2009 08:26'! parse: aString startingAt: aSymbol ^ (self newStartingAt: aSymbol) parse: aString asParserStream! ! !PPCompositeParser class methodsFor: 'parsing' stamp: 'lr 12/7/2009 08:29'! parse: aString startingAt: aSymbol onError: aBlock ^ self result: (self parse: aString startingAt: aSymbol) onError: aBlock! ! !PPCompositeParser class methodsFor: 'private' stamp: 'lr 12/7/2009 08:29'! result: anObject onError: aBlock anObject isFailure ifFalse: [ ^ anObject ]. aBlock numArgs = 0 ifTrue: [ ^ aBlock value ]. aBlock numArgs = 1 ifTrue: [ ^ aBlock value: anObject ]. ^ aBlock value: anObject reason value: anObject position! ! !PPCompositeParser class methodsFor: 'accessing' stamp: 'lr 12/7/2009 08:20'! startSymbol "Answer the method that represents the default start symbol." ^ #start! ! !PPCompositeParser methodsFor: 'initialization' stamp: 'lr 12/7/2009 08:47'! initializeStartingAt: aSymbol | allVariableNames ignoredVariableNames productionIndexesAndNames | self initialize. "find all the produtions that need to be initialized" allVariableNames := self class allInstVarNames. ignoredVariableNames := self class ignoredNames. productionIndexesAndNames := ((1 to: self class instSize) collect: [ :index | index -> (allVariableNames at: index) asSymbol ]) reject: [ :assoc | ignoredVariableNames includes: assoc value ]. "initialize productions with an undefined parser to be replaced later" parser := PPUnresolvedParser named: aSymbol. productionIndexesAndNames do: [ :assoc | self instVarAt: assoc key put: (PPUnresolvedParser named: assoc value) ]. parser := self perform: aSymbol. "resolve unresolved parsers with their actual implementation" productionIndexesAndNames do: [ :assoc | (self respondsTo: assoc value) ifFalse: [ self error: 'Unable to initialize ' , assoc value printString ] ifTrue: [ (self instVarAt: assoc key) def: (self perform: assoc value) ] ]! ! !PPCompositeParser methodsFor: 'querying' stamp: 'lr 12/4/2009 18:39'! productionAt: aSymbol "Answer the production named aSymbol." ^ self productionAt: aSymbol ifAbsent: [ nil ]! ! !PPCompositeParser methodsFor: 'querying' stamp: 'lr 12/7/2009 08:47'! productionAt: aSymbol ifAbsent: aBlock "Answer the production named aSymbol, if there is no such production answer the result of evaluating aBlock." | index | (self class ignoredNames includes: aSymbol) ifTrue: [ ^ aBlock value ]. (self class startSymbol = aSymbol) ifTrue: [ ^ parser ]. ^ self instVarAt: (self class allInstVarNames indexOf: aSymbol ifAbsent: [ ^ aBlock value ])! ! !PPCompositeParser methodsFor: 'accessing' stamp: 'lr 5/16/2008 17:32'! start "Answer the production to start this parser with." self subclassResponsibility! ! PPCompositeParser subclass: #PPLambdaParser instanceVariableNames: 'expression abstraction application variable' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Tests'! !PPLambdaParser class methodsFor: 'curch-booleans' stamp: 'lr 4/3/2009 08:28'! and ^ self parse: '\p.\q.((p q) p)'! ! !PPLambdaParser class methodsFor: 'curch-booleans' stamp: 'lr 4/3/2009 08:28'! false ^ self parse: '\x.\y.y'! ! !PPLambdaParser class methodsFor: 'curch-booleans' stamp: 'lr 4/3/2009 08:28'! ifthenelse ^ self parse: '\p.p'! ! !PPLambdaParser class methodsFor: 'curch-booleans' stamp: 'lr 4/3/2009 08:28'! not ^ self parse: '\p.\a.\b.((p b) a)'! ! !PPLambdaParser class methodsFor: 'curch-booleans' stamp: 'lr 4/3/2009 08:28'! or ^ self parse: '\p.\q.((p p) q)'! ! !PPLambdaParser class methodsFor: 'curch-booleans' stamp: 'lr 4/3/2009 08:28'! true ^ self parse: '\x.\y.x'! ! !PPLambdaParser methodsFor: 'productions' stamp: 'lr 11/22/2009 13:12'! abstraction ^ $\ asParser token , variable , $. asParser token , expression ==> [ :node | Array with: node second with: node fourth ]! ! !PPLambdaParser methodsFor: 'productions' stamp: 'lr 11/22/2009 13:12'! application ^ $( asParser token , expression , expression , $) asParser token ==> [ :node | Array with: node second with: node third ]! ! !PPLambdaParser methodsFor: 'productions' stamp: 'lr 9/15/2008 09:29'! expression ^ variable / abstraction / application! ! !PPLambdaParser methodsFor: 'accessing' stamp: 'lr 5/19/2008 11:35'! start ^ expression end! ! !PPLambdaParser methodsFor: 'productions' stamp: 'lr 11/22/2009 13:12'! variable ^ (#letter asParser , #word asParser star) token ==> [ :token | token value ]! ! !PPDelegateParser class methodsFor: 'instance creation' stamp: 'lr 4/20/2008 16:22'! on: aParser ^ self new setParser: aParser! ! !PPDelegateParser methodsFor: 'accessing' stamp: 'lr 10/21/2009 16:37'! children ^ Array with: parser! ! !PPDelegateParser methodsFor: 'parsing' stamp: 'lr 4/2/2009 18:36'! parse: aStream ^ parser parse: aStream! ! !PPDelegateParser methodsFor: 'initialization' stamp: 'lr 4/20/2008 16:23'! setParser: aParser parser := aParser! ! PPDelegateParser subclass: #PPEndOfInputParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPEndOfInputParser commentStamp: 'lr 4/18/2008 13:46' prior: 0! A parser that succeeds only at the end of the input stream.! !PPEndOfInputParser methodsFor: 'operations' stamp: 'lr 12/7/2009 08:53'! end ^ self! ! !PPEndOfInputParser methodsFor: 'parsing' stamp: 'lr 4/2/2009 18:40'! parse: aStream | position result | position := aStream position. result := super parse: aStream. (result isFailure or: [ aStream atEnd ]) ifTrue: [ ^ result ]. aStream position: position. ^ PPFailure reason: 'end of input expected' at: aStream position! ! PPDelegateParser subclass: #PPExpressionParser instanceVariableNames: 'operators' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Tools'! !PPExpressionParser commentStamp: 'lr 11/29/2009 09:47' prior: 0! A PPExpressionParser is a parser to conveniently define an expression grammar with prefix, postfix, and left- and right-associative infix operators. The following code initializes a parser for arithmetic expressions. First we instantiate an expression parser, a simple parser for expressions in parenthesis and a simple parser for integer numbers. expression := PPExpressionParser new. parens := $( asParser token , expression , $) asParser token ==> [ :nodes | nodes second ]. integer := #digit asParser plus token ==> [ :token | token value asInteger ]. Then we define on what term the expression grammar is built on: expression term: parens / integer. Finally we define the operator-groups in descending precedence. Note, that the action blocks receive both, the terms and the parsed operator in the order they appear in the parsed input. expression group: [ :g | g prefix: $- asParser token do: [ :op :a | a negated ] ]; group: [ :g | g postfix: '++' asParser token do: [ :a :op | a + 1 ]. g postfix: '--' asParser token do: [ :a :op | a - 1 ] ]; group: [ :g | g right: $^ asParser token do: [ :a :op :b | a raisedTo: b ] ]; group: [ :g | g left: $* asParser token do: [ :a :op :b | a * b ]. g left: $/ asParser token do: [ :a :op :b | a / b ] ]; group: [ :g | g left: $+ asParser token do: [ :a :op :b | a + b ]. g left: $- asParser token do: [ :a :op :b | a - b ] ]. After evaluating the above code the 'expression' is an efficient parser that evaluates examples like: expression parse: '-8++' asParserStream. expression parse: '1+2*3' asParserStream. expression parse: '1*2+3' asParserStream. expression parse: '(1+2)*3' asParserStream. expression parse: '8/4/2' asParserStream. expression parse: '8/(4/2)' asParserStream. expression parse: '2^2^3' asParserStream. expression parse: '(2^2)^3' asParserStream.! !PPExpressionParser methodsFor: 'private' stamp: 'FirstnameLastname 11/26/2009 20:48'! build: aParser left: aChoiceParser ^ (aParser separatedBy: aChoiceParser) foldLeft: [ :a :op :b | op first value: a value: op second value: b ]! ! !PPExpressionParser methodsFor: 'private' stamp: 'lr 12/4/2009 17:38'! build: aParser postfix: aChoiceParser ^ aParser , aChoiceParser star map: [ :term :ops | ops inject: term into: [ :result :operator | operator first value: result value: operator second ] ]! ! !PPExpressionParser methodsFor: 'private' stamp: 'lr 12/4/2009 17:39'! build: aParser prefix: aChoiceParser ^ aChoiceParser star , aParser map: [ :ops :term | ops reversed inject: term into: [ :result :operator | operator first value: operator second value: result ] ]! ! !PPExpressionParser methodsFor: 'private' stamp: 'FirstnameLastname 11/26/2009 20:48'! build: aParser right: aChoiceParser ^ (aParser separatedBy: aChoiceParser) foldRight: [ :a :op :b | op first value: a value: op second value: b ]! ! !PPExpressionParser methodsFor: 'private' stamp: 'FirstnameLastname 11/26/2009 21:15'! buildOn: aParser ^ self buildSelectors inject: aParser into: [ :term :selector | | list | list := operators at: selector ifAbsent: [ #() ]. list isEmpty ifTrue: [ term ] ifFalse: [ self perform: selector with: term with: (list size = 1 ifTrue: [ list first first ==> [ :operator | Array with: list first second with: operator ] ] ifFalse: [ list inject: PPChoiceParser new into: [ :choice :each | choice / (each first ==> [ :operator | Array with: each second with: operator ]) ] ]) ] ]! ! !PPExpressionParser methodsFor: 'private' stamp: 'FirstnameLastname 11/26/2009 20:48'! buildSelectors ^ #(build:prefix: build:postfix: build:right: build:left:)! ! !PPExpressionParser methodsFor: 'specifying' stamp: 'lr 12/4/2009 17:38'! group: aOneArgumentBlock "Defines a priority group by evaluating aOneArgumentBlock." operators := Dictionary new. parser := [ aOneArgumentBlock value: self. self buildOn: parser ] ensure: [ operators := nil ]! ! !PPExpressionParser methodsFor: 'specifying' stamp: 'FirstnameLastname 11/26/2009 20:49'! left: aParser do: aThreeArgumentBlock "Define an operator aParser that is left-associative. Evaluate aThreeArgumentBlock with the first term, the operator, and the second term." self operator: #build:left: parser: aParser do: aThreeArgumentBlock! ! !PPExpressionParser methodsFor: 'private' stamp: 'FirstnameLastname 11/26/2009 21:05'! operator: aSymbol parser: aParser do: aBlock parser isNil ifTrue: [ ^ self error: 'You did not specify a term when creating the receiver.' ]. operators isNil ifTrue: [ ^ self error: 'Use #group: to define precedence groups in descending order.' ]. (operators at: aSymbol ifAbsentPut: [ OrderedCollection new ]) addLast: (Array with: aParser with: aBlock)! ! !PPExpressionParser methodsFor: 'specifying' stamp: 'FirstnameLastname 11/26/2009 20:49'! postfix: aParser do: aTwoArgumentBlock "Define a postfix operator aParser. Evaluate aTwoArgumentBlock with the term and the operator." self operator: #build:postfix: parser: aParser do: aTwoArgumentBlock! ! !PPExpressionParser methodsFor: 'specifying' stamp: 'FirstnameLastname 11/26/2009 20:49'! prefix: aParser do: aTwoArgumentBlock "Define a prefix operator aParser. Evaluate aTwoArgumentBlock with the operator and the term." self operator: #build:prefix: parser: aParser do: aTwoArgumentBlock! ! !PPExpressionParser methodsFor: 'specifying' stamp: 'FirstnameLastname 11/26/2009 20:49'! right: aParser do: aThreeArgumentBlock "Define an operator aParser that is right-associative. Evaluate aThreeArgumentBlock with the first term, the operator, and the second term." self operator: #build:right: parser: aParser do: aThreeArgumentBlock! ! !PPExpressionParser methodsFor: 'specifying' stamp: 'FirstnameLastname 11/26/2009 21:26'! term: aParser "Defines the initial term aParser of the receiver." parser isNil ifTrue: [ parser := aParser ] ifFalse: [ self error: 'Unable to redefine the term.' ]! ! PPDelegateParser subclass: #PPFlattenParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPFlattenParser commentStamp: 'lr 11/22/2009 13:09' prior: 0! A parser that answers a flat copy of the range my delegate parses.! !PPFlattenParser methodsFor: 'hooks' stamp: 'lr 6/16/2008 10:10'! create: aCollection start: aStartInteger stop: aStopInteger ^ aCollection copyFrom: aStartInteger to: aStopInteger! ! !PPFlattenParser methodsFor: 'parsing' stamp: 'lr 12/7/2009 09:57'! parse: aStream | begin start element stop | begin := aStream position. self parseBefore: aStream. start := aStream position. element := super parse: aStream. element isFailure ifTrue: [ aStream position: begin. ^ element ]. stop := aStream position. self parseAfter: aStream. ^ self create: aStream collection start: start + 1 stop: stop! ! !PPFlattenParser methodsFor: 'parsing' stamp: 'lr 11/22/2009 13:05'! parseAfter: aStream "Consume input after the actual parse."! ! !PPFlattenParser methodsFor: 'parsing' stamp: 'lr 11/22/2009 13:05'! parseBefore: aStream "Consume input before the actual parse."! ! PPFlattenParser subclass: #PPTokenParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPTokenParser commentStamp: 'lr 11/22/2009 13:10' prior: 0! A parser that answers a token of the range my delegate parses. The receiver silently consumes spaces before and after the actual token.! !PPTokenParser methodsFor: 'hooks' stamp: 'lr 11/22/2009 13:03'! consumeSpaces: aStream [ aStream atEnd not and: [ aStream peek isSeparator ] ] whileTrue: [ aStream next ]! ! !PPTokenParser methodsFor: 'hooks' stamp: 'lr 12/7/2009 09:54'! create: aCollection start: aStartInteger stop: aStopInteger ^ self tokenClass on: aCollection start: aStartInteger stop: aStopInteger! ! !PPTokenParser methodsFor: 'parsing' stamp: 'lr 11/22/2009 13:05'! parseAfter: aStream self consumeSpaces: aStream! ! !PPTokenParser methodsFor: 'parsing' stamp: 'lr 11/22/2009 13:05'! parseBefore: aStream self consumeSpaces: aStream! ! !PPTokenParser methodsFor: 'accessing' stamp: 'lr 12/7/2009 09:54'! tokenClass ^ PPToken! ! PPDelegateParser subclass: #PPMemoizedParser instanceVariableNames: 'stream buffer' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPMemoizedParser commentStamp: 'lr 4/2/2009 19:22' prior: 0! A memoized parser, for refraining redundant computations.! !PPMemoizedParser methodsFor: 'operations' stamp: 'lr 4/2/2009 19:48'! memoized "Ther is no point in memoizing more than once." ^ self! ! !PPMemoizedParser methodsFor: 'parsing' stamp: 'lr 11/13/2009 11:03'! parse: aStream | memento | stream == aStream ifFalse: [ self reset: aStream ]. memento := (buffer at: stream position + 1) ifNil: [ buffer at: stream position + 1 put: PPMemento new ]. memento position isNil ifTrue: [ memento result: (stream size - stream position + 2 < memento count ifTrue: [ PPFailure reason: 'overflow' at: stream position ] ifFalse: [ memento increment. super parse: stream ]). memento position: stream position ] ifFalse: [ stream position: memento position ]. ^ memento result! ! !PPMemoizedParser methodsFor: 'private' stamp: 'lr 4/2/2009 19:22'! reset: aStream stream := aStream. buffer := Array new: aStream size + 1! ! PPDelegateParser subclass: #PPRepeatingParser instanceVariableNames: 'min max' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPRepeatingParser commentStamp: 'lr 11/18/2008 15:19' prior: 0! A parser that eagerly parses min to max instances of my delegate. The default instance parses eagerly an infinite number of elements, as min is set to 0 and max to infinity (SmallInteger maxVal).! !PPRepeatingParser class methodsFor: 'instance creation' stamp: 'lr 11/18/2008 14:53'! on: aParser ^ (super on: aParser) setMin: 0 max: SmallInteger maxVal! ! !PPRepeatingParser class methodsFor: 'instance creation' stamp: 'lr 3/30/2009 10:19'! on: aParser max: aMaxInteger ^ (self on: aParser) setMin: 0 max: aMaxInteger! ! !PPRepeatingParser class methodsFor: 'instance creation' stamp: 'lr 3/30/2009 10:19'! on: aParser min: aMinInteger ^ (self on: aParser) setMin: aMinInteger max: SmallInteger maxVal ! ! !PPRepeatingParser class methodsFor: 'instance creation' stamp: 'lr 3/30/2009 10:19'! on: aParser min: aMinInteger max: aMaxInteger ^ (self on: aParser) setMin: aMinInteger max: aMaxInteger! ! !PPRepeatingParser methodsFor: 'parsing' stamp: 'lr 1/8/2010 15:02'! parse: aStream | start element elements | start := aStream position. elements := OrderedCollection new. [ elements size < min ] whileTrue: [ (element := super parse: aStream) isFailure ifFalse: [ elements addLast: element ] ifTrue: [ aStream position: start. ^ element ] ]. [ elements size < max ] whileTrue: [ (element := super parse: aStream) isFailure ifTrue: [ ^ elements asArray ]. elements addLast: element ]. ^ elements asArray! ! !PPRepeatingParser methodsFor: 'printing' stamp: 'lr 4/3/2009 08:39'! printOn: aStream super printOn: aStream. aStream nextPutAll: ' ['; print: min; nextPutAll: ', '; nextPutAll: (max = SmallInteger maxVal ifTrue: [ '*' ] ifFalse: [ max asString ]); nextPut: $]! ! !PPRepeatingParser methodsFor: 'initialization' stamp: 'lr 11/18/2008 14:53'! setMin: aMinInteger max: aMaxInteger min := aMinInteger. max := aMaxInteger! ! PPParser subclass: #PPEpsilonParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPEpsilonParser commentStamp: 'lr 5/15/2008 15:09' prior: 0! A parser that consumes nothing and always succeeds.! !PPEpsilonParser methodsFor: 'parsing' stamp: 'lr 4/2/2009 18:37'! parse: aStream ^ nil! ! PPParser subclass: #PPFailingParser instanceVariableNames: 'message' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPFailingParser commentStamp: 'lr 5/15/2008 15:10' prior: 0! A parser that consumes nothing and always fails.! !PPFailingParser class methodsFor: 'instance creation' stamp: 'lr 4/19/2008 09:57'! message: aString ^ self new message: aString! ! !PPFailingParser methodsFor: 'accessing' stamp: 'lr 4/19/2008 09:56'! message: aString message := aString! ! !PPFailingParser methodsFor: 'parsing' stamp: 'lr 4/2/2009 18:37'! parse: aStream ^ PPFailure reason: message at: aStream position! ! PPParser subclass: #PPListParser instanceVariableNames: 'parsers' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPListParser commentStamp: 'lr 11/28/2009 18:52' prior: 0! Abstract parser that parses a list of things in some way (to be specified by the subclasses).! PPListParser subclass: #PPChoiceParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPChoiceParser commentStamp: 'lr 4/18/2008 15:35' prior: 0! A parser that uses the first parser that succeeds.! !PPChoiceParser methodsFor: 'operations' stamp: 'lr 9/17/2008 00:16'! / aRule ^ self copyWith: aRule! ! !PPChoiceParser methodsFor: 'parsing' stamp: 'lr 10/4/2009 18:10'! parse: aStream | failure element | failure := nil. 1 to: parsers size do: [ :index | element := (parsers at: index) parse: aStream. element isFailure ifFalse: [ ^ element ]. (failure isNil or: [ failure position < element position ]) ifTrue: [ failure := element ] ]. ^ failure! ! !PPListParser class methodsFor: 'instance creation' stamp: 'lr 9/23/2008 18:32'! with: aFirstParser with: aSecondParser ^ self withAll: (Array with: aFirstParser with: aSecondParser)! ! !PPListParser class methodsFor: 'instance creation' stamp: 'lr 9/23/2008 16:27'! withAll: aCollection ^ self basicNew initializeWithAll: aCollection asArray! ! !PPListParser methodsFor: 'accessing' stamp: 'lr 10/21/2009 16:37'! children ^ parsers! ! !PPListParser methodsFor: 'copying' stamp: 'lr 9/17/2008 22:36'! copyWith: aParser ^ self species withAll: (parsers copyWith: aParser)! ! !PPListParser methodsFor: 'initialization' stamp: 'lr 9/26/2008 11:07'! initialize super initialize. parsers := #()! ! !PPListParser methodsFor: 'initialization' stamp: 'lr 9/17/2008 22:29'! initializeWithAll: anArray parsers := anArray! ! PPListParser subclass: #PPSequenceParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPSequenceParser commentStamp: 'lr 4/18/2008 15:34' prior: 0! A parser that parses a sequence of parsers.! !PPSequenceParser methodsFor: 'operations' stamp: 'lr 9/17/2008 00:17'! , aRule ^ self copyWith: aRule! ! !PPSequenceParser methodsFor: 'operations' stamp: 'lr 9/23/2008 19:09'! map: aBlock ^ self ==> [ :nodes | aBlock valueWithArguments: nodes ]! ! !PPSequenceParser methodsFor: 'parsing' stamp: 'lr 4/3/2009 09:33'! parse: aStream | start elements element | start := aStream position. elements := Array new: parsers size. 1 to: parsers size do: [ :index | element := (parsers at: index) parse: aStream. element isFailure ifFalse: [ elements at: index put: element ] ifTrue: [ aStream position: start. ^ element ] ]. ^ elements! ! !PPSequenceParser methodsFor: 'operations' stamp: 'lr 1/8/2010 12:01'! permutation: anArrayOfIntegers "Answer a permutation of the receivers sequence." anArrayOfIntegers do: [ :index | (index isInteger and: [ index between: 1 and: parsers size ]) ifFalse: [ self error: 'Invalid permutation index: ' , index printString ] ]. ^ self ==> [ :nodes | anArrayOfIntegers collect: [ :index | nodes at: index ] ]! ! PPParser subclass: #PPLiteralParser instanceVariableNames: 'literal failureMessage' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPLiteralParser commentStamp: 'lr 11/28/2009 18:52' prior: 0! Abstract literal parser that parses some kind of literal type (to be specified by subclasses).! PPLiteralParser subclass: #PPLiteralObjectParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPLiteralObjectParser commentStamp: 'lr 11/7/2009 13:38' prior: 0! A parser that accepts a single literal object, such as a character. This is the same as the predicate parser PPPredicateParser expect: literal, but slightly faster.! !PPLiteralObjectParser methodsFor: 'operator' stamp: 'lr 1/7/2010 15:41'! negate ^ PPPredicateParser on: [ :each | each ~= literal ] message: 'no ' , failureMessage negated: [ :each | each = literal ] message: failureMessage! ! !PPLiteralObjectParser methodsFor: 'parsing' stamp: 'lr 1/7/2010 15:33'! parse: aStream ^ (aStream atEnd not and: [ aStream peek = literal ]) ifFalse: [ PPFailure reason: failureMessage at: aStream position ] ifTrue: [ aStream next ]! ! !PPLiteralParser class methodsFor: 'instance creation' stamp: 'lr 1/7/2010 15:30'! on: anObject ^ self on: anObject message: anObject printString , ' expected'! ! !PPLiteralParser class methodsFor: 'instance creation' stamp: 'lr 1/7/2010 15:29'! on: anObject message: aString ^ self new initializeOn: anObject message: aString! ! !PPLiteralParser methodsFor: 'initialization' stamp: 'lr 1/7/2010 15:30'! initializeOn: anObject message: aString literal := anObject. failureMessage := aString! ! PPLiteralParser subclass: #PPLiteralSequenceParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPLiteralSequenceParser commentStamp: 'lr 12/4/2009 18:39' prior: 0! A parser accepts a sequence of literal objects, such as a String. This is an optimization to avoid having to compose longer sequences from PPSequenceParser.! !PPLiteralSequenceParser methodsFor: 'parsing' stamp: 'lr 1/7/2010 15:33'! parse: aStream | position result | position := aStream position. result := aStream next: literal size. result = literal ifTrue: [ ^ result ]. aStream position: position. ^ PPFailure reason: failureMessage at: position! ! !PPParser class methodsFor: 'instance creation' stamp: 'lr 10/27/2008 11:17'! named: aString ^ self new name: aString! ! !PPParser class methodsFor: 'instance creation' stamp: 'lr 4/18/2008 14:00'! new ^ self basicNew initialize! ! !PPParser methodsFor: 'operations' stamp: 'lr 9/23/2008 18:32'! , aParser "Answer a new parser that parses the receiver followed by aParser." ^ PPSequenceParser with: self with: aParser! ! !PPParser methodsFor: 'operations' stamp: 'lr 9/23/2008 18:32'! / aParser "Answer a new parser that either parses the receiver or aParser." ^ PPChoiceParser with: self with: aParser! ! !PPParser methodsFor: 'operations' stamp: 'lr 3/30/2009 10:11'! ==> aBlock "Assigns aBlock as a success action handler." ^ PPActionParser on: self block: aBlock! ! !PPParser methodsFor: 'operations' stamp: 'lr 7/2/2008 12:12'! and "Answer a parser that succeeds whenever the receiver does, but consumes no input." ^ PPAndParser on: self! ! !PPParser methodsFor: 'operations-mapping' stamp: 'lr 1/8/2010 11:14'! answer: anObject "Answer anObject from any successful parse of the receiver." ^ self ==> [ :nodes | anObject ]! ! !PPParser methodsFor: 'converting' stamp: 'lr 4/19/2008 13:08'! asParser ^ self! ! !PPParser methodsFor: 'accessing' stamp: 'lr 10/21/2009 16:38'! children "Answer a set of child parsers that could follow the receiver." ^ #()! ! !PPParser methodsFor: 'private' stamp: 'lr 5/7/2009 11:25'! currentTokenParser | context | context := thisContext sender. [ context notNil ] whileTrue: [ (context receiver respondsTo: #tokenParser) ifTrue: [ ^ context receiver tokenParser ]. context := context sender ]. ^ PPTokenParser! ! !PPParser methodsFor: 'operations' stamp: 'lr 11/19/2009 23:41'! def: aParser "Defines the receiver as the argument aParser. This method is useful when defining recursive parsers: instantiate a PPParser and later redefine it with another one." ^ self becomeForward: (aParser name: self name)! ! !PPParser methodsFor: 'operations-conveniance' stamp: 'lr 6/30/2009 12:15'! delimitedBy: aParser "Answer a parser that parses the receiver one or more times, separated and possibly ended by aParser." ^ (self separatedBy: aParser) , (aParser optional) ==> [ :node | node second isNil ifTrue: [ node first ] ifFalse: [ node first copyWith: node second ] ]! ! !PPParser methodsFor: 'operations' stamp: 'lr 9/15/2008 09:32'! end "Ensure the end of the input and return the result of the receiver." ^ PPEndOfInputParser on: self! ! !PPParser methodsFor: 'operations' stamp: 'lr 5/15/2008 16:08'! flatten "Answer a new parser that flattens the underlying collection." ^ PPFlattenParser on: self! ! !PPParser methodsFor: 'operations-mapping' stamp: 'lr 7/3/2008 15:48'! foldLeft: aBlock "Fold the result of the receiver from left-to-right into aBlock. The argument aBlock must take two or more arguments." | size args | size := aBlock numArgs. args := Array new: size. ^ self ==> [ :nodes | args at: 1 put: (nodes at: 1). 2 to: nodes size by: size - 1 do: [ :index | args replaceFrom: 2 to: size with: nodes startingAt: index; at: 1 put: (aBlock valueWithArguments: args) ]. args at: 1 ]! ! !PPParser methodsFor: 'operations-mapping' stamp: 'lr 7/3/2008 15:48'! foldRight: aBlock "Fold the result of the receiver from right-to-left into aBlock. The argument aBlock must take two or more arguments." | size args | size := aBlock numArgs. args := Array new: size. ^ self ==> [ :nodes | args at: size put: (nodes at: nodes size). nodes size - size + 1 to: 1 by: 1 - size do: [ :index | args replaceFrom: 1 to: size - 1 with: nodes startingAt: index; at: size put: (aBlock valueWithArguments: args) ]. args at: size ]! ! !PPParser methodsFor: 'initialization' stamp: 'lr 4/24/2008 10:33'! initialize! ! !PPParser methodsFor: 'testing' stamp: 'lr 10/27/2008 11:28'! isUnresolved ^ false! ! !PPParser methodsFor: 'operations-mapping' stamp: 'lr 9/23/2008 19:08'! map: aBlock "Map the result of the receiver to the arguments of aBlock." ^ self ==> aBlock! ! !PPParser methodsFor: 'operations' stamp: 'lr 11/18/2008 14:42'! max: anInteger "Answer a new parser that parses the receiver at most anInteger times." ^ PPRepeatingParser on: self max: anInteger! ! !PPParser methodsFor: 'operations' stamp: 'lr 4/2/2009 19:21'! memoized "Answer a memoized parser, for refraining redundant computations. This ensures polynomial time O(n^4) for left-recursive grammars and O(n^3) for non left-recursive grammars in the worst case." ^ PPMemoizedParser on: self! ! !PPParser methodsFor: 'operations' stamp: 'lr 11/18/2008 14:42'! min: anInteger "Answer a new parser that parses the receiver at least anInteger times." ^ PPRepeatingParser on: self min: anInteger! ! !PPParser methodsFor: 'operations' stamp: 'lr 11/18/2008 14:43'! min: aMinInteger max: aMaxInteger "Answer a new parser that parses the receiver at least aMinInteger and at most aMaxInteger times." ^ PPRepeatingParser on: self min: aMinInteger max: aMaxInteger! ! !PPParser methodsFor: 'accessing' stamp: 'lr 10/20/2008 12:06'! name ^ name! ! !PPParser methodsFor: 'accessing' stamp: 'lr 10/20/2008 12:06'! name: aString name := aString! ! !PPParser methodsFor: 'operations' stamp: 'lr 7/2/2008 11:52'! not "Answer a parser that succeeds whenever the receiver fails." ^ PPNotParser on: self! ! !PPParser methodsFor: 'operations' stamp: 'lr 11/20/2009 15:30'! optional "Answer a new parser that parses the receiver, if possible." ^ self / nil asParser! ! !PPParser methodsFor: 'parsing' stamp: 'lr 4/2/2009 18:36'! parse: aStream self subclassResponsibility! ! !PPParser methodsFor: 'operations' stamp: 'lr 11/18/2008 14:55'! plus "Answer a new parser that parses the receiver one or more times." ^ self min: 1! ! !PPParser methodsFor: 'printing' stamp: 'lr 10/23/2009 12:26'! printOn: aStream super printOn: aStream. self name isNil ifTrue: [ aStream nextPut: $(; print: self hash; nextPut: $) ] ifFalse: [ aStream nextPut: $(; nextPutAll: self name; nextPut: $) ]! ! !PPParser methodsFor: 'operations-conveniance' stamp: 'lr 6/30/2009 12:14'! separatedBy: aParser "Answer a parser that parses the receiver one or more times, separated by aParser." ^ (PPSequenceParser with: self with: (PPSequenceParser with: aParser with: self) star) ==> [ :node | Array streamContents: [ :stream | stream nextPut: node first. node second do: [ :each | stream nextPutAll: each ] ] ]! ! !PPParser methodsFor: 'operations' stamp: 'lr 11/18/2008 14:35'! star "Answer a new parser that parses the receiver zero or more times." ^ PPRepeatingParser on: self! ! !PPParser methodsFor: 'operations' stamp: 'lr 12/4/2009 18:39'! token "Answer a new parser that transforms the input to a token and consumes white spaces." ^ self currentTokenParser on: self! ! !PPParser methodsFor: 'operations' stamp: 'lr 10/23/2008 14:05'! wrapped "Answer a new parser that is simply wrapped." ^ PPDelegateParser on: self! ! PPParser subclass: #PPPluggableParser instanceVariableNames: 'block' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPPluggableParser class methodsFor: 'instance creation' stamp: 'lr 6/18/2008 08:46'! on: aBlock ^ self new block: aBlock! ! !PPPluggableParser methodsFor: 'accessing' stamp: 'lr 4/2/2009 20:06'! block: aBlock block := aBlock! ! !PPPluggableParser methodsFor: 'parsing' stamp: 'lr 4/2/2009 18:37'! parse: aStream | position result | position := aStream position. result := block value: aStream. result isFailure ifTrue: [ aStream position: position ]. ^ result! ! PPParser subclass: #PPPredicateParser instanceVariableNames: 'predicate predicateMessage negated negatedMessage' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPPredicateParser commentStamp: 'lr 4/18/2008 15:34' prior: 0! A parser that accepts if a given predicate holds.! !PPPredicateParser class methodsFor: 'factory-objects' stamp: 'lr 4/19/2008 11:21'! any ^ self on: [ :each | true ] message: 'something expected' negated: [ :each | false ] message: 'nothing expected'! ! !PPPredicateParser class methodsFor: 'factory-objects' stamp: 'lr 11/29/2009 08:32'! anyOf: anArray ^ self on: [ :each | anArray includes: each ] message: 'any of ' , anArray printString , ' expected' negated: [ :each | (anArray includes: each) not ] message: 'none of ' , anArray printString , 'expected'! ! !PPPredicateParser class methodsFor: 'factory-objects' stamp: 'lr 11/29/2009 09:28'! 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'! ! !PPPredicateParser class methodsFor: 'factory-chars' stamp: 'lr 4/20/2008 15:54'! char: aCharacter ^ self expect: aCharacter! ! !PPPredicateParser class methodsFor: 'factory-chars' stamp: 'lr 11/29/2009 09:38'! control ^ self on: [ :char | char asInteger < 32 ] message: 'control character expected' negated: [ :char | char asInteger >= 32 ] message: 'no control character expected'! ! !PPPredicateParser class methodsFor: 'factory-chars' stamp: 'lr 5/5/2009 14:53'! cr ^ self char: Character cr! ! !PPPredicateParser class methodsFor: 'factory-chars' stamp: 'lr 11/29/2009 09:38'! digit ^ self on: [ :char | char isDigit ] message: 'digit expected' negated: [ :char | char isDigit not ] message: 'no digit expected'! ! !PPPredicateParser class methodsFor: 'factory-objects' stamp: 'lr 4/19/2008 11:21'! expect: anObject ^ self on: [ :each | each = anObject ] message: anObject printString , ' expected' negated: [ :each | each ~= anObject ] message: anObject printString , ' not expected'! ! !PPPredicateParser class methodsFor: 'factory-chars' stamp: 'lr 11/29/2009 09:38'! hex ^ self on: [ :char | (char between: $0 and: $9) or: [ (char between: $a and: $f) or: [ (char between: $A and: $F) ] ] ] message: 'hex digit expected'! ! !PPPredicateParser class methodsFor: 'factory-chars' stamp: 'lr 11/29/2009 09:38'! letter ^ self on: [ :char | char isLetter ] message: 'letter expected' negated: [ :char | char isLetter not ] message: 'no letter expected'! ! !PPPredicateParser class methodsFor: 'factory-chars' stamp: 'lr 5/5/2009 14:53'! lf ^ self char: Character lf! ! !PPPredicateParser class methodsFor: 'factory-chars' stamp: 'lr 11/29/2009 09:38'! lowercase ^ self on: [ :char | char isLowercase ] message: 'lowercase letter expected' negated: [ :char | char isLowercase not ] message: 'no lowercase letter expected'! ! !PPPredicateParser class methodsFor: 'factory-chars' stamp: 'lr 11/29/2009 08:34'! newline ^ self anyOf: (Array with: Character cr with: Character lf)! ! !PPPredicateParser class methodsFor: 'instance creation' stamp: 'lr 4/19/2008 11:21'! on: aBlock message: aString ^ self on: aBlock message: aString negated: [ :each | (aBlock value: each) not ] message: 'no ' , aString! ! !PPPredicateParser class methodsFor: 'instance creation' stamp: 'lr 4/19/2008 11:21'! on: aBlock message: aString negated: aNegatedBlock message: aNegatedString ^ self new initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString! ! !PPPredicateParser class methodsFor: 'factory-chars' stamp: 'lr 11/29/2009 09:38'! space ^ self on: [ :char | char isSeparator ] message: 'separator expected' negated: [ :char | char isSeparator not ] message: 'no separator expected'! ! !PPPredicateParser class methodsFor: 'factory-chars' stamp: 'lr 5/7/2009 11:15'! tab ^ self char: Character tab! ! !PPPredicateParser class methodsFor: 'factory-chars' stamp: 'lr 11/29/2009 09:37'! uppercase ^ self on: [ :char | char isUppercase ] message: 'uppercase letter expected' negated: [ :char | char isUppercase not ] message: 'no uppercase letter expected' ! ! !PPPredicateParser class methodsFor: 'factory-chars' stamp: 'lr 4/19/2008 11:37'! word ^ self on: [ :each | each isAlphaNumeric ] message: 'letter or digit expected' negated: [ :each | each isAlphaNumeric not ] message: 'no letter or digit expected'! ! !PPPredicateParser methodsFor: 'initialization' stamp: 'lr 11/19/2009 11:45'! initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString predicate := aBlock. predicateMessage := aString. negated := aNegatedBlock. negatedMessage := aNegatedString! ! !PPPredicateParser methodsFor: 'operators' stamp: 'lr 4/21/2009 08:53'! negate "Negate the receiving predicate parser." ^ self class on: negated message: negatedMessage negated: predicate message: predicateMessage! ! !PPPredicateParser methodsFor: 'parsing' stamp: 'lr 4/2/2009 18:37'! parse: aStream ^ (aStream atEnd not and: [ predicate value: aStream peek ]) ifFalse: [ PPFailure reason: predicateMessage at: aStream position ] ifTrue: [ aStream next ]! ! PPParser subclass: #PPUnresolvedParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Tools'! !PPUnresolvedParser commentStamp: 'lr 11/28/2009 18:50' prior: 0! This is a temporary placeholder or forward reference to a parser that has not been defined yet. If everything goes well it will eventually be replaced with the real parser instance.! !PPUnresolvedParser methodsFor: 'testing' stamp: 'lr 10/27/2008 11:29'! isUnresolved ^ true! ! !PPUnresolvedParser methodsFor: 'parsing' stamp: 'lr 4/2/2009 18:37'! parse: aStream self error: self printString , ' need to be resolved before execution.'! ! Object subclass: #PPToken instanceVariableNames: 'collection start stop' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPToken class methodsFor: 'instance creation' stamp: 'lr 4/6/2009 15:42'! on: aSequenzeableCollection ^ self on: aSequenzeableCollection start: 1 stop: aSequenzeableCollection size! ! !PPToken class methodsFor: 'instance creation' stamp: 'lr 6/16/2008 10:09'! on: aSequenzeableCollection start: aStartInteger stop: aStopInteger ^ self basicNew initializeOn: aSequenzeableCollection start: aStartInteger stop: aStopInteger! ! !PPToken methodsFor: 'comparing' stamp: 'lr 10/7/2009 09:06'! = anObject ^ self class = anObject class and: [ self value = anObject value ]! ! !PPToken methodsFor: 'accessing' stamp: 'lr 5/19/2008 10:54'! collection ^ collection! ! !PPToken methodsFor: 'copying' stamp: 'lr 6/16/2008 10:55'! copyFrom: aStartInteger to: aStopInteger ^ self class on: collection start: start + aStartInteger - 1 stop: stop + aStopInteger - 3! ! !PPToken methodsFor: 'comparing' stamp: 'lr 10/7/2009 09:06'! hash ^ self value hash! ! !PPToken methodsFor: 'initialization' stamp: 'lr 6/16/2008 10:09'! initializeOn: aSequenzeableCollection start: aStartInteger stop: aStopInteger collection := aSequenzeableCollection. start := aStartInteger. stop := aStopInteger! ! !PPToken methodsFor: 'printing' stamp: 'lr 6/16/2008 10:13'! printOn: aStream super printOn: aStream. aStream nextPut: $(; nextPutAll: self value; nextPut: $)! ! !PPToken methodsFor: 'accessing' stamp: 'lr 6/16/2008 10:07'! size ^ self stop - self start + 1! ! !PPToken methodsFor: 'accessing' stamp: 'lr 6/16/2008 10:05'! start ^ start! ! !PPToken methodsFor: 'accessing' stamp: 'lr 6/16/2008 10:05'! stop ^ stop! ! !PPToken methodsFor: 'accessing' stamp: 'lr 6/16/2008 10:12'! value ^ collection copyFrom: start to: stop! ! !Symbol methodsFor: '*petitparser-core-converting' stamp: 'lr 4/20/2008 14:01'! asParser ^ PPPredicateParser perform: self! ! TestCase subclass: #PPAbstractParseTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Tests'! !PPAbstractParseTest class methodsFor: 'testing' stamp: 'lr 10/4/2009 17:08'! isAbstract ^ self name = #PPAbstractParseTest! ! !PPAbstractParseTest class methodsFor: 'accessing' stamp: 'lr 4/13/2009 09:45'! packageNamesUnderTest ^ #('PetitParser')! ! !PPAbstractParseTest methodsFor: 'utilities' stamp: 'on 9/14/2008 16:20'! assert: aParser fail: aCollection | stream result | stream := aCollection asParserStream. result := aParser parse: stream. self assert: result isFailure. self assert: stream position = 0! ! !PPAbstractParseTest methodsFor: 'utilities' stamp: 'on 9/14/2008 16:20'! assert: aParser parse: aCollection self assert: aParser parse: aCollection to: nil end: aCollection size ! ! !PPAbstractParseTest methodsFor: 'utilities' stamp: 'on 9/14/2008 16:21'! assert: aParser parse: aCollection end: anInteger self assert: aParser parse: aCollection to: nil end: anInteger! ! !PPAbstractParseTest methodsFor: 'utilities' stamp: 'on 9/14/2008 16:21'! assert: aParser parse: aCollection to: anObject self assert: aParser parse: aCollection to: anObject end: aCollection size ! ! !PPAbstractParseTest methodsFor: 'utilities' stamp: 'PaoloBonzini 10/5/2009 10:26'! assert: aParser parse: aParseObject to: aTargetObject end: anInteger | stream result | stream := aParseObject asParserStream. result := aParser parse: stream. aTargetObject isNil ifTrue: [ self deny: result isFailure ] ifFalse: [ self assert: result = aTargetObject ]. self assert: stream position = anInteger! ! !PPAbstractParseTest methodsFor: 'utilities' stamp: 'lr 10/6/2009 08:21'! assert: aParser parse: aParserObject toToken: from stop: to | token | token := PPToken on: aParserObject start: from stop: to. ^ self assert: aParser parse: aParserObject to: token! ! !PPAbstractParseTest methodsFor: 'utilities' stamp: 'lr 10/6/2009 08:22'! assert: aParser parse: aParserObject toToken: from stop: to end: end | token | token := PPToken on: aParserObject start: from stop: to. ^ self assert: aParser parse: aParserObject to: token end: end! ! PPAbstractParseTest subclass: #PPComposedTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Tests'! !PPComposedTest methodsFor: 'testing' stamp: 'lr 7/6/2009 08:34'! testDoubledString | parser | parser := ($' asParser , (($' asParser , $' asParser) / $' asParser negate) star flatten , $' asParser) ==> [ :nodes | nodes second copyReplaceAll: '''''' with: '''' ]. self assert: parser parse: '''''' to: ''. self assert: parser parse: '''a''' to: 'a'. self assert: parser parse: '''ab''' to: 'ab'. self assert: parser parse: '''a''''b''' to: 'a''b'. self assert: parser parse: '''a''''''''b''' to: 'a''''b'! ! !PPComposedTest methodsFor: 'testing' stamp: 'lr 10/20/2008 13:27'! testIfThenElse "S ::= if C then S else S | if C then S | X" | start if then else cond expr parser | start := PPUnresolvedParser new. if := 'if' asParser token. then := 'then' asParser token. else := 'else' asParser token. cond := 'C' asParser token. expr := 'X' asParser token. start def: (if , cond , then , start , else , start) / (if , cond , then , start) / (expr). parser := start end. self assert: parser parse: 'X'. self assert: parser parse: 'if C then X'. self assert: parser parse: 'if C then X else X'. self assert: parser parse: 'if C then if C then X'. self assert: parser parse: 'if C then if C then X else if C then X'. self assert: parser parse: 'if C then if C then X else X else if C then X'. self assert: parser parse: 'if C then if C then X else X else if C then X else X'. self assert: parser fail: 'if C'. self assert: parser fail: 'if C else X'. self assert: parser fail: 'if C then if C'! ! !PPComposedTest methodsFor: 'testing' stamp: 'lr 4/2/2009 20:46'! testLeftRecursion "S ::= S 'x' S / '1'" | parser | parser := PPUnresolvedParser new. parser def: ((parser , $x asParser , parser) / $1 asParser) memoized flatten. self assert: parser parse: '1' to: '1'. self assert: parser parse: '1x1' to: '1x1'. self assert: parser parse: '1x1x1' to: '1x1x1'. self assert: parser parse: '1x1x1x1' to: '1x1x1x1'. self assert: parser parse: '1x1x1x1x1' to: '1x1x1x1x1'. self assert: parser parse: '1x1x1x1x1x1' to: '1x1x1x1x1x1'! ! !PPComposedTest methodsFor: 'testing' stamp: 'TestRunner 11/22/2009 13:07'! testListOfIntegers "S ::= S , number | number" | number list parser | number := #digit asParser plus token ==> [ :node | node value asInteger ]. list := (number separatedBy: $, asParser token) ==> [ :node | node select: [ :each | each isInteger ] ]. parser := list end. self assert: parser parse: '1' to: (1 to: 1) asArray. self assert: parser parse: '1,2' to: (1 to: 2) asArray. self assert: parser parse: '1,2,3' to: (1 to: 3) asArray. self assert: parser parse: '1,2,3,4' to: (1 to: 4) asArray. self assert: parser parse: '1,2,3,4,5' to: (1 to: 5) asArray. self assert: parser parse: '1' to: (1 to: 1) asArray. self assert: parser parse: '1, 2' to: (1 to: 2) asArray. self assert: parser parse: '1, 2, 3' to: (1 to: 3) asArray. self assert: parser parse: '1, 2, 3, 4' to: (1 to: 4) asArray. self assert: parser parse: '1, 2, 3, 4, 5' to: (1 to: 5) asArray. self assert: parser parse: '1' to: (1 to: 1) asArray. self assert: parser parse: '1 ,2' to: (1 to: 2) asArray. self assert: parser parse: '1 ,2 ,3' to: (1 to: 3) asArray. self assert: parser parse: '1 ,2 ,3 ,4' to: (1 to: 4) asArray. self assert: parser parse: '1 ,2 ,3 ,4 ,5' to: (1 to: 5) asArray. self assert: parser fail: ''. self assert: parser fail: ','. self assert: parser fail: '1,'. self assert: parser fail: '1,,2'! ! !PPComposedTest methodsFor: 'testing' stamp: 'lr 10/20/2008 13:27'! testNestedComments "C ::= B I* E" "I ::= !!E (C | T)" "B ::= /*" "E ::= */" "T ::= ." | begin end any inside parser | begin := '/*' asParser. end := '*/' asParser. any := #any asParser. parser := PPUnresolvedParser new. inside := end not , (parser / any). parser def: begin , inside star , end. self assert: parser parse: '/*ab*/cd' end: 6. self assert: parser parse: '/*a/*b*/c*/'. self assert: parser fail: '/*a/*b*/c'! ! !PPComposedTest methodsFor: 'testing' stamp: 'lr 11/20/2009 15:29'! testPalindrome "S0 ::= a S1 a | b S1 b | ... S1 ::= S0 | epsilon" | s0 s1 parser | s0 := PPUnresolvedParser new. s1 := PPUnresolvedParser new. s0 def: ($a asParser , s1 , $a asParser) / ($b asParser , s1 , $b asParser) / ($c asParser , s1 , $c asParser). s1 def: s0 / nil asParser. parser := s0 flatten end. self assert: parser parse: 'aa' to: 'aa'. self assert: parser parse: 'bb' to: 'bb'. self assert: parser parse: 'cc' to: 'cc'. self assert: parser parse: 'abba' to: 'abba'. self assert: parser parse: 'baab' to: 'baab'. self assert: parser parse: 'abccba' to: 'abccba'. self assert: parser parse: 'abaaba' to: 'abaaba'. self assert: parser parse: 'cbaabc' to: 'cbaabc'. self assert: parser fail: 'a'. self assert: parser fail: 'ab'. self assert: parser fail: 'aab'. self assert: parser fail: 'abccbb'! ! !PPComposedTest methodsFor: 'testing' stamp: 'lr 11/20/2009 15:29'! testParseAaaBbb "S0 ::= a S1 b S1 ::= S0 | epsilon" | s0 s1 parser | s0 := PPUnresolvedParser new. s1 := PPUnresolvedParser new. s0 def: $a asParser , s1 , $b asParser. s1 def: s0 / nil asParser. parser := s0 flatten. self assert: parser parse: 'ab' to: 'ab'. self assert: parser parse: 'aabb' to: 'aabb'. self assert: parser parse: 'aaabbb' to: 'aaabbb'. self assert: parser parse: 'aaaabbbb' to: 'aaaabbbb'. self assert: parser parse: 'abb' to: 'ab' end: 2. self assert: parser parse: 'aabbb' to: 'aabb' end: 4. self assert: parser parse: 'aaabbbb' to: 'aaabbb' end: 6. self assert: parser parse: 'aaaabbbbb' to: 'aaaabbbb' end: 8. self assert: parser fail: 'a'. self assert: parser fail: 'b'. self assert: parser fail: 'aab'. self assert: parser fail: 'aaabb'! ! !PPComposedTest methodsFor: 'testing' stamp: 'lr 11/20/2009 15:29'! testParseAaaaaa "S ::= a a S | epsilon" | s0 s1 parser | s0 := PPUnresolvedParser new. s1 := $a asParser , $a asParser , s0. s0 def: s1 / nil asParser. parser := s0 flatten. self assert: parser parse: '' to: ''. self assert: parser parse: 'aa' to: 'aa'. self assert: parser parse: 'aaaa' to: 'aaaa'. self assert: parser parse: 'aaaaaa' to: 'aaaaaa'. self assert: parser parse: 'a' to: '' end: 0. self assert: parser parse: 'aaa' to: 'aa' end: 2. self assert: parser parse: 'aaaaa' to: 'aaaa' end: 4. self assert: parser parse: 'aaaaaaa' to: 'aaaaaa' end: 6! ! !PPComposedTest methodsFor: 'testing' stamp: 'lr 9/18/2008 09:26'! testParseAbAbAb "S ::= (A B)+" | parser | parser := ($a asParser , $b asParser) plus flatten. self assert: parser parse: 'ab' to: 'ab'. self assert: parser parse: 'abab' to: 'abab'. self assert: parser parse: 'ababab' to: 'ababab'. self assert: parser parse: 'abababab' to: 'abababab'. self assert: parser parse: 'abb' to: 'ab' end: 2. self assert: parser parse: 'ababa' to: 'abab' end: 4. self assert: parser parse: 'abababb' to: 'ababab' end: 6. self assert: parser parse: 'ababababa' to: 'abababab' end: 8. self assert: parser fail: ''. self assert: parser fail: 'a'. self assert: parser fail: 'bab'! ! !PPComposedTest methodsFor: 'testing' stamp: 'lr 9/18/2008 09:26'! testParseAbabbb "S ::= (A | B)+" | parser | parser := ($a asParser / $b asParser) plus flatten. self assert: parser parse: 'a' to: 'a'. self assert: parser parse: 'b' to: 'b'. self assert: parser parse: 'ab' to: 'ab'. self assert: parser parse: 'ba' to: 'ba'. self assert: parser parse: 'aaa' to: 'aaa'. self assert: parser parse: 'aab' to: 'aab'. self assert: parser parse: 'aba' to: 'aba'. self assert: parser parse: 'baa' to: 'baa'. self assert: parser parse: 'abb' to: 'abb'. self assert: parser parse: 'bab' to: 'bab'. self assert: parser parse: 'bba' to: 'bba'. self assert: parser parse: 'bbb' to: 'bbb'. self assert: parser parse: 'ac' to: 'a' end: 1. self assert: parser parse: 'bc' to: 'b' end: 1. self assert: parser parse: 'abc' to: 'ab' end: 2. self assert: parser parse: 'bac' to: 'ba' end: 2. self assert: parser fail: ''. self assert: parser fail: 'c'! ! PPAbstractParseTest subclass: #PPDemoTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Tests'! !PPDemoTest commentStamp: 'on 9/14/2008 16:16' prior: 0! These are some simple demos of parser combinators for the compiler construction course. http://www.iam.unibe.ch/~scg/Teaching/CC/index.html! !PPDemoTest methodsFor: 'examples' stamp: 'lr 10/20/2008 13:27'! addMulInterpreter "Same as testMiniGrammar but with semantic actions" | mul prim add dec | add := PPUnresolvedParser new. mul := PPUnresolvedParser new. prim := PPUnresolvedParser new. dec := ($0 - $9) ==> [ :token | token asciiValue - $0 asciiValue ]. add def: ((mul , $+ asParser , add) ==> [ :nodes | (nodes at: 1) + (nodes at: 3) ]) / mul. mul def: ((prim , $* asParser , mul) ==> [ :nodes | (nodes at: 1) * (nodes at: 3) ]) / prim. prim def: (($( asParser , add , $) asParser) ==> [ :nodes | nodes at: 2 ]) / dec. ^ add end! ! !PPDemoTest methodsFor: 'examples' stamp: 'lr 10/20/2008 13:27'! addMulParser "Simple demo of scripting a parser" | add mul prim dec | add := PPUnresolvedParser new. mul := PPUnresolvedParser new. prim := PPUnresolvedParser new. dec := $0 - $9. add def: ( mul, $+ asParser, add ) / mul. mul def: ( prim, $* asParser, mul) / prim. prim def: ( $( asParser, add, $) asParser) / dec. ^ add end! ! !PPDemoTest methodsFor: 'examples' stamp: 'lr 10/20/2008 13:27'! straightLineParser | goal stm stmList id char dec exp expList mulExp primExp nonzero num lower upper | goal := PPUnresolvedParser new. stmList := PPUnresolvedParser new. stm := PPUnresolvedParser new. exp := PPUnresolvedParser new. expList := PPUnresolvedParser new. mulExp := PPUnresolvedParser new. primExp := PPUnresolvedParser new. lower := $a - $z. upper := $A - $Z. char := lower / upper. nonzero := $1 - $9. dec := $0 - $9. id := char, ( char / dec ) star. num := $0 asParser / ( nonzero, dec star). goal def: stmList end. stmList def: stm , ( $; asParser, stm ) star. stm def: ( id, ':=' asParser, exp ) / ( 'print' asParser, $( asParser, expList, $) asParser ). exp def: mulExp, ( ( $+ asParser / $- asParser ), mulExp ) star. expList def: exp, ( $, asParser, exp ) star. mulExp def: primExp, ( ( $* asParser / $/ asParser ), primExp ) star. primExp def: id / num / ( $( asParser, stmList, $, asParser, exp, $) asParser ). ^ goal ! ! !PPDemoTest methodsFor: 'tests' stamp: 'on 9/14/2008 16:28'! testMiniGrammar self assert: (self addMulParser) parse: '2*(3+4)' to: #($2 $* #($( #($3 $+ $4) $))).! ! !PPDemoTest methodsFor: 'tests' stamp: 'on 9/14/2008 16:29'! testMiniSemanticActions self assert: (self addMulInterpreter) parse: '2*(3+4)' to: 14! ! !PPDemoTest methodsFor: 'tests' stamp: 'lr 9/17/2008 22:44'! testSLassign self assert: self straightLineParser parse: 'abc:=1' to: #(#($a #($b $c) ':=' #(#(#($1 #()) #()) #())) #())! ! !PPDemoTest methodsFor: 'tests' stamp: 'lr 9/17/2008 22:46'! testSLprint self assert: self straightLineParser parse: 'print(3,4)' to: #(#('print' $( #(#(#($3 #()) #()) #() #(#($, #(#(#($4 #()) #()) #())))) $)) #())! ! PPAbstractParseTest subclass: #PPExamplesTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Tests'! !PPExamplesTest methodsFor: 'parsers' stamp: 'lr 9/18/2008 09:28'! comment ^ ($" asParser , $" asParser negate star , $" asParser) flatten! ! !PPExamplesTest methodsFor: 'parsers' stamp: 'lr 9/18/2008 09:28'! identifier ^ (#letter asParser , #word asParser star) flatten! ! !PPExamplesTest methodsFor: 'parsers' stamp: 'lr 9/18/2008 09:28'! number ^ ($- asParser optional , #digit asParser plus , ($. asParser , #digit asParser plus) optional) flatten! ! !PPExamplesTest methodsFor: 'testing' stamp: 'lr 9/18/2008 09:28'! testComment self assert: self comment parse: '""' to: '""'. self assert: self comment parse: '"a"' to: '"a"'. self assert: self comment parse: '"ab"' to: '"ab"'. self assert: self comment parse: '"abc"' to: '"abc"'. self assert: self comment parse: '""a' to: '""' end: 2. self assert: self comment parse: '"a"a' to: '"a"' end: 3. self assert: self comment parse: '"ab"a' to: '"ab"' end: 4. self assert: self comment parse: '"abc"a' to: '"abc"' end: 5. self assert: self comment fail: '"'. self assert: self comment fail: '"a'. self assert: self comment fail: '"aa'. self assert: self comment fail: 'a"'. self assert: self comment fail: 'aa"'! ! !PPExamplesTest methodsFor: 'testing' stamp: 'lr 5/20/2009 13:51'! testIdentifier self assert: self identifier parse: 'a' to: 'a'. self assert: self identifier parse: 'a1' to: 'a1'. self assert: self identifier parse: 'a12' to: 'a12'. self assert: self identifier parse: 'ab' to: 'ab'. self assert: self identifier parse: 'a1b' to: 'a1b'. self assert: self identifier parse: 'a_' to: 'a' end: 1. self assert: self identifier parse: 'a1-' to: 'a1' end: 2. self assert: self identifier parse: 'a12+' to: 'a12' end: 3. self assert: self identifier parse: 'ab^' to: 'ab' end: 2. self assert: self identifier parse: 'a1b*' to: 'a1b' end: 3. self assert: self identifier fail: ''. self assert: self identifier fail: '1'. self assert: self identifier fail: '1a'! ! !PPExamplesTest methodsFor: 'testing' stamp: 'lr 9/18/2008 09:28'! testNumber self assert: self number parse: '1' to: '1'. self assert: self number parse: '12' to: '12'. self assert: self number parse: '12.3' to: '12.3'. self assert: self number parse: '12.34' to: '12.34'. self assert: self number parse: '1..' to: '1' end: 1. self assert: self number parse: '12-' to: '12' end: 2. self assert: self number parse: '12.3.' to: '12.3' end: 4. self assert: self number parse: '12.34.' to: '12.34' end: 5. self assert: self number parse: '-1' to: '-1'. self assert: self number parse: '-12' to: '-12'. self assert: self number parse: '-12.3' to: '-12.3'. self assert: self number parse: '-12.34' to: '-12.34'. self assert: self number fail: ''. self assert: self number fail: '-'. self assert: self number fail: '.'. self assert: self number fail: '.1'! ! !PPExamplesTest methodsFor: 'testing' stamp: 'TestRunner 11/22/2009 13:08'! testReturn | number spaces return | number := #digit asParser plus token. spaces := #space asParser star. return := (spaces , $^ asParser token , spaces , number) ==> [ :nodes | { #return. (nodes at: 4) value } ]. self assert: return parse: '^1' to: #(return '1'). self assert: return parse: ' ^12' to: #(return '12'). self assert: return parse: '^123 ' to: #(return '123'). self assert: return parse: '^ 1234' to: #(return '1234'). self assert: return fail: '1'. self assert: return fail: '^'! ! PPAbstractParseTest subclass: #PPExtensionTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Tests'! !PPExtensionTest methodsFor: 'testing' stamp: 'lr 9/18/2008 09:34'! testCharacter | parser | parser := $a asParser. self assert: parser parse: 'a' to: $a. self assert: parser fail: 'b'! ! !PPExtensionTest methodsFor: 'testing' stamp: 'lr 9/17/2008 22:02'! testClosure | parser | parser := [ :stream | stream upTo: $s ] asParser. self assert: parser parse: '' to: ''. self assert: parser parse: 'a' to: 'a'. self assert: parser parse: 'aa' to: 'aa'. self assert: parser parse: 's' to: ''. self assert: parser parse: 'as' to: 'a'. self assert: parser parse: 'aas' to: 'aa'. self assert: parser parse: 'sa' to: '' end: 1. self assert: parser parse: 'saa' to: '' end: 1. parser := [ :stream | stream upTo: $s. PPFailure new ] asParser. self assert: parser fail: ''. self assert: parser fail: 's'. self assert: parser fail: 'as' ! ! !PPExtensionTest methodsFor: 'testing' stamp: 'lr 11/20/2009 15:29'! testEpsilon | parser | parser := nil asParser. self assert: parser asParser = parser! ! !PPExtensionTest methodsFor: 'testing' stamp: 'lr 9/15/2008 09:20'! testOrdered | parser | parser := #(1 2) asParser. self assert: parser parse: #(1 2) to: #(1 2). self assert: parser parse: #(1 2 3) to: #(1 2) end: 2. self assert: parser fail: #(). self assert: parser fail: #(1). self assert: parser fail: #(1 1). self assert: parser fail: #(1 1 2)! ! !PPExtensionTest methodsFor: 'testing' stamp: 'lr 11/20/2009 15:30'! testParser | parser | parser := $a asParser. self assert: parser asParser = parser! ! !PPExtensionTest methodsFor: 'testing' stamp: 'lr 9/17/2008 22:48'! testRange | parser | parser := $a - $c. self assert: parser parse: 'a' to: $a. self assert: parser parse: 'b' to: $b. self assert: parser parse: 'c' to: $c. self assert: parser fail: 'd'! ! !PPExtensionTest methodsFor: 'testing' stamp: 'lr 11/29/2009 10:10'! testStream | stream | stream := 'abc' readStream asParserStream. self assert: (stream class = PPStream). self assert: (stream printString = '·abc'). self assert: (stream peek) = $a. self assert: (stream next) = $a. self assert: (stream printString = 'a·bc'). self assert: (stream asParserStream = stream)! ! !PPExtensionTest methodsFor: 'testing' stamp: 'lr 9/17/2008 22:44'! testString | parser | parser := 'ab' asParser. self assert: parser parse: 'ab' to: 'ab'. self assert: parser parse: 'aba' to: 'ab' end: 2. self assert: parser parse: 'abb' to: 'ab' end: 2. self assert: parser fail: 'a'. self assert: parser fail: 'ac'! ! !PPExtensionTest methodsFor: 'testing' stamp: 'lr 9/17/2008 22:03'! testSymbol | parser | parser := #any asParser. self assert: parser parse: 'a'. self assert: parser fail: ''! ! !PPExtensionTest methodsFor: 'testing' stamp: 'lr 4/21/2009 08:54'! testText | stream | stream := 'abc' asText asParserStream. self assert: stream class = PPStream! ! !PPExtensionTest methodsFor: 'testing' stamp: 'lr 9/15/2008 09:20'! testUnordered | parser | parser := #(1 2) asSet asParser. self assert: parser parse: #(1) to: 1. self assert: parser parse: #(2) to: 2. self assert: parser parse: #(1 2) to: 1 end: 1. self assert: parser parse: #(2 1) to: 2 end: 1. self assert: parser fail: #(). self assert: parser fail: #(3)! ! PPAbstractParseTest subclass: #PPMappingTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Tests'! !PPMappingTest methodsFor: 'testing' stamp: 'lr 9/15/2008 09:22'! testFoldLeft2 | parser | parser := #any asParser star foldLeft: [ :a :b | Array with: a with: b ]. self assert: parser parse: #(a) to: #a. self assert: parser parse: #(a b) to: #(a b). self assert: parser parse: #(a b c) to: #((a b) c). self assert: parser parse: #(a b c d) to: #(((a b) c) d). self assert: parser parse: #(a b c d e) to: #((((a b) c) d) e)! ! !PPMappingTest methodsFor: 'testing' stamp: 'lr 9/15/2008 09:22'! testFoldLeft3 | parser | parser := #any asParser star foldLeft: [ :a :b :c | Array with: a with: b with: c ]. self assert: parser parse: #(a) to: #a. self assert: parser parse: #(a b c) to: #(a b c). self assert: parser parse: #(a b c d e) to: #((a b c) d e)! ! !PPMappingTest methodsFor: 'testing' stamp: 'lr 9/15/2008 09:22'! testFoldRight2 | parser | parser := #any asParser star foldRight: [ :a :b | Array with: a with: b ]. self assert: parser parse: #(a) to: #a. self assert: parser parse: #(a b) to: #(a b). self assert: parser parse: #(a b c) to: #(a (b c)). self assert: parser parse: #(a b c d) to: #(a (b (c d))). self assert: parser parse: #(a b c d e) to: #(a (b (c (d e))))! ! !PPMappingTest methodsFor: 'testing' stamp: 'lr 9/15/2008 09:22'! testFoldRight3 | parser | parser := #any asParser star foldRight: [ :a :b :c | Array with: a with: b with: c ]. self assert: parser parse: #(a) to: #a. self assert: parser parse: #(a b c) to: #(a b c). self assert: parser parse: #(a b c d e) to: #(a b (c d e))! ! !PPMappingTest methodsFor: 'testing' stamp: 'lr 3/30/2009 16:38'! testMap1 | parser | parser := #any asParser map: [ :a | Array with: a ]. self assert: parser parse: #(a) to: #(a)! ! !PPMappingTest methodsFor: 'testing' stamp: 'lr 9/15/2008 09:22'! testMap2 | parser | parser := (#any asParser , #any asParser) map: [ :a :b | Array with: b with: a ]. self assert: parser parse: #(a b) to: #(b a)! ! !PPMappingTest methodsFor: 'testing' stamp: 'lr 9/15/2008 09:22'! testMap3 | parser | parser := (#any asParser , #any asParser , #any asParser) map: [ :a :b :c | Array with: c with: b with: a ]. self assert: parser parse: #(a b c) to: #(c b a)! ! PPAbstractParseTest subclass: #PPParserTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Tests'! !PPParserTest methodsFor: 'testing' stamp: 'lr 9/18/2008 09:30'! testAction | parser | parser := #any asParser ==> #asUppercase. self assert: parser parse: 'a' to: $A. self assert: parser parse: 'b' to: $B! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 7/2/2008 12:17'! testAnd | parser | parser := 'foo' asParser flatten , 'bar' asParser flatten and. self assert: parser parse: 'foobar' to: #('foo' 'bar') end: 3. self assert: parser fail: 'foobaz'! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 1/8/2010 12:04'! testAnswer | parser | parser := $a asParser answer: $b. self assert: parser parse: 'a' to: $b. self assert: parser fail: ''. self assert: parser fail: 'b'! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 4/2/2009 19:56'! testBlock | parser | parser := [ :s | s next ] asParser. self assert: parser parse: 'ab' to: $a end: 1. self assert: parser parse: 'b' to: $b. self assert: parser parse: '' to: nil! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 9/15/2008 09:24'! testChoice | parser | parser := $a asParser / $b asParser. self assert: parser parse: 'a' to: $a. self assert: parser parse: 'b' to: $b. self assert: parser parse: 'ab' to: $a end: 1. self assert: parser parse: 'ba' to: $b end: 1. self assert: parser fail: ''. self assert: parser fail: 'c'. self assert: parser fail: 'ca'! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 5/7/2008 08:58'! testDelimitedBy | parser | parser := $a asParser delimitedBy: $b asParser. self assert: parser parse: 'a' to: #($a). self assert: parser parse: 'aba' to: #($a $b $a). self assert: parser parse: 'ababa' to: #($a $b $a $b $a). self assert: parser parse: 'ab' to: #($a $b). self assert: parser parse: 'abab' to: #($a $b $a $b). self assert: parser parse: 'ababab' to: #($a $b $a $b $a $b). self assert: parser parse: 'ac' to: #($a) end: 1. self assert: parser parse: 'abc' to: #($a $b) end: 2. self assert: parser parse: 'abac' to: #($a $b $a) end: 3. self assert: parser parse: 'ababc' to: #($a $b $a $b) end: 4. self assert: parser fail: ''. self assert: parser fail: 'b'. self assert: parser fail: 'c'! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 1/29/2010 11:39'! testEndOfInput | parser | parser := PPEndOfInputParser on: $a asParser. self assert: parser end = parser. self assert: parser parse: 'a' to: $a. self assert: parser fail: ''. self assert: parser fail: 'aa'! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 9/17/2008 22:47'! testEndOfInputAfterMatch | parser | parser := 'stuff' asParser end. self assert: parser parse: 'stuff' to: 'stuff'. self assert: parser fail: 'stufff'. self assert: parser fail: 'fluff'! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 11/20/2009 15:31'! testEpsilon | parser | parser := nil asParser. self assert: parser parse: '' to: nil. self assert: parser parse: 'a' to: nil end: 0. self assert: parser parse: 'ab' to: nil end: 0! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 4/21/2009 08:40'! testFailing | parser result | parser := PPFailingParser message: 'Plonk'. self assert: parser fail: ''. self assert: parser fail: 'a'. self assert: parser fail: 'aa'. result := parser parse: 'a' asParserStream. self assert: result reason = 'Plonk'. self assert: result printString = 'Plonk at 0'! ! !PPParserTest methodsFor: 'testing-utilities' stamp: 'lr 4/21/2009 08:44'! testFailure | f1 f2 f3 | f1 := PPFailure at: 1. f2 := PPFailure reason: 'Fatal'. f3 := PPFailure reason: 'Error' at: 3. self assert: f1 position = 1. self assert: f1 reason isNil. self assert: f1 isFailure. self assert: f2 position = 0. self assert: f2 reason = 'Fatal'. self assert: f2 isFailure. self assert: f3 position = 3. self assert: f3 reason = 'Error'. self assert: f3 isFailure. self deny: 4 isFailure. self deny: 'foo' isFailure! ! !PPParserTest methodsFor: 'testing' stamp: 'TestRunner 11/22/2009 13:13'! testFlatten | parser | parser := $a asParser flatten. self assert: parser parse: 'a' to: 'a'. self assert: parser parse: #($a) to: #($a). self assert: parser fail: ''. self assert: parser fail: 'b'! ! !PPParserTest methodsFor: 'testing-utilities' stamp: 'lr 10/21/2009 16:37'! testFollowing | p1 p2 p3 | p1 := #lowercase asParser. p2 := p1 ==> #asUppercase. p3 := PPUnresolvedParser new. p3 def: p2 / p3. self assert: p1 children isEmpty. self assert: p2 children size = 1. self assert: p3 children size = 2! ! !PPParserTest methodsFor: 'testing' stamp: 'TestRunner 11/5/2009 10:26'! testMax | parser | parser := $a asParser max: 2. self assert: parser parse: '' to: #(). self assert: parser parse: 'a' to: #($a). self assert: parser parse: 'aa' to: #($a $a). self assert: parser parse: 'aaa' to: #($a $a) end: 2. self assert: parser parse: 'aaaa' to: #($a $a) end: 2. self assert: (parser printString endsWith: '[0, 2]')! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 4/2/2009 20:35'! testMemoized | count parser twice | count := 0. parser := [ :s | count := count + 1. s next ] asParser memoized. twice := parser and , parser. count := 0. self assert: parser parse: 'a' to: $a. self assert: count = 1. count := 0. self assert: twice parse: 'a' to: #($a $a). self assert: count = 1. self assert: parser memoized = parser! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 11/5/2009 10:26'! testMin | parser | parser := $a asParser min: 2. self assert: parser fail: ''. self assert: parser fail: 'a'. self assert: parser parse: 'aa' to: #($a $a). self assert: parser parse: 'aaa' to: #($a $a $a). self assert: parser parse: 'aaaa' to: #($a $a $a $a). self assert: (parser printString endsWith: '[2, *]')! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 11/5/2009 10:26'! testMinMax | parser | parser := $a asParser min: 2 max: 4. self assert: parser fail: ''. self assert: parser fail: 'a'. self assert: parser parse: 'aa' to: #($a $a). self assert: parser parse: 'aaa' to: #($a $a $a). self assert: parser parse: 'aaaa' to: #($a $a $a $a). self assert: parser parse: 'aaaaa' to: #($a $a $a $a) end: 4. self assert: parser parse: 'aaaaaa' to: #($a $a $a $a) end: 4. self assert: (parser printString endsWith: '[2, 4]')! ! !PPParserTest methodsFor: 'testing-accessing' stamp: 'lr 3/30/2009 16:36'! testNamed | parser | parser := PPSequenceParser new. self assert: parser name isNil. parser := PPChoiceParser named: 'choice'. self assert: parser name = 'choice'. parser := $* asParser name: 'star'. self assert: parser name = 'star'! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 7/2/2008 12:19'! testNot | parser | parser := 'foo' asParser flatten , 'bar' asParser flatten not. self assert: parser parse: 'foobaz' to: #('foo' nil) end: 3. self assert: parser fail: 'foobar'. parser := 'foo' asParser flatten , 'bar' asParser flatten not not. self assert: parser fail: 'foobaz'. self assert: parser parse: 'foobar'! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 4/29/2008 11:32'! testOptional | parser | parser := $a asParser optional. self assert: parser parse: '' to: nil. self assert: parser parse: 'a' to: $a. self assert: parser parse: 'aa' to: $a end: 1. self assert: parser parse: 'ab' to: $a end: 1. self assert: parser parse: 'b' to: nil end: 0. self assert: parser parse: 'bb' to: nil end: 0. self assert: parser parse: 'ba' to: nil end: 0! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 1/8/2010 12:09'! testPermutation | parser | parser := #any asParser , #any asParser , #any asParser. self assert: (parser permutation: #()) parse: '123' to: #(). self assert: (parser permutation: #(1)) parse: '123' to: #($1). self assert: (parser permutation: #(1 3)) parse: '123' to: #($1 $3). self assert: (parser permutation: #(3 1)) parse: '123' to: #($3 $1). self assert: (parser permutation: #(2 2)) parse: '123' to: #($2 $2). self assert: (parser permutation: #(3 2 1)) parse: '123' to: #($3 $2 $1). self should: [ parser permutation: #(0) ] raise: Error. self should: [ parser permutation: #(4) ] raise: Error. self should: [ parser permutation: #($2) ] raise: Error! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 4/29/2008 11:33'! testPlus | parser | parser := $a asParser plus. self assert: parser parse: 'a' to: #($a). self assert: parser parse: 'aa' to: #($a $a). self assert: parser parse: 'aaa' to: #($a $a $a). self assert: parser parse: 'ab' to: #($a) end: 1. self assert: parser parse: 'aab' to: #($a $a) end: 2. self assert: parser parse: 'aaab' to: #($a $a $a) end: 3. self assert: parser fail: ''. self assert: parser fail: 'b'. self assert: parser fail: 'ba'! ! !PPParserTest methodsFor: 'testing-accessing' stamp: 'lr 11/5/2009 10:27'! testPrint | parser | parser := PPSequenceParser new. self assert: (parser printString beginsWith: 'a PPSequenceParser'). parser := PPChoiceParser named: 'choice'. self assert: (parser printString = 'a PPChoiceParser(choice)')! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 4/29/2008 11:42'! testSeparatedBy | parser | parser := $a asParser separatedBy: $b asParser. self assert: parser parse: 'a' to: #($a). self assert: parser parse: 'aba' to: #($a $b $a). self assert: parser parse: 'ababa' to: #($a $b $a $b $a). self assert: parser parse: 'ab' to: #($a) end: 1. self assert: parser parse: 'abab' to: #($a $b $a) end: 3. self assert: parser parse: 'ac' to: #($a) end: 1. self assert: parser parse: 'abac' to: #($a $b $a) end: 3. self assert: parser fail: ''. self assert: parser fail: 'c'! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 4/29/2008 11:33'! testSequence | parser | parser := $a asParser , $b asParser. self assert: parser parse: 'ab' to: #($a $b). self assert: parser parse: 'aba' to: #($a $b) end: 2. self assert: parser parse: 'abb' to: #($a $b) end: 2. self assert: parser fail: ''. self assert: parser fail: 'a'. self assert: parser fail: 'aa'. self assert: parser fail: 'ba'. self assert: parser fail: 'bab'! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 4/29/2008 11:33'! testStar | parser | parser := $a asParser star. self assert: parser parse: '' to: #(). self assert: parser parse: 'a' to: #($a). self assert: parser parse: 'aa' to: #($a $a). self assert: parser parse: 'aaa' to: #($a $a $a). self assert: parser parse: 'b' to: #() end: 0. self assert: parser parse: 'ab' to: #($a) end: 1. self assert: parser parse: 'aab' to: #($a $a) end: 2. self assert: parser parse: 'aaab' to: #($a $a $a) end: 3! ! !PPParserTest methodsFor: 'testing' stamp: 'PaoloBonzini 10/5/2009 10:34'! testToken | parser | parser := $a asParser token. self assert: parser parse: 'a' toToken: 1 stop: 1. self assert: parser parse: 'a ' toToken: 1 stop: 1. self assert: parser parse: 'a ' toToken: 1 stop: 1. self assert: parser parse: 'a ' toToken: 1 stop: 1. self assert: parser parse: 'a' toToken: 1 stop: 1. self assert: parser parse: ' a' toToken: 2 stop: 2. self assert: parser parse: ' a' toToken: 2 stop: 2. self assert: parser parse: ' a' toToken: 5 stop: 5. self assert: parser parse: 'aa' toToken: 1 stop: 1 end: 1. self assert: parser parse: 'a a' toToken: 1 stop: 1 end: 2. self assert: parser parse: 'a a' toToken: 1 stop: 1 end: 3. self assert: parser fail: ''. self assert: parser fail: 'b'! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 11/20/2009 15:31'! testUnresolved | parser | parser := PPUnresolvedParser new. self assert: parser isUnresolved. self should: [ parser parse: '' ] raise: Error. self should: [ parser parse: 'a' ] raise: Error. self should: [ parser parse: 'ab' ] raise: Error. parser := nil asParser. self deny: parser isUnresolved! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 4/3/2009 08:44'! testWrapped | parser | parser := $a asParser wrapped. self assert: parser parse: 'a' to: $a. self assert: parser fail: 'b'! ! PPAbstractParseTest subclass: #PPPredicateTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Tests'! !PPPredicateTest methodsFor: 'utilities' stamp: 'lr 11/29/2009 09:33'! assertCharacterSets: aParser "Assert the character set of aParser does not overlap with the character set with the negated parser, and that they both cover the complete character space." | positives negatives | positives := self parsedCharacterSet: aParser. negatives := self parsedCharacterSet: aParser negate. Character allCharacters do: [ :char | | positive negative | positive := positives includes: char. negative := negatives includes: char. self assert: ((positive and: [ negative not ]) or: [ positive not and: [ negative ] ]) description: char printString , ' should be in exactly one set' ]! ! !PPPredicateTest methodsFor: 'utilities' stamp: 'lr 11/29/2009 09:32'! parsedCharacterSet: aParser | result stream | result := WriteStream on: String new. Character allCharacters do: [ :char | stream := (String with: char) asParserStream. (aParser parse: stream) isFailure ifFalse: [ result nextPut: char ] ]. ^ result contents! ! !PPPredicateTest methodsFor: 'testing-objects' stamp: 'lr 11/29/2009 09:32'! testAny | parser | parser := #any asParser. self assertCharacterSets: parser. self assert: parser parse: ' ' to: $ . self assert: parser parse: '1' to: $1. self assert: parser parse: 'a' to: $a. self assert: parser fail: ''! ! !PPPredicateTest methodsFor: 'testing-objects' stamp: 'lr 11/29/2009 09:32'! testAnyOf | parser | parser := PPPredicateParser anyOf: #($a $z). self assertCharacterSets: parser. self assert: parser parse: 'a' to: $a. self assert: parser parse: 'z' to: $z. self assert: parser fail: 'x'! ! !PPPredicateTest methodsFor: 'testing-objects' stamp: 'lr 11/29/2009 09:32'! testBetweenAnd | parser | parser := PPPredicateParser between: $b and: $d. self assertCharacterSets: parser. self assert: parser fail: 'a'. self assert: parser parse: 'b' to: $b. self assert: parser parse: 'c' to: $c. self assert: parser parse: 'd' to: $d. self assert: parser fail: 'e'! ! !PPPredicateTest methodsFor: 'testing-chars' stamp: 'lr 11/29/2009 09:34'! testChar | parser | parser := $* asParser. self assertCharacterSets: parser. self assert: parser parse: '*' to: $*. self assert: parser parse: '**' to: $* end: 1. self assert: parser fail: ''. self assert: parser fail: '1'. self assert: parser fail: 'a'! ! !PPPredicateTest methodsFor: 'testing-chars' stamp: 'lr 11/29/2009 09:32'! testControl | parser | parser := #control asParser. self assertCharacterSets: parser. self assert: parser parse: (String with: Character cr) to: Character cr. self assert: parser parse: (String with: Character tab) to: Character tab. self assert: parser fail: ''. self assert: parser fail: '1'. self assert: parser fail: 'a'! ! !PPPredicateTest methodsFor: 'testing-chars' stamp: 'lr 11/29/2009 09:32'! testCr | parser | parser := #cr asParser. self assertCharacterSets: parser. self assert: parser parse: (String with: Character cr) to: Character cr! ! !PPPredicateTest methodsFor: 'testing-chars' stamp: 'lr 11/29/2009 09:32'! testDigit | parser | parser := #digit asParser. self assertCharacterSets: parser. self assert: parser parse: '0' to: $0. self assert: parser parse: '9' to: $9. self assert: parser fail: ''. self assert: parser fail: 'a'! ! !PPPredicateTest methodsFor: 'testing-objects' stamp: 'lr 11/29/2009 09:40'! testExpect | parser | parser := PPPredicateParser expect: $a. self assertCharacterSets: parser. self assert: parser parse: 'a' to: $a. self assert: parser fail: 'b'. self assert: parser fail: ''! ! !PPPredicateTest methodsFor: 'testing-chars' stamp: 'lr 11/29/2009 09:32'! testHex | parser | parser := #hex asParser. self assertCharacterSets: parser. self assert: parser parse: '0' to: $0. self assert: parser parse: '5' to: $5. self assert: parser parse: '9' to: $9. self assert: parser parse: 'A' to: $A. self assert: parser parse: 'D' to: $D. self assert: parser parse: 'F' to: $F. self assert: parser parse: 'a' to: $a. self assert: parser parse: 'e' to: $e. self assert: parser parse: 'f' to: $f. self assert: parser fail: ''. self assert: parser fail: 'g'! ! !PPPredicateTest methodsFor: 'testing-chars' stamp: 'lr 11/29/2009 09:32'! testLetter | parser | parser := #letter asParser. self assertCharacterSets: parser. self assert: parser parse: 'a' to: $a. self assert: parser parse: 'Z' to: $Z. self assert: parser fail: ''. self assert: parser fail: '0'! ! !PPPredicateTest methodsFor: 'testing-chars' stamp: 'lr 11/29/2009 09:32'! testLf | parser | parser := #lf asParser. self assertCharacterSets: parser. self assert: parser parse: (String with: Character lf) to: Character lf! ! !PPPredicateTest methodsFor: 'testing-chars' stamp: 'lr 11/29/2009 09:32'! testLowercase | parser | parser := #lowercase asParser. self assertCharacterSets: parser. self assert: parser parse: 'a' to: $a. self assert: parser parse: 'z' to: $z. self assert: parser fail: ''. self assert: parser fail: 'A'. self assert: parser fail: '0'! ! !PPPredicateTest methodsFor: 'testing-chars' stamp: 'lr 11/29/2009 09:36'! testNewline | parser | parser := #newline asParser. self assertCharacterSets: parser. self assert: parser parse: (String with: Character cr) to: Character cr. self assert: parser parse: (String with: Character lf) to: Character lf. self assert: parser fail: ' '! ! !PPPredicateTest methodsFor: 'testing-chars' stamp: 'lr 11/29/2009 09:32'! testSpace | parser | parser := #space asParser. self assertCharacterSets: parser. self assert: parser parse: (String with: Character tab) to: Character tab. self assert: parser parse: ' ' to: Character space. self assert: parser fail: ''. self assert: parser fail: 'a'! ! !PPPredicateTest methodsFor: 'testing-chars' stamp: 'lr 11/29/2009 09:32'! testTab | parser | parser := #tab asParser. self assertCharacterSets: parser. self assert: parser parse: (String with: Character tab) to: Character tab! ! !PPPredicateTest methodsFor: 'testing-chars' stamp: 'lr 11/29/2009 09:32'! testUppercase | parser | parser := #uppercase asParser. self assertCharacterSets: parser. self assert: parser parse: 'A' to: $A. self assert: parser parse: 'Z' to: $Z. self assert: parser fail: ''. self assert: parser fail: 'a'. self assert: parser fail: '0'! ! !PPPredicateTest methodsFor: 'testing-chars' stamp: 'lr 11/29/2009 09:32'! testWord | parser | parser := #word asParser. self assertCharacterSets: parser. self assert: parser parse: 'a' to: $a. self assert: parser parse: 'A' to: $A. self assert: parser parse: '0' to: $0. self assert: parser fail: ''. self assert: parser fail: '-'! ! PPAbstractParseTest subclass: #PPTokenTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Tests'! !PPTokenTest methodsFor: 'accessing' stamp: 'lr 4/3/2009 08:51'! identifier ^ #word asParser plus token! ! !PPTokenTest methodsFor: 'utilities' stamp: 'lr 4/3/2009 08:49'! parse: aString using: aParser ^ aParser parse: aString asParserStream! ! !PPTokenTest methodsFor: 'testing' stamp: 'lr 4/3/2009 08:49'! testCollection | input result | input := 'foo '. result := self parse: input using: self identifier. self assert: (result collection = input). self assert: (result collection == input)! ! !PPTokenTest methodsFor: 'testing' stamp: 'lr 4/21/2009 08:50'! testCopyFromTo | result other | result := PPToken on: 'abc'. other := result copyFrom: 2 to: 2. self assert: other size = 1. self assert: other start = 2. self assert: other stop = 2. self assert: other collection = result collection! ! !PPTokenTest methodsFor: 'testing' stamp: 'lr 10/23/2009 11:37'! testEquality | token1 token2 | token1 := self parse: 'foo' using: self identifier. token2 := self parse: 'foo' using: self identifier. self deny: token1 == token2. self assert: token1 = token2. self assert: token1 hash = token2 hash.! ! !PPTokenTest methodsFor: 'testing' stamp: 'TestRunner 12/4/2009 19:16'! testPrinting | result | result := PPToken on: 'var'. self assert: result printString = 'a PPToken(var)'! ! !PPTokenTest methodsFor: 'testing' stamp: 'TestRunner 12/4/2009 19:16'! testSize | result | result := self parse: 'foo' using: self identifier. self assert: result size = 3! ! !PPTokenTest methodsFor: 'testing' stamp: 'TestRunner 12/4/2009 19:16'! testStart | result | result := self parse: 'foo' using: self identifier. self assert: result start = 1! ! !PPTokenTest methodsFor: 'testing' stamp: 'TestRunner 12/4/2009 19:16'! testStop | result | result := self parse: 'foo' using: self identifier. self assert: result stop = 3! ! !PPTokenTest methodsFor: 'testing' stamp: 'lr 4/3/2009 08:51'! testValue | input result | input := 'foo'. result := self parse: input using: self identifier. self assert: result value = input. self deny: result value == input! ! TestCase subclass: #PPCompositeParserTest instanceVariableNames: 'parser' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Tests'! PPCompositeParserTest subclass: #PPArithmeticParserTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Tests'! !PPArithmeticParserTest methodsFor: 'accessing' stamp: 'FirstnameLastname 11/26/2009 21:53'! parserClass ^ PPArithmeticParser! ! !PPArithmeticParserTest methodsFor: 'testing-operations' stamp: 'lr 4/30/2008 17:21'! testAdd self assert: '1 + 2' is: 3. self assert: '2 + 1' is: 3. self assert: '1 + 2.3' is: 3.3. self assert: '2.3 + 1' is: 3.3. self assert: '1 + -2' is: -1. self assert: '-2 + 1' is: -1! ! !PPArithmeticParserTest methodsFor: 'testing-operations' stamp: 'lr 4/21/2008 10:23'! testAddMany self assert: '1' is: 1. self assert: '1 + 2' is: 3. self assert: '1 + 2 + 3' is: 6. self assert: '1 + 2 + 3 + 4' is: 10. self assert: '1 + 2 + 3 + 4 + 5' is: 15! ! !PPArithmeticParserTest methodsFor: 'testing-expression' stamp: 'lr 4/21/2008 10:03'! testBrackets self assert: '(1)' is: 1. self assert: '(1 + 2)' is: 3. self assert: '((1))' is: 1. self assert: '((1 + 2))' is: 3. self assert: '2 * (3 + 4)' is: 14. self assert: '(2 + 3) * 4' is: 20. self assert: '6 / (2 + 4)' is: 1. self assert: '(2 + 6) / 2' is: 4! ! !PPArithmeticParserTest methodsFor: 'testing-operations' stamp: 'lr 4/21/2008 09:32'! testDiv self assert: '12 / 3' is: 4. self assert: '-16 / -4' is: 4! ! !PPArithmeticParserTest methodsFor: 'testing-operations' stamp: 'lr 7/3/2008 15:46'! testDivMany self assert: '100 / 2' is: 50. self assert: '100 / 2 / 2' is: 25. self assert: '100 / 2 / 2 / 5' is: 5. self assert: '100 / 2 / 2 / 5 / 5' is: 1 ! ! !PPArithmeticParserTest methodsFor: 'testing-operations' stamp: 'lr 4/21/2008 09:31'! testMul self assert: '2 * 3' is: 6. self assert: '2 * -4' is: -8! ! !PPArithmeticParserTest methodsFor: 'testing-operations' stamp: 'lr 4/21/2008 10:16'! testMulMany self assert: '1 * 2' is: 2. self assert: '1 * 2 * 3' is: 6. self assert: '1 * 2 * 3 * 4' is: 24. self assert: '1 * 2 * 3 * 4 * 5' is: 120! ! !PPArithmeticParserTest methodsFor: 'testing' stamp: 'lr 4/21/2008 09:32'! testNum self assert: '0' is: 0. self assert: '0.0' is: 0.0. self assert: '1' is: 1. self assert: '1.2' is: 1.2. self assert: '34' is: 34. self assert: '56.78' is: 56.78. self assert: '-9' is: -9. self assert: '-9.9' is: -9.9! ! !PPArithmeticParserTest methodsFor: 'testing-operations' stamp: 'lr 7/3/2008 15:28'! testPow self assert: '2 ^ 3' is: 8. self assert: '-2 ^ 3' is: -8. self assert: '-2 ^ -3' is: -0.125! ! !PPArithmeticParserTest methodsFor: 'testing-operations' stamp: 'lr 7/3/2008 15:45'! testPowMany self assert: '4 ^ 3' is: 64. self assert: '4 ^ 3 ^ 2' is: 262144. self assert: '4 ^ 3 ^ 2 ^ 1' is: 262144. self assert: '4 ^ 3 ^ 2 ^ 1 ^ 0' is: 262144! ! !PPArithmeticParserTest methodsFor: 'testing-expression' stamp: 'lr 4/21/2008 10:00'! testPriority self assert: '2 * 3 + 4' is: 10. self assert: '2 + 3 * 4' is: 14. self assert: '6 / 3 + 4' is: 6. self assert: '2 + 6 / 2' is: 5! ! !PPArithmeticParserTest methodsFor: 'testing-operations' stamp: 'lr 4/28/2008 11:55'! testSub self assert: '1 - 2' is: -1. self assert: '1.3 - 2' is: -0.7. self assert: '1 - -2' is: 3. self assert: '-1 - -2' is: 1! ! !PPArithmeticParserTest methodsFor: 'testing-operations' stamp: 'lr 4/28/2008 11:56'! testSubMany self assert: '1' is: 1. self assert: '1 - 2' is: -1. self assert: '1 - 2 - 3' is: -4. self assert: '1 - 2 - 3 - 4' is: -8. self assert: '1 - 2 - 3 - 4 - 5' is: -13! ! PPArithmeticParserTest subclass: #PPExpressionParserTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Tests'! !PPExpressionParserTest methodsFor: 'accessing' stamp: 'FirstnameLastname 11/26/2009 21:57'! parserInstance | expression parens number | expression := PPExpressionParser new. parens := $( asParser token , expression , $) asParser token ==> [ :nodes | nodes second ]. number := (#digit asParser plus , ($. asParser , #digit asParser plus) optional) token ==> [ :token | token value asNumber ]. expression term: parens / number. expression group: [ :g | g prefix: $- asParser token do: [ :op :a | a negated ] ]; group: [ :g | g postfix: '++' asParser token do: [ :a :op | a + 1 ]. g postfix: '--' asParser token do: [ :a :op | a - 1 ] ]; group: [ :g | g right: $^ asParser token do: [ :a :op :b | a raisedTo: b ] ]; group: [ :g | g left: $* asParser token do: [ :a :op :b | a * b ]. g left: $/ asParser token do: [ :a :op :b | a / b ] ]; group: [ :g | g left: $+ asParser token do: [ :a :op :b | a + b ]. g left: $- asParser token do: [ :a :op :b | a - b ] ]. ^ expression end! ! !PPExpressionParserTest methodsFor: 'testing' stamp: 'FirstnameLastname 11/26/2009 22:13'! testPostfixAdd self assert: '0++' is: 1. self assert: '0++++' is: 2. self assert: '0++++++' is: 3. self assert: '0+++1' is: 2. self assert: '0+++++1' is: 3. self assert: '0+++++++1' is: 4! ! !PPExpressionParserTest methodsFor: 'testing' stamp: 'FirstnameLastname 11/26/2009 22:11'! testPostfixSub self assert: '1--' is: 0. self assert: '2----' is: 0. self assert: '3------' is: 0. self assert: '2---1' is: 0. self assert: '3-----1' is: 0. self assert: '4-------1' is: 0.! ! !PPExpressionParserTest methodsFor: 'testing' stamp: 'FirstnameLastname 11/26/2009 22:13'! testPrefixNegate self assert: '1' is: 1. self assert: '-1' is: -1. self assert: '--1' is: 1. self assert: '---1' is: -1! ! !PPCompositeParserTest class methodsFor: 'testing' stamp: 'lr 10/4/2009 17:09'! isAbstract ^ self name = #PPCompositeParserTest! ! !PPCompositeParserTest methodsFor: 'utilities' stamp: 'TestRunner 11/22/2009 13:18'! assert: aCollection is: anObject | result | result := parser parse: aCollection asParserStream. result isFailure ifTrue: [ self error: result printString ]. self assert: result = anObject description: 'Got: ' , result printString , '; Expected: ' , anObject printString resumable: true! ! !PPCompositeParserTest methodsFor: 'accessing' stamp: 'FirstnameLastname 11/26/2009 21:52'! parserClass self subclassResponsibility! ! !PPCompositeParserTest methodsFor: 'accessing' stamp: 'FirstnameLastname 11/26/2009 21:52'! parserInstance ^ self parserClass new! ! !PPCompositeParserTest methodsFor: 'running' stamp: 'FirstnameLastname 11/26/2009 21:48'! setUp super setUp. parser := self parserInstance! ! PPCompositeParserTest subclass: #PPLambdaParserTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Tests'! !PPLambdaParserTest methodsFor: 'accessing' stamp: 'FirstnameLastname 11/26/2009 21:53'! parserClass ^ PPLambdaParser! ! !PPLambdaParserTest methodsFor: 'testing' stamp: 'lr 4/30/2008 09:38'! testAbstraction self assert: '\x.y' is: #('x' 'y'). self assert: '\x.\y.z' is: #('x' ('y' 'z'))! ! !PPLambdaParserTest methodsFor: 'testing-curch' stamp: 'FirstnameLastname 11/26/2009 21:53'! testAnd self assert: self parserClass and = #('p' ('q' (('p' 'q') 'p')))! ! !PPLambdaParserTest methodsFor: 'testing' stamp: 'lr 4/30/2008 09:38'! testApplication self assert: '(x x)' is: #('x' 'x'). self assert: '(x y)' is: #('x' 'y'). self assert: '((x y) z)' is: #(('x' 'y') 'z'). self assert: '(x (y z))' is: #('x' ('y' 'z'))! ! !PPLambdaParserTest methodsFor: 'testing-curch' stamp: 'FirstnameLastname 11/26/2009 21:53'! testFalse self assert: self parserClass false = #('x' ('y' 'y'))! ! !PPLambdaParserTest methodsFor: 'testing-curch' stamp: 'FirstnameLastname 11/26/2009 21:53'! testIfThenElse self assert: self parserClass ifthenelse = #('p' 'p')! ! !PPLambdaParserTest methodsFor: 'testing-curch' stamp: 'FirstnameLastname 11/26/2009 21:53'! testNot self assert: self parserClass not = #('p' ('a' ('b' (('p' 'b') 'a'))))! ! !PPLambdaParserTest methodsFor: 'testing-curch' stamp: 'FirstnameLastname 11/26/2009 21:53'! testOr self assert: self parserClass or = #('p' ('q' (('p' 'p') 'q')))! ! !PPLambdaParserTest methodsFor: 'testing-utilities' stamp: 'lr 12/7/2009 08:34'! testParseOnError | result beenHere | result := self parserClass parse: '\x.y' onError: [ self fail ]. self assert: result = #('x' 'y'). beenHere := false. result := self parserClass parse: '\x.' onError: [ beenHere := true ]. self assert: beenHere. beenHere := false. result := self parserClass parse: '\x.' onError: [ :fail | beenHere := true. fail ]. self assert: beenHere. self assert: result reason = 'letter expected'. self assert: result position = 3. beenHere := false. result := self parserClass parse: '\x.' onError: [ :msg :pos | self assert: msg = 'letter expected'. self assert: pos = 3. beenHere := true ]. self assert: beenHere! ! !PPLambdaParserTest methodsFor: 'testing-utilities' stamp: 'TestRunner 12/7/2009 08:46'! testParseStartingAtOnError | result beenHere | result := self parserClass parse: 'x' startingAt: #variable onError: [ self fail ]. self assert: result = 'x'. beenHere := false. result := self parserClass parse: '\' startingAt: #variable onError: [ beenHere := true ]. self assert: beenHere. beenHere := false. result := self parserClass parse: '\' startingAt: #variable onError: [ :fail | beenHere := true. fail ]. self assert: beenHere. self assert: result reason = 'letter expected'. self assert: result position = 0. beenHere := false. result := self parserClass parse: '\' startingAt: #variable onError: [ :msg :pos | self assert: msg = 'letter expected'. self assert: pos = 0. beenHere := true ]. self assert: beenHere! ! !PPLambdaParserTest methodsFor: 'testing-utilities' stamp: 'FirstnameLastname 11/26/2009 21:56'! testProductionAt self assert: (parser productionAt: #foo) isNil. self assert: (parser productionAt: #foo ifAbsent: [ true ]). self assert: (parser productionAt: #start) notNil. self assert: (parser productionAt: #start ifAbsent: [ true ]) notNil. self assert: (parser productionAt: #variable) notNil. self assert: (parser productionAt: #variable ifAbsent: [ true ]) notNil! ! !PPLambdaParserTest methodsFor: 'testing-curch' stamp: 'FirstnameLastname 11/26/2009 21:53'! testTrue self assert: self parserClass true = #('x' ('y' 'x'))! ! !PPLambdaParserTest methodsFor: 'testing' stamp: 'lr 4/30/2008 09:33'! testVariable self assert: 'x' is: 'x'. self assert: 'xy' is: 'xy'. self assert: 'x12' is: 'x12'! ! ReadStream subclass: #PPStream instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPStream commentStamp: 'lr 1/8/2010 15:51' prior: 0! A positional stream implementation used for parsing. It overrides some methods for optimization reasons. Note: The class side contains some parser constructor methods intended for fast stream operations.! !PPStream methodsFor: 'converting' stamp: 'lr 5/19/2008 15:11'! asParserStream ^ self! ! !PPStream methodsFor: 'accessing' stamp: 'lr 12/4/2009 18:39'! next: anInteger "Answer up to anInteger elements of my collection. Overridden for efficiency." | answer endPosition | endPosition := position + anInteger min: readLimit. answer := collection copyFrom: position + 1 to: endPosition. position := endPosition. ^ answer ! ! !PPStream methodsFor: 'accessing' stamp: 'lr 4/29/2008 21:48'! peek "An improved version of peek, that is slightly faster than the built in version." ^ self atEnd ifFalse: [ collection at: position + 1 ]! ! !PPStream methodsFor: 'printing' stamp: 'PaoloBonzini 10/6/2009 20:33'! printOn: aStream aStream nextPutAll: (collection copyFrom: 1 to: position); nextPutAll: '·'; nextPutAll: (collection copyFrom: position + 1 to: readLimit)! ! !UndefinedObject methodsFor: '*petitparser-converting' stamp: 'lr 11/20/2009 15:27'! asParser ^ PPEpsilonParser new! ! !Character methodsFor: '*petitparser-core-operators' stamp: 'lr 9/17/2008 21:56'! - aCharacter "Create a range of characters between the receiver and the argument." ^ PPPredicateParser between: self and: aCharacter! ! !Character methodsFor: '*petitparser-converting' stamp: 'lr 11/7/2009 13:36'! asParser ^ PPLiteralObjectParser on: self! !