hg/stx-goodies-petitparser: comparison compiler/PPCCodeGenerator.st

equal deleted inserted replaced

-:1e45d3c96ec5
+:b5316ef15274
 falseBlock value.
 compiler dedent.
 compiler addOnLine: '].'.
 ]."
-guard id: (compiler idFor: guard prefixed: #guard).
+guard id: (compiler idFor: guard defaultName: #guard).
 guard compileGuard: compiler.
 trueBlock isNil ifFalse: [
 compiler addOnLine: ' ifTrue: ['.
 compiler indent.
 ^ compiler checkCache: (compiler idFor: node)
 ! !
 !PPCCodeGenerator methodsFor:'private'!
+checkBlockIsInlinable: block
+"Check whether the given block could be inlined. If not,
+throw an error. If yes, this method is noop.
+A block is inlineable if and only if it's a purely functional
+(see PPCASTUtilities>>checkBlockIsPurelyFunctional:inClass: for
+details)
+As a side-effect, copy all self-sent methods from the block
+to the target class.
+"
+| blockNode |
+blockNode := block sourceNode.
+"In Smalltalk implementation which use cheap-block optimization (Smalltalk/X) it may
+happen that home context of the block is nil (in case of cheap blocks)"
+block home notNil ifTrue:[
+| blockClass |
+blockClass := block home receiver class.
+PPCASTUtilities new checkNodeIsFunctional: blockNode inClass: blockClass.
+"The above code should raise an error when block is not functional (i.e., when not
+inlineable, so if the control flow reach this point, block is OK and we can safely
+copy self-sent methods."
+self copySelfSentMethodsOf: blockNode inClass: blockClass
+].
+"Created: / 27-07-2015 / 14:40:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+"Modified: / 27-07-2015 / 15:52:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+copySelfSentMethodsOf: anRBProgramNode inClass: aClass
+PPCASTUtilities new withAllMessageNodesOf: anRBProgramNode sentToSelfDo: [ :node|
+| method source |
+method := aClass lookupSelector: node selector.
+method isNil ifTrue:[
+PPCCompilationError new signalWith: 'oops, no method found (internal error)!!'.
+].
+source := method source.
+source isNil ifTrue:[
+PPCCompilationError new signalWith: 'unavailable source for method ', method printString ,'!!'.
+].
+"Following actually copies the method to the target class,
+though the APU is not nice. This has to be cleaned up"
+(compiler cachedValue: node selector) isNil ifTrue:[
+compiler cache: node selector as: (PPCMethod new id: node selector; source: source; yourself).
+"Now compile self-sends of the just copied method"
+self copySelfSentMethodsOf: method parseTree inClass: aClass
+].
+]
+"Created: / 27-07-2015 / 14:50:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
 withAllVariableNodesOf: anRBProgramNode do: aBlock
 "Enumerate all chilren of `anRBProgramNode` (including itself)
 and evaluate `aBlock` for each variable node.
 This is a replacement for Smalltalk/X's RBProgramNode>>variableNodesDo:
 which is not present in Pharo"
 notCharSetPredicateBody: node
 | classificationId  classification |
 self error: 'deprecated.'.
 classification := node extendClassification: node predicate classification.
-classificationId := (compiler idFor: classification prefixed: #classification).
+classificationId := (compiler idFor: classification defaultName: #classification).
 compiler  addConstant: classification as: classificationId.
 compiler addOnLine: '(', classificationId, ' at: context peek asInteger)'.
 compiler indent.
 compiler add: ' ifTrue: [ self error: '' predicate not expected'' ]'.
 !
 startMethodForNode:node
 node isMarkedForInline ifTrue:[
 compiler startInline: (compiler idFor: node).
-compiler addComment: 'BEGIN inlined code of ' , node printString.
+compiler codeComment: 'BEGIN inlined code of ' , node printString.
 compiler indent.
 ] ifFalse:[
 compiler startMethod: (compiler idFor: node).
-compiler addComment: 'GENERATED by ' , node printString.
+compiler codeComment: '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>"
 !PPCCodeGenerator methodsFor:'visiting'!
 visitActionNode: node
 | blockNode blockBody blockNodesVar blockNeedsCollection blockMatches childValueVars |
+self checkBlockIsInlinable: node block.
 blockNode := node block sourceNode copy.
 self assert: blockNode arguments size == 1.
 blockNodesVar := blockNode arguments first .
 blockBody := blockNode body.
 blockNeedsCollection := true.
 node child isSequenceNode ifTrue:[
 blockNeedsCollection := false.
 blockMatches := IdentityDictionary new."Must use IDENTITY dict as nodes have overwritten their #=!!!!!!"
 childValueVars := node child preferredChildrenVariableNames.
-self withAllVariableNodesOf: blockBody do:[:variableNode|
+PPCASTUtilities new withAllVariableNodesOf: blockBody do:[:variableNode|
 variableNode name = blockNodesVar name ifTrue:[
 "Check if variable node matches..."
 variableNode parent isMessage ifTrue:[
 | parent |
 ].
 blockNeedsCollection ifTrue:[
 "Bad, we have to use the collection.
 Replace all references to blockNodeVar to retvalVar..."
-self withAllVariableNodesOf: blockBody do:[:variableNode|
+PPCASTUtilities new withAllVariableNodesOf: blockBody do:[:variableNode|
 variableNode name = blockNodesVar name ifTrue:[
 variableNode name: self retvalVar.
 ].
 ].
 ] ifFalse:[
 compiler codeReturn: 'failure'.
 ] else: [
 compiler code: blockBody.
 ]
-"Modified: / 19-06-2015 / 07:05:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+"Modified: / 27-07-2015 / 15:49:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 visitAndNode: node
 | mementoVar |
 visitCharSetPredicateNode: node
 | classification classificationId |
 classification := node extendClassification: node predicate classification.
-classificationId := compiler idFor: classification prefixed: #classification.
+classificationId := compiler idFor: classification defaultName: #classification.
 compiler addConstant: classification as: classificationId.
 compiler add: '(', classificationId, ' at: context peek asInteger)'.
 compiler indent.
 compiler add: 'ifFalse: ['.
 visitCharacterNode: node
 | chid |
 node character ppcPrintable ifTrue: [
 chid := node character storeString
 ] ifFalse: [
-chid := compiler idFor: node character prefixed: #char.
+chid := compiler idFor: node character defaultName: #char.
 compiler addConstant: (Character value: node character asInteger) as: chid .
 ].
 compiler add: '(context peek == ', chid, ')'.
 compiler indent.
 !
 visitMappedActionNode: node
 | child blockNode blockBody |
+self checkBlockIsInlinable: node block.
 child := node child.
 blockNode := node block sourceNode copy.
 blockBody := blockNode body.
 "Block return value is return value of last statement.
 In the block, replace all references to block argument to
 my retvalVar. "
 | blockArg |
 blockArg := blockNode arguments first.
-self withAllVariableNodesOf: blockBody do:[:variableNode|
+PPCASTUtilities new withAllVariableNodesOf: blockBody do:[:variableNode|
 variableNode name = blockArg name ifTrue:[
 variableNode name: self retvalVar.
 ].
 ].
 ].
 ].
 compiler code: blockBody.
 ]
 "Created: / 02-06-2015 / 17:28:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-"Modified: / 19-06-2015 / 07:06:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+"Modified: / 27-07-2015 / 15:49:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 visitMessagePredicateNode: node
 compiler add: '(context peek ', node message, ') ifFalse: ['.
 compiler codeError: 'predicate not found'.
 !
 visitNotCharSetPredicateNode: node
 | classificationId  classification |
 classification := node extendClassification: node predicate classification.
-classificationId := (compiler idFor: classification prefixed: #classification).
+classificationId := (compiler idFor: classification defaultName: #classification).
 compiler  addConstant: classification as: classificationId.
 compiler addOnLine: '(', classificationId, ' at: context peek asInteger)'.
 compiler indent.
 compiler add: ' ifTrue: ['.
 visitNotCharacterNode: node
 | chid |
 node character ppcPrintable ifTrue: [
 chid := node character storeString
 ] ifFalse: [
-chid := compiler idFor: node character prefixed: #char.
+chid := compiler idFor: node character defaultName: #char.
 compiler addConstant: (Character value: node character asInteger) as: chid .
 ].
 compiler add: '(context peek == ', chid, ')'.
 compiler indent.
 compiler codeReturn.
 !
 visitPluggableNode: node
 | blockId |
-blockId := compiler idFor: node block prefixed: #block.
+blockId := compiler idFor: node block defaultName: #pluggableBlock.
 compiler addConstant: node block as: blockId.
 compiler codeReturn: blockId, ' value: context.'.
 !
 "Modified: / 26-05-2015 / 19:04:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 visitPredicateNode: node
 | pid |
-pid := (compiler idFor: node predicate prefixed: #predicate).
+pid := (compiler idFor: node predicate defaultName: #predicate).
 compiler addConstant: node predicate as: pid.
 compiler add: '(context atEnd not and: [ ', pid , ' value: context uncheckedPeek])'.
 compiler indent.
 visitStarCharSetPredicateNode: node
 | classification classificationId |
 classification := node extendClassification: node predicate classification.
-classificationId := compiler idFor: classification prefixed: #classification.
+classificationId := compiler idFor: classification defaultName: #classification.
 compiler addConstant: classification as: classificationId.
 compiler codeAssign: 'OrderedCollection new.' to: self retvalVar.
 compiler add: '[ ', classificationId, ' at: context peek asInteger ] whileTrue: ['.
 compiler indent.
 elementVar := compiler allocateTemporaryVariableNamed: 'element'.
 self addGuard: node child ifTrue: nil ifFalse: [ compiler codeReturn: '#()' ].
-compiler codeAssign: 'OrderedCollection new.' to: self retvalVar.
 compiler codeAssignParsedValueOf:[ self visit:node child ] to:elementVar.
+compiler codeIf: 'error'
+then: [
+compiler codeClearError.
+compiler codeReturn: '#()'.
+] else: [
+compiler codeAssign: 'OrderedCollection new.' to: self retvalVar.
+].
 compiler add: '[ error ] whileFalse: ['.
 compiler indent.
 compiler add: self retvalVar, ' add: ', elementVar, '.'.
 compiler codeAssignParsedValueOf:[ self visit:node child ] to:elementVar.
 compiler dedent.

changeset 515	b5316ef15274
parent 502	1e45d3c96ec5
child 516	3b81c9e53352
child 524	f6f68d32de73