"{ Package: 'stx:goodies/petitparser/compiler' }"

"{ NameSpace: Smalltalk }"

PPCNodeVisitor subclass:#PPCCodeGenerator

	instanceVariableNames:'compiler'

	classVariableNames:''

	poolDictionaries:''

	category:'PetitCompiler-Visitors'

!

!PPCCodeGenerator class methodsFor:'as yet unclassified'!

on: aPPCCompiler

	^ self new 

		compiler: aPPCCompiler;

		yourself

! !

!PPCCodeGenerator methodsFor:'accessing'!

compiler: aPPCCompiler

	compiler := aPPCCompiler 

! !

!PPCCodeGenerator methodsFor:'hooks'!

afterAccept: node retval: retval

	"return the method from compiler"

	^ self stopMethodForNode: node.

!

beforeAccept: node

	self startMethodForNode: node

!

closedDetected: node

	^ node isMarkedForInline ifFalse: [ 

		self error: 'Should not happen!!'

	]

!

openDetected: node

	^ compiler checkCache: (compiler idFor: node)

! !

!PPCCodeGenerator methodsFor:'support'!

addGuard: node

	|  guard firsts id |

	(arguments guards not or: [(guard := PPCGuard on: node) makesSense not]) ifTrue: [ ^ self].

	id := compiler idFor: node.

	firsts := (node firstSetSuchThat: [ :e | (e isKindOf: PPCTrimmingTokenNode) or: [ e isTerminal ] ]).

	(firsts allSatisfy: [ :e | e isKindOf: PPCTrimmingTokenNode ]) ifTrue: [  

		"If we start with trimming, we should invoke the whitespace parser"

		self compileTokenWhitespace: firsts anyOne.

		compiler add: 'context atEnd ifTrue: [ ^ self error ].'.

		guard id: id, '_guard'.

		guard compileGuard: compiler.

		compiler addOnLine: 'ifFalse: [ ^ self error ].'

	].

	(firsts allSatisfy: [ :e | e isTerminal ]) ifTrue: [  

		compiler add: 'context atEnd ifTrue: [ ^ self error ].'.

		guard id: id, '_guard'.

		guard compileGuard: compiler.

		compiler addOnLine: 'ifFalse: [ ^ self error ].'

	].

!

compileTokenWhitespace: node

	compiler add: 'context atWs ifFalse: ['.

	compiler indent.

		compiler call: (self visit: node whitespace).

		compiler add: 'context setWs.'.

	compiler dedent.

	compiler add: '].'.

!

