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

"{ NameSpace: Smalltalk }"

Object subclass:#PPCConfiguration
	instanceVariableNames:'context options ir history'
	classVariableNames:''
	poolDictionaries:''
	category:'PetitCompiler-Core'
!

!PPCConfiguration class methodsFor:'as yet unclassified'!

default
    ^ self universal
!

new
    ^ self basicNew
        initialize;
        yourself
!

tokenizing
    ^ PPCTokenizingConfiguration new
!

universal
    ^ PPCUniversalConfiguration new
! !

!PPCConfiguration methodsFor:'accessing'!

defaultArguments
    ^ PPCCompilationOptions default

    "Modified: / 24-08-2015 / 23:39:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

input: whatever
    ir := whatever.
    
    self remember: (self copyTree: ir) as: #input
!

ir
    ^ ir
!

ir: whatever
    ir := whatever
!

options
     				options isNil ifTrue: [ options := self defaultArguments ].
                    ^ options
!

options: args
    options := args
! !

!PPCConfiguration methodsFor:'caching'!

cacheFirstSet
    "Creates a PPCNodes from a PPParser"
    | firstSets |
    firstSets := ir firstSets.
    ir allNodesDo: [ :node |
        node firstSet: (firstSets at: node)
    ]
!

cacheFirstSetWithProductions
    "Creates a PPCNodes from a PPParser"
    | firstSets |
    firstSets := ir firstSetsSuchThat: [:e | e name isNil not ].
    ir allNodesDo: [ :node |
        node firstSetWithProductions: (firstSets at: node)
    ]
!

cacheFirstSetWithTokens
    "Creates a PPCNodes from a PPParser"
    | firstSets |
    firstSets := ir firstSetsSuchThat: [:e | e isTerminal or: [ e isTokenNode ] ].
    ir allNodesDo: [ :node |
        node firstSetWithTokens: (firstSets at: node)
    ]
!

cacheFollowSet
    "Creates a PPCNodes from a PPParser"
    | followSets |
    followSets := ir followSets.
    ir allNodesDo: [ :node |
        node followSet: (followSets at: node)
    ]
!

cacheFollowSetWithTokens
    "Creates a PPCNodes from a PPParser"
    | followSets |
    followSets := ir followSetsSuchThat: [:e | e isTerminal or: [ e isTokenNode ] ].
    ir allNodesDo: [ :node |
        node followSetWithTokens: (followSets at: node)
    ]
! !

!PPCConfiguration methodsFor:'compiling'!

compile: whatever
    | time |
    self input: whatever.
    
    time := [ self invokePhases ] timeToRun.
    ((Smalltalk respondsTo:#isSmalltalkX) and:[Smalltalk isSmalltalkX]) ifFalse:[ 
        "Assume Pharo"
        time := time asMilliSeconds.
    ].
    self reportTime: time.
    
    ^ ir

    "Modified: / 17-08-2015 / 13:06:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

invokePhases
    self subclassResponsibility
! !

!PPCConfiguration methodsFor:'debugging'!

copy: somethingTransformable
    self deprecated: 'copy on your own, or whatever, but dont use me'.
    ^ somethingTransformable transform: [ :e | e copy ]
!

copyTree: somethingTransformable
    ^ somethingTransformable transform: [ :e | e copy ]
!

remember: key
    self deprecated: 'use remember:as:'.
    
    self options debug ifTrue: [ 
        history add: key -> (self copy: ir).
    ]
!

remember: value as: key
    self options debug ifTrue: [ 
        history add: key -> value.
    ]
! !

!PPCConfiguration methodsFor:'initialization'!

initialize
    history := OrderedCollection new.
    context := PPCCompilationContext new.
    options := PPCCompilationOptions default.

    "Modified: / 25-08-2015 / 00:02:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!PPCConfiguration methodsFor:'phases'!

cacheFirstFollow
    options cacheFirstFollow ifFalse: [ ^ self ] .
    
    self cacheFirstSet.
    self cacheFollowSet.
    self cacheFirstSetWithTokens.
    self cacheFollowSetWithTokens.
!

check
    ir checkTree 
!

createRecognizingComponents
    options recognizingComponents ifFalse: [ ^ self ] .
    
    ir :=  PPCRecognizerComponentDetector new
        options: options;
        visit: ir.

    self remember: (self copyTree: ir) as: #recognizingComponents
!

createTokens
    options detectTokens ifFalse: [ ^ self ] .
    
    ir :=  PPCTokenDetector new
        options: options;
        visit: ir.

    self remember: (self copyTree: ir) as: #createTokens
!

inline
    options inline ifFalse: [ ^ self ].
    
    ir := PPCInliningVisitor new
        options: options;
        visit: ir.
        
    self remember: (self copyTree: ir) as: #inline.
!

merge
    "Merge equivalent nodes under one object with single identity"
    options merge ifFalse: [ ^ self ].
    
    ir :=  PPCMergingVisitor new
        options: options;
        visit: ir.
        
    self remember: (self copyTree: ir) as: #merge
!

specialize
    options specialize ifFalse: [ ^ self ].

    " 
        Invokes a visitor that creates specialized nodes
        for some patterns of PPCNodes, 
        
        e.g. $a astar can be represented by PPCCharacterStarNode
    "
    ir :=  (PPCSpecializingVisitor new
        options: options;
        visit: ir).
        
    self remember: (self copyTree: ir) as: #specialize
!

toPPCIr
    "Creates a PPCNodes from a PPParser"
    ir := ir asCompilerTree.
    
    self remember: (self copyTree: ir) as: #ppcNodes
! !

!PPCConfiguration methodsFor:'reporting'!

reportTime: timeInMs
    options profile ifTrue: [ 
        Transcript show: 'Time to compile: ', timeInMs asString, ' ms'; cr.
    ]
! !