PPExpressionParser.st
author sr
Wed, 04 Jul 2018 15:30:19 +0200
changeset 611 38338f2de417
parent 11 e6e33e8fe655
child 427 a7f5e6de19d2
child 646 6e97d8145481
permissions -rw-r--r--
build order was wrong
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
4
90de244a7fa2 move to package
Claus Gittinger <cg@exept.de>
parents: 0
diff changeset
     1
"{ Package: 'stx:goodies/petitparser' }"
0
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     2
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     3
PPDelegateParser subclass:#PPExpressionParser
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     4
	instanceVariableNames:'operators'
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     5
	classVariableNames:''
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     6
	poolDictionaries:''
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     7
	category:'PetitParser-Tools'
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     8
!
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     9
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    10
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    11
!PPExpressionParser methodsFor:'private'!
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    12
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    13
build: aParser left: aChoiceParser
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    14
	^ (aParser separatedBy: aChoiceParser) foldLeft: [ :a :op :b | op first value: a value: op second value: b ]
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    15
!
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    16
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    17
build: aParser postfix: aChoiceParser
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    18
	^ aParser , aChoiceParser star map: [ :term :ops | ops inject: term into: [ :result :operator | operator first value: result value: operator second ] ]
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    19
!
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    20
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    21
build: aParser prefix: aChoiceParser
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    22
	^ aChoiceParser star , aParser map: [ :ops :term | ops reversed inject: term into: [ :result :operator | operator first value: operator second value: result ] ]
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    23
!
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    24
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    25
build: aParser right: aChoiceParser
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    26
	^ (aParser separatedBy: aChoiceParser) foldRight: [ :a :op :b | op first value: a value: op second value: b ]
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    27
!
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    28
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    29
buildOn: aParser
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    30
	^ self buildSelectors inject: aParser into: [ :term :selector |
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    31
		| list |
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    32
		list := operators at: selector ifAbsent: [ #() ].
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    33
		list isEmpty
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    34
			ifTrue: [ term ]
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    35
			ifFalse: [
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    36
				self
11
e6e33e8fe655 Checkin from browser
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 4
diff changeset
    37
					perform: selector with: term 
0
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    38
					with: (list size = 1
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    39
						ifTrue: [ list first first ==> [ :operator | Array with: list first second with: operator ] ]
11
e6e33e8fe655 Checkin from browser
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 4
diff changeset
    40
						ifFalse: [ 
0
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    41
							list
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    42
								inject: PPChoiceParser new
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    43
								into: [ :choice :each | choice / (each first ==> [ :operator | Array with: each second with: operator ]) ] ]) ] ]
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    44
!
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    45
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    46
buildSelectors
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    47
	^ #(build:prefix: build:postfix: build:right: build:left:)
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    48
!
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    49
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    50
operator: aSymbol parser: aParser do: aBlock
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    51
	parser isNil
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    52
		ifTrue: [ ^ self error: 'You did not specify a term when creating the receiver.' ].
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    53
	operators isNil
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    54
		ifTrue: [ ^ self error: 'Use #group: to define precedence groups in descending order.' ].
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    55
	(operators at: aSymbol ifAbsentPut: [ OrderedCollection new ])
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    56
		addLast: (Array with: aParser asParser with: aBlock)
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    57
! !
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    58
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    59
!PPExpressionParser methodsFor:'specifying'!
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    60
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    61
group: aOneArgumentBlock
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    62
	"Defines a priority group by evaluating aOneArgumentBlock."
11
e6e33e8fe655 Checkin from browser
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 4
diff changeset
    63
	
0
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    64
	operators := Dictionary new.
11
e6e33e8fe655 Checkin from browser
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 4
diff changeset
    65
	parser := [ 
0
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    66
		aOneArgumentBlock value: self.
11
e6e33e8fe655 Checkin from browser
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 4
diff changeset
    67
	 	self buildOn: parser ]
0
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    68
			ensure: [ operators := nil ]
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    69
!
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    70
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    71
left: aParser do: aThreeArgumentBlock
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    72
	"Define an operator aParser that is left-associative. Evaluate aThreeArgumentBlock with the first term, the operator, and the second term."
11
e6e33e8fe655 Checkin from browser
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 4
diff changeset
    73
	
0
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    74
	self operator: #build:left: parser: aParser do: aThreeArgumentBlock
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    75
!
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    76
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    77
postfix: aParser do: aTwoArgumentBlock
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    78
	"Define a postfix operator aParser. Evaluate aTwoArgumentBlock with the term and the operator."
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    79
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    80
	self operator: #build:postfix: parser: aParser do: aTwoArgumentBlock
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    81
!
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    82
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    83
prefix: aParser do: aTwoArgumentBlock
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    84
	"Define a prefix operator aParser. Evaluate aTwoArgumentBlock with the operator and the term."
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    85
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    86
	self operator: #build:prefix: parser: aParser do: aTwoArgumentBlock
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    87
!
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    88
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    89
right: aParser do: aThreeArgumentBlock
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    90
	"Define an operator aParser that is right-associative. Evaluate aThreeArgumentBlock with the first term, the operator, and the second term."
11
e6e33e8fe655 Checkin from browser
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 4
diff changeset
    91
	
0
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    92
	self operator: #build:right: parser: aParser do: aThreeArgumentBlock
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    93
!
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    94
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    95
term: aParser
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    96
	"Defines the initial term aParser of the receiver."
11
e6e33e8fe655 Checkin from browser
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 4
diff changeset
    97
	
0
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    98
	parser isNil
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    99
		ifTrue: [ parser := aParser ]
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   100
		ifFalse: [ self error: 'Unable to redefine the term.' ]
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   101
! !
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   102
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   103
!PPExpressionParser class methodsFor:'documentation'!
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   104
11
e6e33e8fe655 Checkin from browser
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 4
diff changeset
   105
version
e6e33e8fe655 Checkin from browser
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 4
diff changeset
   106
    ^ '$Header: /cvs/stx/stx/goodies/petitparser/PPExpressionParser.st,v 1.3 2012-05-04 21:59:01 vrany Exp $'
e6e33e8fe655 Checkin from browser
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 4
diff changeset
   107
!
e6e33e8fe655 Checkin from browser
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 4
diff changeset
   108
e6e33e8fe655 Checkin from browser
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 4
diff changeset
   109
version_CVS
e6e33e8fe655 Checkin from browser
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 4
diff changeset
   110
    ^ '$Header: /cvs/stx/stx/goodies/petitparser/PPExpressionParser.st,v 1.3 2012-05-04 21:59:01 vrany Exp $'
e6e33e8fe655 Checkin from browser
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 4
diff changeset
   111
!
e6e33e8fe655 Checkin from browser
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 4
diff changeset
   112
0
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   113
version_SVN
11
e6e33e8fe655 Checkin from browser
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 4
diff changeset
   114
    ^ '§Id: PPExpressionParser.st 2 2010-12-17 18:44:23Z vranyj1 §'
0
739fe9b7253e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   115
! !