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

"{ NameSpace: Smalltalk }"

Object subclass:#PPCASTUtilities
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	category:'PetitCompiler-Support'
!

!PPCASTUtilities methodsFor:'checks'!

checkNodeIsFunctional: anRBBlockNode inClass: aClaas
    "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.
    "
    | allDefinedVarNames allInstVarNames allClassVarNames cls |

    allDefinedVarNames := anRBBlockNode allDefinedVariables.
    allInstVarNames := Set new.
    allClassVarNames := Set new.
    cls := aClaas.
    [ cls notNil ] whileTrue:[ 
        | instanceVariables classVariables |
                
        instanceVariables := cls instanceVariables.
        classVariables := cls classVariables.
        instanceVariables notNil ifTrue:[
            allInstVarNames addAll: instanceVariables.
        ]. 
        classVariables notNil ifTrue:[
            allClassVarNames addAll: classVariables.
        ].
        cls := cls superclass.
    ].

    self withAllVariableNodesOf: anRBBlockNode  do: [ :node | 
        (allDefinedVarNames includes: node name) ifFalse:[ 
            (allInstVarNames includes: node name) ifTrue:[
                PPCCompilationError new signalWith: 'code refers to an instance variable named `',node name,'`'.
                ^ self.
            ].
            (allClassVarNames includes: node name) ifTrue:[
                PPCCompilationError new signalWith: 'code refers to a class variable named `',node name,'`'.
                ^ self.
            ].
            (Smalltalk includesKey: node name asSymbol) ifFalse:[ 
                PPCCompilationError new signalWith: 'code refers to an unknown variable named `',node name,'`'.
                ^ self.                    
            ].
        ]
    ].
    self withAllMessageNodesOf: anRBBlockNode sentToSelfDo:[:node |
        | method |
        
        method := aClaas lookupSelector: node selector.
        method isNil ifTrue:[
            PPCCompilationError new signalWith: 'code contains self-send to non-existent method'.        
            ^ self
        ].
        self checkNodeIsFunctional: method parseTree inClass: method methodClass.
    ].      
    self withAllSuperNodesOf: anRBBlockNode do: [ :node | 
        PPCCompilationError new signalWith: 'code contains a super-send'.
        ^ self
    ].

    "Created: / 27-07-2015 / 12:15:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 27-07-2015 / 14:43:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!PPCASTUtilities methodsFor:'enumerating'!

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

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

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

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

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

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