diff -r 54b3bc9e3987 -r 20598d7ce9fa compiler/PPCCodeGenerator.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/compiler/PPCCodeGenerator.st Thu Apr 30 23:43:14 2015 +0200 @@ -0,0 +1,680 @@ +"{ 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 " + "Modified: / 23-04-2015 / 19:13:25 / Jan Vrany " + "Modified (comment): / 23-04-2015 / 21:31:24 / Jan Vrany " +! + +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 " + "Modified: / 23-04-2015 / 18:35:41 / Jan Vrany " +! ! + +!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 " +! + +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 " +! + +visitAnyNode: node + + compiler codeReturn: 'context next ifNil: [ error := true. ].'. + + "Modified: / 23-04-2015 / 20:52:15 / Jan Vrany " +! + +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 " +! + +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 " +! + +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 " +! + +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 " +! + +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 " +! + +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. + compiler add: 'error ifFalse: [ '. + compiler codeReturn: elementVar, ' ', node block asString, '.'. + compiler add: '] ifTrue: ['. + compiler codeReturn: 'failure'. + compiler add: ']'. +! + +visitTokenActionNode: node + " + Actually, do nothing, we are in Token mode and the + child does not return any result and token takes only + the input value. + " + + compiler add: '^ '. + compiler callOnLine: (node child compileWith: compiler). +! + +visitTokenNode: node + | startVar endVar | + startVar := compiler allocateTemporaryVariableNamed: 'start'. + endVar := compiler allocateTemporaryVariableNamed: 'end'. + + compiler codeAssign: 'context position + 1.' to: startVar. + compiler codeStoreValueOf: [ self visit: node child ] intoVariable: #whatever. + compiler add: 'error ifFalse: [ '. + compiler indent. + compiler codeAssign: 'context position.' to: endVar. + + compiler codeReturn: node tokenClass asString, ' on: (context collection) + start: ', startVar, ' + stop: ', endVar, ' + value: nil.'. + compiler dedent. + compiler add: '].'. +! + +visitTokenSequenceNode: node + + + compiler addVariable: 'memento'. + compiler add: (compiler smartRemember: node). + +" self addGuard: compiler." + + compiler codeStoreValueOf: [ self visit: (node children at: 1) ] intoVariable: #whatever. + compiler add: 'error ifTrue: [ ^ failure ].'. + + 2 to: (node children size) do: [ :idx | |child| + child := node children at: idx. + compiler codeStoreValueOf: [ self visit: child ] intoVariable: #whatever. + compiler add: 'error ifTrue: [ ', (compiler smartRestore: node) ,' ^ failure ].'. + ]. +! + +visitTokenStarMessagePredicateNode: node + + compiler add: '[ context peek ', node message,' ] whileTrue: ['. + compiler indent. + compiler add: 'context next'. + compiler indent. + compiler dedent. + compiler add: '].'. +! + +visitTokenStarSeparatorNode: node + + compiler add: 'context skipSeparators.'. +! + +visitTrimNode: node + | mementoVar | + "TODO: This ignores the TrimmingParser trimmer object!!" + + mementoVar := compiler allocateTemporaryVariableNamed: 'memento'. + + compiler add: (compiler smartRemember: node child to: mementoVar). + compiler add: 'context skipSeparators.'. + + compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar. + + compiler add: 'error ifTrue: [ '. + compiler indent. + compiler add: (compiler smartRestore: node child from: mementoVar). + compiler codeReturn. + compiler dedent. + compiler add: '] ifFalse: [' . + compiler indent. + compiler add: 'context skipSeparators.'. + compiler codeReturn. + compiler dedent. + compiler add: '].'. +! + +visitTrimmingTokenNode: node + | id guard startVar endVar | + + startVar := compiler allocateTemporaryVariableNamed: 'start'. + endVar := compiler allocateTemporaryVariableNamed: 'end'. + + id := compiler idFor: node. +" (id beginsWith: 'kw') ifTrue: [ self halt. ]." + "self compileFirstWhitespace: compiler." + self compileTokenWhitespace: node. + + (arguments guards and: [(guard := PPCGuard on: node) makesSense]) ifTrue: [ + compiler add: 'context atEnd ifTrue: [ ^ self error ].'. + guard id: id, '_guard'. + guard compileGuard: compiler. + compiler addOnLine: 'ifFalse: [ ^ self error ].' + ]. + + compiler codeAssign: 'context position + 1.' to: startVar. + compiler codeStoreValueOf: [ self visit: node child ] intoVariable: #whatever. + compiler add: 'error ifFalse: [ '. + compiler indent. + compiler codeAssign: 'context position.' to: endVar. + +" self compileSecondWhitespace: compiler." + self compileTokenWhitespace: node. + + compiler codeReturn: node tokenClass asString, ' on: (context collection) + start: ', startVar, ' + stop: ', endVar, ' + value: nil'. + compiler dedent. + compiler add: '].' +! + +visitUnknownNode: node + | compiledChild compiledParser id | + + id := compiler idFor: node. + + compiledParser := node parser copy. + "Compile all the children and call compiled version of them instead of the original one" + compiledParser children do: [ :child | + compiledChild := self visit: child. + compiledParser replace: child with: compiledChild bridge. + ]. + + compiler addConstant: compiledParser as: id. + + compiler codeClearError. + compiler add: '(', self retvalVar, ' := ', id, ' parseOn: context) isPetitFailure'. + compiler indent. + compiler add: ' ifTrue: [self error: retval message at: ', self retvalVar, ' position ].'. + compiler dedent. + compiler add: 'error := ', self retvalVar, ' isPetitFailure.'. + compiler codeReturn. +! ! +