"{ Package: 'stx:goodies/smaCC' }"

"{ NameSpace: SmaCC }"

Set subclass:#SmaCCItemSet

	instanceVariableNames:'type derivedFrom id'

	classVariableNames:''

	poolDictionaries:''

	category:'SmaCC-Parser Generator'

!

SmaCCItemSet comment:'SmaCCItemSet represents a LALR(1) or a LR(1) item set.

Instance Variables:

	type	<Symbol>	#LALR1 or #LR1

'

!

!SmaCCItemSet class methodsFor:'instance creation'!

new: anInteger 

	^(super new: anInteger)

		initialize;

		yourself

! !

!SmaCCItemSet methodsFor:'accessing'!

action: aGrammarSymbol prefer: aClass 

	| action actionItem eachAction |

	action := SmaCCRejectAction new.

	self do: 

			[:each | 

			eachAction := each action: aGrammarSymbol.

			action class = SmaCCRejectAction 

				ifTrue: 

					[action := eachAction.

					actionItem := each]

				ifFalse: 

					[(eachAction = action or: [eachAction class = SmaCCRejectAction]) 

						ifFalse: 

							[eachAction class = SmaCCShiftAction | (action class = SmaCCShiftAction) 

								ifTrue: 

									["Shift/Reduce conflict -- check precedence"

									(aGrammarSymbol precedence isNil 

										or: [each precedence isNil or: [actionItem precedence isNil]]) 

											ifTrue: 

												["No precedence, choose shift"

												eachAction class = SmaCCShiftAction 

													ifTrue: 

														[self 

															raiseXReduceNotification: each

															with: actionItem

															type: 'Shift/Reduce Conflict'.

														action := eachAction.

														actionItem := each]

													ifFalse: 

														[self 

															raiseXReduceNotification: actionItem

															with: each

															type: 'Shift/Reduce Conflict']]

											ifFalse: 

												[(each precedence > actionItem precedence 

													or: [each precedence = actionItem precedence and: [eachAction class = aClass]]) 

														ifTrue: 

															[self 

																raiseXReduceNotification: each

																with: actionItem

																type: 'Shift/Reduce Conflict (handled by precedence rules)'.

															action := eachAction.

															actionItem := each]

														ifFalse: 

															[(each precedence = actionItem precedence and: [SmaCCRejectAction = aClass]) 

																ifTrue: 

																	[self 

																		raiseXReduceNotificationWithNoPreferredItem: actionItem

																		with: each

																		type: 'Shift/Reduce Conflict (handled by precedence rules)'.

																	^aClass new]

																ifFalse: 

																	[self 

																		raiseXReduceNotification: actionItem

																		with: each

																		type: 'Shift/Reduce Conflict (handled by precedence rules)']]]]

								ifFalse: 

									["Reduce/Reduce conflict -- just pick one and proceed"

									self 

										raiseXReduceNotification: actionItem

										with: each

										type: 'Reduce/Reduce Conflict']]]].

	^action

!

derivedFrom

    ^ derivedFrom

    "Created: / 14-02-2008 / 13:26:17 / janfrog"

!

derivedFrom:something

    derivedFrom := something.

    "Created: / 14-02-2008 / 13:26:17 / janfrog"

!

id

    ^ id

    "Created: / 14-02-2008 / 13:28:54 / janfrog"

!

id:something

    id := something.

    "Created: / 14-02-2008 / 13:28:54 / janfrog"

!

mergeWith: anItemSet 

	self == anItemSet ifTrue: [^self].

	anItemSet do: [:each | self add: each]

!

moveOn: aGrammarSymbol 

        | anItemSet |

        anItemSet := self class new.

        anItemSet type: type.

        anItemSet derivedFrom: self.

        self 

                do: [:each | each nextSymbol == aGrammarSymbol ifTrue: [anItemSet add: each moveNext]].

        ^anItemSet

    "Modified: / 14-02-2008 / 13:26:51 / janfrog"

!

raiseXReduceNotification: preferredItem with: otherItem type: aString

        | stream |

        stream := WriteStream on: (String new: 200).

        stream

                nextPutAll: preferredItem printString;

                nextPutAll: '   *****';

                cr;

                nextPutAll: otherItem printString.

        Smalltalk isSmalltalkX ifTrue:[

            SmaCCCompilationNotification raiseSignal: aString with: stream contents

        ] ifFalse:[

            SmaCCCompilationNotification signal: aString with: stream contents

        ]

!

