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

"{ NameSpace: Smalltalk }"

PPCNodeVisitor subclass:#PPCCodeGenerator

	instanceVariableNames:'compiler'

	classVariableNames:''

	poolDictionaries:''

	category:'PetitCompiler-Visitors'

!

!PPCCodeGenerator class methodsFor:'as yet unclassified'!

new

    ^ self basicNew

        initialize;

        yourself 

!

on: aPPCCompiler

    ^ self new 

        compiler: aPPCCompiler;

        yourself

! !

!PPCCodeGenerator methodsFor:'accessing'!

compiler: aPPCCompiler

    compiler := aPPCCompiler 

!

guards

    ^ arguments guards

! !

!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'!

compileTokenWhitespace: node

    compiler add: 'context atWs ifFalse: ['.

    compiler indent.

        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

    | blockId |

    blockId := 'block_', (compiler idFor: node).

    compiler addConstant: node block as: blockId.

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

    compiler add: 'error ifFalse: ['.

    compiler codeReturn: blockId, ' value: ', self retvalVar.

    compiler add: '] ifTrue: ['.

    compiler codeReturn: 'failure'.

    compiler add: '].'.

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

!

visitAndNode: node

    | mementoVar |

    mementoVar := compiler allocateTemporaryVariableNamed: 'memento'.

    compiler smartRemember: node child to: mementoVar.

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

    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 add: '(', classificationId, ' at: context peek asInteger)'.

    compiler indent.

    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 codeReturn: 'context next'.

    compiler add: '].'.

    compiler dedent.

!

visitChild: child of: node

    |  |

    (self isOpen: child) ifTrue: [ 

        "already processing..."

        ^ nil

    ].

    ^ self visit: child.

!

visitChoiceNode: node

    "The code is not ready for inlining"

    self assert: node isMarkedForInline not.

    elementVar := compiler allocateTemporaryVariableNamed: 'element'.

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

        child := node children at: idx.

        allowGuard := whitespaceConsumed.

                compiler add: 'self clearError.'.

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

        ]

    ].

    "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!!'' ].'.

!

visitEndOfInputNode: node

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

    compiler add: 'context atEnd ifTrue: ['.

    compiler codeReturn.	

    compiler add: '] ifFalse: ['.

    compiler codeError: 'End of input expected'.

    compiler add: ']'.

!

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: '].'.

!

visitMessagePredicateNode: node

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

    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 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 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

    | mementoVar |

    mementoVar := compiler allocateTemporaryVariableNamed: 'memento'.

    compiler smartRemember: node child to: mementoVar.

    compiler codeStoreValueOf: [ self visit: node child  ] intoVariable: #whatever.

    compiler smartRestore: node child from: mementoVar.

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

    "Modified: / 05-05-2015 / 14:29:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

visitOptionalNode: node

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

    compiler add: 'error ifTrue: [ '.

    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 := compiler allocateTemporaryVariableNamed:  'element'.

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

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

    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.'.