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

"{ NameSpace: Smalltalk }"

Object subclass:#PPCConfiguration

	instanceVariableNames:'context 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

! !

!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:'error handling'!

options

    ^ context options

    "Modified: / 26-08-2015 / 19:48:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

options: aPPCCompilationOptions

    context options: aPPCCompilationOptions

    "Created: / 26-08-2015 / 19:56:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!PPCConfiguration methodsFor:'initialization'!

initialize

    history := OrderedCollection new.

    context := PPCCompilationContext new.

    "Modified: / 26-08-2015 / 19:49:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!PPCConfiguration methodsFor:'phases'!

cacheFirstFollow

    context options cacheFirstFollow ifFalse:[

        ^ self

    ].

    self cacheFirstSet.

    self cacheFollowSet.

    self cacheFirstSetWithTokens.

    self cacheFollowSetWithTokens.

!

check

    ir checkTree 

!

createRecognizingComponents

    context options recognizingComponents ifFalse:[

        ^ self

    ].

!

createTokens

    context options detectTokens ifFalse:[

        ^ self

    ].

!

inline

    context options inline ifFalse:[

        ^ self

    ].

!

merge

    "Merge equivalent nodes under one object with single identity"

    context options merge ifFalse:[

        ^ self

    ].

!

specialize

    context 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

    "

!

toPPCIr

    "Creates a PPCNodes from a PPParser"

    ir := ir asCompilerTree.

    self remember: (self copyTree: ir) as: #ppcNodes

! !

!PPCConfiguration methodsFor:'reporting'!

reportTime: timeInMs

    context options profile ifTrue: [ 

        Transcript show: 'Time to compile: ', timeInMs asString, ' ms'; cr.

    ]

    "Modified: / 26-08-2015 / 16:35:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !