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 " "Modified: / 08-09-2015 / 02:48:55 / Jan Vrany " ] { #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 " "Modified (comment): / 27-07-2015 / 11:26:29 / Jan Vrany " ] { #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 " ] { #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 " "Modified (comment): / 27-07-2015 / 11:26:46 / Jan Vrany " ] { #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 " "Modified (comment): / 27-07-2015 / 11:26:52 / Jan Vrany " ] { #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 " ] { #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 " "Modified (comment): / 27-07-2015 / 11:27:00 / Jan Vrany " ]