Updated to PetitCompiler-JanVrany.135, PetitCompiler-Tests-JanKurs.93, PetitCompiler-Extras-Tests-JanVrany.16, PetitCompiler-Benchmarks-JanKurs.12
Name: PetitCompiler-JanVrany.135
Author: JanVrany
Time: 22-07-2015, 06:53:29.127 PM
UUID: 890178b5-275d-46af-a2ad-1738998f07cb
Ancestors: PetitCompiler-JanVrany.134
Name: PetitCompiler-Tests-JanKurs.93
Author: JanKurs
Time: 20-07-2015, 11:30:10.283 PM
UUID: 6473e671-ad70-42ca-b6c3-654b78edc531
Ancestors: PetitCompiler-Tests-JanKurs.92
Name: PetitCompiler-Extras-Tests-JanVrany.16
Author: JanVrany
Time: 22-07-2015, 05:18:22.387 PM
UUID: 8f6f9129-dbba-49b1-9402-038470742f98
Ancestors: PetitCompiler-Extras-Tests-JanKurs.15
Name: PetitCompiler-Benchmarks-JanKurs.12
Author: JanKurs
Time: 06-07-2015, 02:10:06.901 PM
UUID: cb24f1ac-46a4-494d-9780-64576f0f0dba
Ancestors: PetitCompiler-Benchmarks-JanKurs.11, PetitCompiler-Benchmarks-JanVrany.e29bd90f388e.20150619081300
"{ 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 §'
! !