author | Jan Vrany <jan.vrany@fit.cvut.cz> |
Wed, 05 Nov 2014 21:40:01 +0000 | |
changeset 413 | 5389e6fbb3bc |
parent 11 | e6e33e8fe655 |
child 427 | a7f5e6de19d2 |
child 646 | 6e97d8145481 |
permissions | -rw-r--r-- |
"{ Package: 'stx:goodies/petitparser' }" 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 reversed 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 §' ! !