notCharSetPredicateBody: node

	| classificationId  classification |

	self error: 'deprecated.'.

	classification := node extendClassification: node predicate classification.

	classificationId := (compiler idFor: classification prefixed: #classification).

	compiler  addConstant: classification as: classificationId.

	compiler addOnLine: '(', classificationId, ' at: context peek asInteger)'.

	compiler indent.

	compiler add: ' ifTrue: [ self error: '' predicate not expected'' ]'.

	compiler add: ' ifFalse: [ nil ].'.

	compiler dedent.

!

notMessagePredicateBody: node

	self error: 'deprecated'.

	compiler addOnLine: '(context peek ', node message, ')'.

	compiler indent.

	compiler add: ' ifTrue: [ self error: '' predicate not expected'' ]'.

	compiler add: ' ifFalse: [ nil ].'.

	compiler dedent.

!

predicateBody: node

	| tmpId |

	self error:'deprecated'.

	tmpId := (compiler idFor: node predicate prefixed: #predicate).

	compiler addConstant: node predicate as: tmpId.

	compiler addOnLine: '(context atEnd not and: [ ', tmpId , ' value: context uncheckedPeek])'.

	compiler indent.

	compiler add: 'ifFalse: [ self error: ''predicate not found'' ]'.

	compiler add: 'ifTrue: [ context next ].'.

	compiler dedent.	

!

retvalVar

	^ compiler currentReturnVariable 

!

startMethodForNode:node

    node isMarkedForInline ifTrue:[ 

		compiler startInline: (compiler idFor: node).

		compiler addComment: 'BEGIN inlined code of ' , node printString.

		compiler indent.

    ] ifFalse:[ 

		compiler startMethod: (compiler idFor: node).

		compiler addComment: 'GENERATED by ' , node printString.

		compiler allocateReturnVariable.

    ].

    "Created: / 23-04-2015 / 15:51:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 23-04-2015 / 19:13:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified (comment): / 23-04-2015 / 21:31:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

stopMethodForNode:aPPCNode

    ^ aPPCNode isMarkedForInline ifTrue:[ 

		compiler dedent.

		compiler add: '"END inlined code of ' , aPPCNode printString , '"'.

		compiler stopInline.

    ] ifFalse:[ 

		compiler stopMethod

    ].

    "Created: / 23-04-2015 / 15:51:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 23-04-2015 / 18:35:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!PPCCodeGenerator methodsFor:'traversing - caching'!

cache: node value: retval

	"this is compiler thing, not mine"

!

cachedDetected: node

	^ compiler checkCache: (compiler idFor: node)

!

isCached: node

	^ (compiler checkCache: (compiler idFor: node)) isNil not

! !

!PPCCodeGenerator methodsFor:'visiting'!

visitActionNode: node

	compiler addConstant: node block as: (compiler idFor: node).

	compiler addVariable: 'element'.

	compiler add: 'element := '.

	compiler callOnLine: (self visit: node child).

	compiler add: 'error ifFalse: [ ^ ',  (compiler idFor: node), ' value: element ].'.

	compiler add: '^ failure'.

    "Modified: / 23-04-2015 / 15:59:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

visitAndNode: node

	| mementoVar |

	mementoVar := compiler allocateTemporaryVariableNamed: 'memento'.

	compiler add: (compiler smartRemember: node child to: mementoVar).

	compiler codeStoreValueOf: [ self visit: node child  ] intoVariable: self retvalVar.

	compiler add: (compiler smartRestore: node child from: mementoVar).

	compiler codeReturn.

    "Modified: / 23-04-2015 / 15:59:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

visitAnyNode: node

	compiler codeReturn: 'context next ifNil: [ error := true. ].'.

    "Modified: / 23-04-2015 / 20:52:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

visitCharSetPredicateNode: node

	| classification classificationId |

	classification := node extendClassification: node predicate classification.

	classificationId := compiler idFor: classification prefixed: #classification.

	compiler addConstant: classification as: classificationId.

	compiler addOnLine: '(', classificationId, ' at: context peek asInteger)'.

	compiler indent.

	compiler add: 'ifFalse: [ self error: ''predicate not found'' ]'.

	compiler add: 'ifTrue: [ '.

	compiler codeReturn: 'context next'.

	compiler add: '].'.

	compiler dedent.

!

visitCharacterNode: node

	| chid |

	node character ppcPrintable ifTrue: [ 

		chid := node character storeString 

	] ifFalse: [ 

		chid := compiler idFor: node character prefixed: #char.

		compiler addConstant: (Character value: node character asInteger) as: chid .

	].

	compiler add: '(context peek == ', chid, ')'.

	compiler indent.

	compiler add: 'ifFalse: [ self error: ''', node character asInteger asString, ' expected'' at: context position ] '.

	compiler add: 'ifTrue: [ '.

	compiler codeReturn: 'context next'.

	compiler add: '].'.

	compiler dedent.

!

visitChild: child of: node

	|  |

	(self isOpen: child) ifTrue: [ 

		"already processing..."

		^ nil

	].

	"TODO JK: this is is wrong,.. to tired now to fix this :("

"	(self isCached: child) ifTrue: [ 

		node replace: child with: (self cachedValue: child).

		^ nil

	]. 

"

	^ self visit: child.

!

visitChoiceNode: node

	| firsts guard whitespaceConsumed |

	whitespaceConsumed := false.

	firsts := (node firstSetSuchThat: [ :e | (e isKindOf: PPCTrimmingTokenNode) or: [ e isTerminal ] ]).

	compiler addVariable: 'element'.

	"If we start with trimming token, we should invoke the whitespace parser"

	(firsts allSatisfy: [ :e | e isKindOf: PPCTrimmingTokenNode ]) ifTrue: [  

		self compileTokenWhitespace: firsts anyOne.

		whitespaceConsumed := true.

	].

	1 to: node children size do: [ :idx  | |child allowGuard |

		child := node children at: idx.

"               allowGuard := ((child isKindOf: PPCTrimmingTokenNode) and: [ whitespaceConsumed not ]) not.

"       

		allowGuard := whitespaceConsumed.

		(allowGuard and: [arguments guards and: [ (guard := PPCGuard on: child) makesSense ]]) ifTrue: [         

			guard id: (compiler idFor: guard prefixed: #guard).

			guard compileGuard: compiler.

			compiler add: ' ifTrue: [ '.

			compiler indent.

				compiler add: 'self clearError.'.

				compiler codeStoreValueOf:  [self visit: child] intoVariable: 'element'.

				compiler add: 'error ifFalse: [ ^ element ].'.

			compiler dedent.

			compiler add: ' ].'.

		] ifFalse: [

			compiler add: 'self clearError.'.

			compiler codeStoreValueOf:  [self visit: child] intoVariable: 'element'.

			compiler add: 'error ifFalse: [ ^ element ].'.

		]

	].

	compiler add: '^ self error: ''no choice suitable'''.

    "Modified: / 23-04-2015 / 21:40:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

visitEndOfFileNode: node

	compiler codeReturn: 'context atEnd ifTrue: [ #EOF ] ifFalse: [ self error: ''EOF expected!!'' ].'.

!

visitForwardNode: node

	compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar.

	compiler codeReturn.

!

visitLiteralNode: node

	| positionVar encodedLiteral |

	encodedLiteral := node encodeQuotes: node literal.

	positionVar := compiler allocateTemporaryVariableNamed: 'position'.

	compiler codeAssign: 'context position.' to: positionVar.

	compiler add: '((context next: ', node literal size asString, ') = #''', encodedLiteral, ''') ifTrue: ['.

	compiler codeReturn: '#''', encodedLiteral, ''' '.

	compiler add: '] ifFalse: ['.

	compiler add: '  context position: ', positionVar, '.'.

	compiler add: '  self error: ''', encodedLiteral,  ' expected'' at: position'.

	compiler add: '].'.

!

visitMessagePredicateNode: node

	compiler add: '(context peek ', node message, ') ifFalse: ['.

	compiler add: '  self error: ''predicate not found'''.

	compiler add: '] ifTrue: [ '.

	compiler codeReturn: ' context next'.

	compiler add: '].'.

    "Modified: / 23-04-2015 / 18:39:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

visitNilNode: node

	compiler codeReturn: 'nil.'.

!

visitNotCharSetPredicateNode: node

	| classificationId  classification |

	classification := node extendClassification: node predicate classification.

	classificationId := (compiler idFor: classification prefixed: #classification).

	compiler  addConstant: classification as: classificationId.

	compiler addOnLine: '(', classificationId, ' at: context peek asInteger)'.

	compiler indent.

	compiler add: ' ifTrue: [ self error: '' predicate not expected'' ]'.

	compiler add: ' ifFalse: ['.

	compiler codeReturn: 'nil'.

	compiler add: '].'.

	compiler dedent.

!

visitNotLiteralNode: node

	| encodedLiteral size |

	encodedLiteral := node encodeQuotes: node literal.

	size := node literal size asString.

	compiler add: '((context peek: ', size, ') =#''', encodedLiteral, ''')'.

	compiler indent.

	compiler add: 'ifTrue: [ self error: ''', encodedLiteral, ' not expected'' ]'.

	compiler add: 'ifFalse: [ '.

	compiler codeReturn: 'nil' .

	compiler add: '].'.

	compiler dedent.

!

visitNotMessagePredicateNode: node

	compiler addOnLine: '(context peek ', node message, ')'.

	compiler indent.

	compiler add: ' ifTrue: [ '.

	compiler codeError: 'predicate not expected'.

	compiler add: '] ifFalse: ['.

	compiler codeReturn: 'nil'.

	compiler add: ' ].'.

	compiler dedent. 

!

visitNotNode: node

	compiler addVariable: 'memento'.

	compiler add: (compiler smartRemember: node child).

	compiler call: (self visit: node child).

	compiler add: (compiler smartRestore: node child).

	compiler add: '^ error ifFalse: [ self error ] ifTrue: [ self clearError. nil ]'.

!

visitOptionalNode: node

	compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar.

	compiler add: 'error ifTrue: [ '.

	compiler add: '  self clearError. '.

	compiler codeAssign: 'nil.' to: self retvalVar.

	compiler add: '].'.

	compiler codeReturn.

!

visitPluggableNode: node

	| blockId |

	blockId := compiler idFor: node block prefixed: #block.

	compiler addConstant: node block as: blockId.

	compiler codeReturn: blockId, ' value: context.'.

!

visitPlusNode: node

	| elementVar |

	elementVar := compiler allocateTemporaryVariableNamed:  'element'.

	compiler codeAssign: 'OrderedCollection new.' to: self retvalVar.

	compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar.

	compiler add: 'error ifTrue: [ self error: ''at least one occurence expected'' ] ifFalse: ['.

	compiler indent.

	    compiler add: self retvalVar , ' add: ',elementVar , '.'.

	    compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar.

	    compiler add: '[ error ] whileFalse: ['.

	    compiler indent.

	    compiler add: self retvalVar , ' add: ',elementVar , '.'.

	    compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar.

	    compiler dedent.

	    compiler add: '].'.

	    compiler add: 'self clearError.'.

	    compiler codeReturn: self retvalVar , ' asArray.'.         

	compiler dedent.

	compiler add: '].'.

    "Modified (comment): / 23-04-2015 / 21:30:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

visitPredicateNode: node

	| pid |

	pid := (compiler idFor: node predicate prefixed: #predicate).

	compiler addConstant: node predicate as: pid.

	compiler add: '(context atEnd not and: [ ', pid , ' value: context uncheckedPeek])'.

	compiler indent.

	compiler add: 'ifFalse: [ self error: ''predicate not found'' ]'.

	compiler add: 'ifTrue: [ ', self retvalVar ,' := context next ].'.

	compiler dedent.   

	compiler codeReturn.

    "Modified: / 23-04-2015 / 21:48:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

visitSequenceNode: node

	| elementVar mementoVar |

	elementVar := compiler allocateTemporaryVariableNamed: 'element'.

	mementoVar := compiler allocateTemporaryVariableNamed: 'memento'.

	compiler add: (compiler smartRemember: node to: mementoVar).

	compiler codeAssign: 'Array new: ', node children size asString, '.' to: self retvalVar.

	self addGuard: node.

	1 to: (node children size) do: [ :idx  | |child|

		child := node children at: idx.

		compiler codeStoreValueOf: [ self visit: child ]  intoVariable: elementVar.

		compiler add: 'error ifTrue: [ ', (compiler smartRestore: node) ,' ^ failure ].'.

		compiler add: self retvalVar , ' at: ', idx asString, ' put: ',elementVar,'.'.

	].

	compiler codeReturn

    "Modified: / 23-04-2015 / 22:03:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

visitStarAnyNode: node

	compiler addVariable: 'retval size'.

	compiler add: 'size := context size - context position.'.

	compiler add: 'retval := Array new: size.'.

	compiler add: '(1 to: size) do: [ :e | retval at: e put: context next ].'.

	compiler add: '^ retval'.

!

visitStarCharSetPredicateNode: node

	| classification classificationId |

	classification := node extendClassification: node predicate classification.

	classificationId := compiler idFor: classification prefixed: #classification.

	compiler addConstant: classification as: classificationId.

	compiler codeAssign: 'OrderedCollection new.' to: self retvalVar.	

	compiler add: '[ ', classificationId, ' at: context peek asInteger ] whileTrue: ['.

	compiler indent.

	compiler add: self retvalVar, ' add: context next.'.

	compiler dedent.

	compiler add: '].'.

   compiler codeReturn: 'retval asArray'.

!

visitStarMessagePredicateNode: node

	compiler codeAssign: 'OrderedCollection new.' to: self retvalVar.	

	compiler add: '[ context peek ', node message, ' ] whileTrue: ['.

	compiler indent.

	compiler add: self retvalVar, ' add: context next.'.

	compiler dedent.

	compiler add: '].'.

   compiler codeReturn: 'retval asArray'.

!

visitStarNode: node

	| elementVar |

	elementVar := compiler allocateTemporaryVariableNamed: 'element'.

	compiler codeAssign: 'OrderedCollection new.' to: self retvalVar.

	compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar.

	compiler add: '[ error ] whileFalse: ['.

	compiler indent.

	compiler add: self retvalVar, ' add: element.'.

	compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar.

	compiler dedent.

	compiler add: '].'.

	compiler codeClearError.

	compiler codeReturn: self retvalVar, ' asArray'.

!

visitSymbolActionNode: node

	| elementVar |

	elementVar := compiler allocateTemporaryVariableNamed: 'element'.	

	compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar.