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

"{ NameSpace: Smalltalk }"

Object subclass:#PPCConfiguration

	instanceVariableNames:'arguments 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'!

arguments

 				arguments isNil ifTrue: [ arguments := self defaultArguments ].

				^ arguments

!

arguments: args

    arguments := args

!

defaultArguments

 				^ PPCArguments default

!

input: whatever

    ir := whatever.

    self remember: #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'!

buildClass: compiler

    self subclassResponsibility

!

compile: whatever

    | time |

    self input: whatever.

    self reportTime: time.

    ^ ir

!

invokePhases

    self subclassResponsibility

! !

!PPCConfiguration methodsFor:'debugging'!

copy: somethingTransformable

    ^ somethingTransformable transform: [ :e | e copy ]

!

remember: key

    self arguments debug ifTrue: [ 

        history add: key -> (self copy: ir).

    ]

! !

!PPCConfiguration methodsFor:'hooks'!

codeCompiler

    ^ PPCCodeGen on: arguments 

!

codeCompilerOn: args

    ^ PPCCodeGen on: args

!

codeGeneratorVisitorOn: compiler

    ^ arguments codeGenerator on: compiler

! !

!PPCConfiguration methodsFor:'initialization'!

initialize

    history := OrderedCollection new

! !

!PPCConfiguration methodsFor:'phases'!

cacheFirstFollow

    arguments cacheFirstFollow ifFalse: [ ^ self ] .

    self cacheFirstSet.

    self cacheFollowSet.

    self cacheFirstSetWithTokens.

    self cacheFollowSetWithTokens.

!

check

    ir checkTree 

!

createRecognizingComponents

    arguments recognizingComponents ifFalse: [ ^ self ] .

    ir :=  PPCRecognizerComponentDetector new

        arguments: arguments;

        visit: ir.

    self remember: #recognizingComponents

!

createTokens

    arguments detectTokens ifFalse: [ ^ self ] .

    ir :=  PPCTokenDetector new

        arguments: arguments;

        visit: ir.

    self remember: #createTokens

!

generate

    |  compiler rootMethod compiledParser |

    arguments generate ifFalse: [ ^ self ].

    compiler := self codeCompiler.

    rootMethod := (self codeGeneratorVisitorOn: compiler)

        arguments: arguments;

        visit: ir.

    compiledParser := self buildClass: compiler.

    compiledParser startSymbol: rootMethod methodName.

    compiledParser := compiledParser new.

    ir := compiledParser.

!

inline

    arguments inline ifFalse: [ ^ self ].

    ir := PPCInliningVisitor new

        arguments: arguments;

        visit: ir.

    self remember: #inline.

!

merge

    "Merge equivalent nodes under one object with single identity"

    arguments merge ifFalse: [ ^ self ].

    ir :=  PPCMergingVisitor new

        arguments: arguments;

        visit: ir.

    self remember: #merge

!

specialize

    arguments 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

        arguments: arguments;

        visit: ir).

    self remember: #specialize

!

toPPCIr

    "Creates a PPCNodes from a PPParser"

    ir := ir asCompilerTree.

    self remember: #ppcNodes

! !

!PPCConfiguration methodsFor:'reporting'!

reportTime: timeInMs

    arguments profile ifTrue: [ 

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

    ]

! !