Tests refactoring - use generated test cases to make sure all posibilities are tested.
Do not generate resource for all combinations, use PPCSetUpBeforeTearDownAfterResource
instead that delegates parser compilation to the testcase itself (it calls it's #setUpBefore
method).
"{ Package: 'stx:goodies/petitparser' }"
"{ NameSpace: Smalltalk }"
PPDelegateParser subclass:#PPExpressionParser
instanceVariableNames:'operators'
classVariableNames:''
poolDictionaries:''
category:'PetitParser-Tools'
!
!PPExpressionParser methodsFor:'private'!
build: aParser left: aChoiceParser
^ (aParser separatedBy: aChoiceParser) foldLeft: [ :a :op :b | op first value: a value: op second value: b ]
!
build: aParser postfix: aChoiceParser
^ aParser , aChoiceParser star map: [ :term :ops | ops inject: term into: [ :result :operator | operator first value: result value: operator second ] ]
!
build: aParser prefix: aChoiceParser
^ aChoiceParser star , aParser map: [ :ops :term | ops reverse inject: term into: [ :result :operator | operator first value: operator second value: result ] ]
!
build: aParser right: aChoiceParser
^ (aParser separatedBy: aChoiceParser) foldRight: [ :a :op :b | op first value: a value: op second value: b ]
!
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 ]) ] ]) ] ]
!
buildSelectors
^ #(build:prefix: build:postfix: build:right: build:left:)
!
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 asParser with: aBlock)
! !
!PPExpressionParser methodsFor:'specifying'!
group: aOneArgumentBlock
"Defines a priority group by evaluating aOneArgumentBlock."
operators := Dictionary new.
parser := [
aOneArgumentBlock value: self.
self buildOn: parser ]
ensure: [ operators := nil ]
!
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
!
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
!
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
!
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
!
term: aParser
"Defines the initial term aParser of the receiver."
parser isNil
ifTrue: [ parser := aParser ]
ifFalse: [ self error: 'Unable to redefine the term.' ]
! !
!PPExpressionParser class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/goodies/petitparser/PPExpressionParser.st,v 1.3 2012-05-04 21:59:01 vrany Exp $'
!
version_CVS
^ '$Header: /cvs/stx/stx/goodies/petitparser/PPExpressionParser.st,v 1.3 2012-05-04 21:59:01 vrany Exp $'
!
version_SVN
^ '§Id: PPExpressionParser.st 2 2010-12-17 18:44:23Z vranyj1 §'
! !