197 lines
7.0 KiB
Smalltalk
197 lines
7.0 KiB
Smalltalk
Class {
|
|
#name : 'PPCASTUtilities',
|
|
#superclass : 'Object',
|
|
#category : 'PetitCompiler-Support'
|
|
}
|
|
|
|
{ #category : 'variables' }
|
|
PPCASTUtilities >> allClassVariableNames: aClass [
|
|
| variables cls |
|
|
variables := Set new.
|
|
cls := aClass.
|
|
|
|
[ cls notNil ] whileTrue:[
|
|
variables addAll: (cls isMeta ifFalse: [ cls classVariables ] ifTrue: [ #() ]).
|
|
cls := cls superclass.
|
|
].
|
|
|
|
^ variables
|
|
]
|
|
|
|
{ #category : 'variables' }
|
|
PPCASTUtilities >> allInstanceVariableNames: aClass [
|
|
| variables cls |
|
|
variables := Set new.
|
|
cls := aClass.
|
|
|
|
[ cls notNil ] whileTrue:[
|
|
" cls instanceVariables notNil ifTrue:[
|
|
" variables addAll: cls instanceVariables.
|
|
" ]. "
|
|
cls := cls superclass.
|
|
].
|
|
|
|
^ variables
|
|
]
|
|
|
|
{ #category : 'checks' }
|
|
PPCASTUtilities >> checkNodeIsFunctional: anRBNode inClass: aClass options: aPPCCompilationOptions [
|
|
"Check whether the given node is purely functional or not.
|
|
If no, raise an erorr. If not, this method is noop.
|
|
|
|
A block is purely functional if and only if:
|
|
(i) it does not refer to any instance or class variable or non-local variable
|
|
(ii) all self-sends within the block are to 'purely-functional' methods
|
|
(transitively)
|
|
(iii) contains no super-sends.
|
|
"
|
|
self checkNodeVariables: anRBNode inClass: aClass.
|
|
|
|
self withAllSuperNodesOf: anRBNode do: [ :node |
|
|
PPCCompilationError new signal: 'code not functional: contains a super-send. See https://bitbucket.org/janvrany/stx-goodies-petitparser/wiki/Limitations'.
|
|
^ self
|
|
].
|
|
|
|
self withAllMessageNodesOf: anRBNode sentToSelfDo:[:node |
|
|
| method |
|
|
|
|
method := aClass lookupSelector: node selector.
|
|
method isNil ifTrue:[
|
|
PPCCompilationError new signal: 'code not functional: contains self-send to non-existent method. See https://bitbucket.org/janvrany/stx-goodies-petitparser/wiki/Limitations'.
|
|
^ self
|
|
].
|
|
aPPCCompilationOptions allowProperties ifTrue:[
|
|
"Accessing properties are explicitly allowed"
|
|
(self propertiesSelectors includes: node selector) ifTrue:[
|
|
method methodClass == PPParser ifTrue:[
|
|
^self.
|
|
].
|
|
(method methodClass inheritsFrom: PPParser) ifTrue:[
|
|
PPCCompilationWarning new signal: 'Class ', method methodClass name, ' overrides PPParser>>', node selector storeString.
|
|
^self.
|
|
].
|
|
].
|
|
].
|
|
(anRBNode isMethod and: [ anRBNode selector = node selector ]) ifFalse: [
|
|
self checkNodeIsFunctional: method parseTree inClass: aClass options: aPPCCompilationOptions.
|
|
] "ifTrue: [ 'method is calling itself ... recursion is happening' ] "
|
|
].
|
|
|
|
|
|
"Created: / 27-07-2015 / 12:15:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
|
|
"Modified: / 08-09-2015 / 02:48:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
|
|
]
|
|
|
|
{ #category : 'checks' }
|
|
PPCASTUtilities >> checkNodeVariables: anRBNode inClass: aClass [
|
|
" does node refer to any instance or class variable or non-local variable ?"
|
|
| allDefinedVarNames allInstVarNames allClassVarNames |
|
|
|
|
allDefinedVarNames := anRBNode allDefinedVariables.
|
|
allDefinedVarNames add: 'thisContext'.
|
|
allInstVarNames := self allInstanceVariableNames: aClass.
|
|
allClassVarNames := self allClassVariableNames: aClass.
|
|
|
|
self withAllVariableNodesOf: anRBNode do: [ :node |
|
|
(allDefinedVarNames includes: node name) ifFalse:[
|
|
(allInstVarNames includes: node name) ifTrue:[
|
|
PPCCompilationError new signal: 'code not functional: refers to an instance variable named `',node name,'`. See https://bitbucket.org/janvrany/stx-goodies-petitparser/wiki/Limitations'.
|
|
^ self.
|
|
].
|
|
(allClassVarNames includes: node name) ifTrue:[
|
|
PPCCompilationError new signal: 'code not functional: refers to a class variable named `',node name,'`. See https://bitbucket.org/janvrany/stx-goodies-petitparser/wiki/Limitations'.
|
|
^ self.
|
|
].
|
|
(Smalltalk includesKey: node name asSymbol) ifFalse:[
|
|
PPCCompilationError new signal: 'code not functional: refers to an unknown variable named `',node name,'`. See https://bitbucket.org/janvrany/stx-goodies-petitparser/wiki/Limitations'.
|
|
^ self.
|
|
].
|
|
]
|
|
].
|
|
]
|
|
|
|
{ #category : 'accessing' }
|
|
PPCASTUtilities >> propertiesSelectors [
|
|
^ #(
|
|
hasProperty:
|
|
propertyAt:
|
|
propertyAt:ifAbsent:
|
|
propertyAt:ifAbsentPut:
|
|
propertyAt:put:
|
|
removeProperty:
|
|
removeProperty:ifAbsent:
|
|
)
|
|
]
|
|
|
|
{ #category : 'enumerating' }
|
|
PPCASTUtilities >> withAllMessageNodesOf: anRBProgramNode do: aBlock [
|
|
"Enumerate all chilren of `anRBProgramNode` (including itself)
|
|
and evaluate `aBlock` for each message node."
|
|
|
|
self withAllNodesOf: anRBProgramNode suchThat: [ :node | node isMessage ] do: aBlock.
|
|
|
|
"Created: / 18-06-2015 / 22:02:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
|
|
"Modified (comment): / 27-07-2015 / 11:26:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
|
|
]
|
|
|
|
{ #category : 'enumerating' }
|
|
PPCASTUtilities >> withAllMessageNodesOf: anRBProgramNode sentToSelfDo: aBlock [
|
|
"Enumerate all chilren of `anRBProgramNode` (including itself)
|
|
and evaluate `aBlock` for each message node which sends a message
|
|
to self (i.e., for self-sends)."
|
|
|
|
self withAllNodesOf: anRBProgramNode suchThat: [ :node | node isMessage and:[node receiver isSelf ] ] do: aBlock.
|
|
|
|
"Created: / 27-07-2015 / 14:41:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
|
|
]
|
|
|
|
{ #category : 'enumerating' }
|
|
PPCASTUtilities >> withAllNodesOf: node suchThat: predicate do: action [
|
|
"Enumerate all chilren of `node` (including itself)
|
|
and evaluate `aBlock` for each node for which `predicate` returns true."
|
|
|
|
(predicate value: node) ifTrue:[
|
|
action value: node.
|
|
].
|
|
node children do:[:each |
|
|
self withAllNodesOf: each suchThat: predicate do: action
|
|
].
|
|
|
|
"Created: / 18-06-2015 / 22:02:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
|
|
"Modified (comment): / 27-07-2015 / 11:26:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
|
|
]
|
|
|
|
{ #category : 'enumerating' }
|
|
PPCASTUtilities >> withAllSelfNodesOf: anRBProgramNode do: aBlock [
|
|
"Enumerate all chilren of `anRBProgramNode` (including itself)
|
|
and evaluate `aBlock` for each `self` node."
|
|
|
|
self withAllNodesOf: anRBProgramNode suchThat: [ :node | node isSelf ] do: aBlock.
|
|
|
|
"Created: / 18-06-2015 / 22:02:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
|
|
"Modified (comment): / 27-07-2015 / 11:26:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
|
|
]
|
|
|
|
{ #category : 'enumerating' }
|
|
PPCASTUtilities >> withAllSuperNodesOf: anRBProgramNode do: aBlock [
|
|
"Enumerate all chilren of `anRBProgramNode` (including itself)
|
|
and evaluate `aBlock` for each `super` node."
|
|
|
|
self withAllNodesOf: anRBProgramNode suchThat: [ :node | node isSuper ] do: aBlock.
|
|
|
|
"Created: / 27-07-2015 / 14:42:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
|
|
]
|
|
|
|
{ #category : 'enumerating' }
|
|
PPCASTUtilities >> 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"
|
|
|
|
self withAllNodesOf: anRBProgramNode suchThat: [ :node | node isVariable and:[node isSelf not and:[node isSuper not]]] do: aBlock.
|
|
|
|
"Created: / 18-06-2015 / 22:02:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
|
|
"Modified (comment): / 27-07-2015 / 11:27:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
|
|
]
|