raiseXReduceNotificationWithNoPreferredItem: firstItem with: secondItem type: aString

        | stream |

        stream := WriteStream on: (String new: 200).

        stream

                nextPutAll: firstItem printString;

                cr;

                nextPutAll: secondItem printString.

        Smalltalk isSmalltalkX ifTrue:[

            SmaCCCompilationNotification raiseSignal: aString with: stream contents

        ] ifFalse:[

            SmaCCCompilationNotification signal: aString with: stream contents

        ]

! !

!SmaCCItemSet methodsFor:'adding'!

add: aLR1Item

        | index item |

        aLR1Item == nil ifTrue: [^aLR1Item].

        Smalltalk isSmalltalkX ifTrue:[

            index := self findKeyOrNil: aLR1Item.

            item := keyArray basicAt: index.

            item == nil 

                    ifTrue: 

                            [keyArray basicAt: index put: aLR1Item.

                             tally := tally + 1.

                            self performClosureOn: aLR1Item]

                    ifFalse: [item mergeWith: aLR1Item].

        ] ifFalse:[

            index := self findElementOrNil: aLR1Item.

            item := self basicAt: index.

            item == nil 

                    ifTrue: 

                            [self privateAt: index put: aLR1Item.

                            self performClosureOn: aLR1Item]

                    ifFalse: [item mergeWith: aLR1Item].

        ].

        ^aLR1Item

! !

!SmaCCItemSet methodsFor:'comparing'!

= anItemSet 

	self class = anItemSet class 

		ifTrue: 

			[type == #LALR1

				ifTrue: [^self isLALREqualTo: anItemSet]

				ifFalse: [^self isLREqualTo: anItemSet]].

	^false

!

hash

	^self inject: self class hash into: [:sum :each | sum bitXor: each hash]

! !

!SmaCCItemSet methodsFor:'copying'!

copyEmpty: aSize 

	^(super copyEmpty: aSize)

		type: type;

		yourself

! !

!SmaCCItemSet methodsFor:'initialize-release'!

initialize

	(self class superclass canUnderstand: #initialize) 

		ifTrue: [super initialize].

	type := #LALR1

!

type: aSymbol 

	type := aSymbol

! !

!SmaCCItemSet methodsFor:'printing'!

printOn:aStream

    id ifNotNil:

        [aStream nextPutAll: id printString asText allBold].

    derivedFrom ifNotNil:

        [derivedFrom id ifNotNil:

            [aStream 

                nextPutAll:' (derived from ';

                nextPutAll:derivedFrom id printString asText allBold;

                nextPut:$)]].

    aStream cr.

    self do:[:each | 

        aStream

            tab;

            nextPutAll:each printString;

            cr

    ]

    "Modified: / 14-02-2008 / 13:34:50 / janfrog"

! !

!SmaCCItemSet methodsFor:'private'!

itemFor: anObject 

        Smalltalk isSmalltalkX ifTrue:[

            ^keyArray basicAt: (self findKeyOrNil: anObject)

        ].

        ^self basicAt: (self findElementOrNil: anObject)

!

performClosureOn: aLR1Item 

	| nextSymbol rest first followers |

	nextSymbol := aLR1Item nextSymbol.

	nextSymbol isTerminal ifTrue: [^self].

	rest := aLR1Item rest.

	first := rest firstTerminals.

	followers := SmaCCSymbolSet new.

	(first includes: SmaCCSymbol empty) 

		ifTrue: 

			[first remove: SmaCCSymbol empty.

			followers baseOn: aLR1Item followers].

	followers addAll: first.

	nextSymbol productionsDo: 

			[:each | 

			self add: (SmaCCLR1Item 

						symbol: nextSymbol

						rhs: each

						follow: followers)]

! !

!SmaCCItemSet methodsFor:'public'!

isLALREqualTo: anItemSet 

	^anItemSet size = self size 

		and: [self allSatisfy: [:each | anItemSet includes: each]]

!

isLREqualTo: anItemSet 

	^anItemSet size = self size and: 

			[self allSatisfy: 

					[:each | 

					| item |

					(item := anItemSet itemFor: each) notNil and: [each isLR1EqualTo: item]]]

! !

!SmaCCItemSet class methodsFor:'documentation'!

version

    ^ '$Header: /opt/data/cvs/stx/goodies/smaCC/SmaCC__SmaCCItemSet.st,v 1.2 2008-02-17 10:30:37 vranyj1 Exp $'

!

version_SVN

    ^ '$Id$'

! !