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

"{ NameSpace: Smalltalk }"

Object subclass:#PPCScannerCodeGenerator

	instanceVariableNames:'codeGen fsa backlinkStates backlinkTransitions arguments openSet

		joinPoints incommingTransitions methodCache id'

	classVariableNames:''

	poolDictionaries:''

	category:'PetitCompiler-Scanner'

!

!PPCScannerCodeGenerator methodsFor:'accessing'!

arguments

    ^ arguments 

!

arguments: anObject

    arguments := anObject

! !

!PPCScannerCodeGenerator methodsFor:'analysis'!

analyzeBacklinks

    backlinkTransitions := fsa backTransitions.

    backlinkStates := IdentityDictionary new.

    backlinkTransitions do: [ :t |

        (self backlinksTo: (t destination)) add: t.

    ].

!

analyzeJoinPoints

    | joinTransitions |

    joinTransitions := fsa joinTransitions.

    joinTransitions := joinTransitions reject: [ :t | self isBacklinkDestination: t destination ].

    joinPoints := IdentityDictionary new.

    joinTransitions do: [ :t |

        (joinPoints at: t destination ifAbsentPut: [ IdentitySet new ]) add: t.

    ]

!

analyzeTransitions

    | transitions |

    transitions := fsa allTransitions.

    incommingTransitions := IdentityDictionary new.

    (self incommingTransitionsFor: fsa startState) add: #transitionStub.

    transitions do: [ :t |

        (self incommingTransitionsFor: t destination) add: t.

    ].

!

backlinksTo: state

    ^ backlinkStates at: state ifAbsentPut: [ OrderedCollection new ] 

!

closedJoinPoints

    | closed |

    closed := IdentitySet new.

    joinPoints keysAndValuesDo: [ :key :value | 

        value isEmpty ifTrue: [ closed add: key ].

    ].

    ^ closed

!

containsBacklink: state

    state transitions do: [ :t |

        (self isBacklink:  t) ifTrue: [ ^ true ]

    ].

    ^ false

!

hasMultipleIncommings: state

    ^ (incommingTransitions at: state ifAbsent: [ self error: 'should not happen']) size > 1

!

incommingTransitionsFor: state

    ^ incommingTransitions  at: state ifAbsentPut: [ IdentitySet new ]

!

isBacklink: transition

    ^ backlinkTransitions includes: transition

!

isBacklinkDestination: state

    ^ (self backlinksTo: state)  isEmpty not

!

isJoinPoint: state

    "Please note that joinPoints are removed as the compilaction proceeds"

    ^ joinPoints keys includes: state

!

joinTransitionsTo: joinPoint "state"

    ^ joinPoints at: joinPoint ifAbsent: [ #() ]

! !

!PPCScannerCodeGenerator methodsFor:'code generation'!

generate

    self assert: fsa isDeterministic.

    self assert: fsa isWithoutEpsilons.

    self assert: fsa checkConsistency.

    self analyzeBacklinks.

    self analyzeJoinPoints.

    self analyzeTransitions.

    openSet := IdentitySet new.

    codeGen startMethod: (codeGen idFor: fsa).

    codeGen codeComment: (Character codePoint: 13) asString, fsa asString.

    self generateFor: fsa startState.

    codeGen stopMethod.	

    ^ self compileScannerClass new

!

generate: aPEGFsa

    fsa := aPEGFsa.

    fsa compact.

    fsa checkSanity.

    ^ self generate

!

generateFinalFor: state

    state isFinal ifFalse: [  ^ self ].

    codeGen codeRecordMatch: state retval priority: state priority.

!

generateFor: state

"	(self isJoinPoint: state) ifTrue: [ 

        ^ codeGen codeComment: 'join point generation postponed...'

    ].

"

    codeGen cachedValue: (codeGen idFor: state) ifPresent: [ :method | 

        "if state is already cached, it has multiple incomming links.

     	 In such a case, it is compiled as a method, thus return immediatelly"

        ^ codeGen codeAbsoluteReturn:  method call

    ].

    self generateStartMethod: state.

"	(self isBacklinkDestination: state) ifTrue: [ 

        codeGen codeStartBlock.

    ].

"

    self generateFinalFor: state.

    self generateNextFor: state.

    self generateTransitionsFor: state.

"	(self isBacklinkDestination: state) ifTrue: [ 

        codeGen codeEndBlockWhileTrue.

    ].

"

    self generateStopMethod: state.

!

    (self isJoinPoint: t destination) ifTrue: [ self removeJoinTransition: t ].

    codeGen codeAssertPeek: (t characterSet) orReturn: state priority.

"	(self isBacklink: t) ifTrue: [ 

        codeGen add: 'true'

    ] ifFalse: [ 

        self generateFor: t destination.

    ]

"

    self generateFor: t destination

!

generateForTransition: t from: state	

    (self isJoinPoint: t destination) ifTrue: [ self removeJoinTransition: t   ].

"	(self isBacklink: t) ifTrue: [ 

        codeGen codeAssertPeek: (t characterSet) ifTrue: [ 

            codeGen add: 'true'

        ]

    ] ifFalse: [ 

            self generateFor: t destination.

        ].

    ].

"

        self generateFor: t destination.

    ].

    codeGen codeIfFalse.

!

generateNextFor: state

    state transitions isEmpty ifTrue: [  ^ self ].

    codeGen codeNextChar.

!

generateReturnFor: state

    codeGen codeNlReturnResult: state priority.

!

    id := codeGen idFor: state.

    codeGen codeComment: 'START - Generated from state: ', state asString.

    (self hasMultipleIncommings: state) ifTrue: [ 

        codeGen startMethod: id.

    ] ifFalse: [ 

        codeGen  startInline: id.

    ]

!

generateStopMethod: state

    |  |

    (self hasMultipleIncommings: state) ifTrue: [ 

        codeGen codeAbsoluteReturn: codeGen stopMethod call.

    ] ifFalse: [ 

        codeGen code: codeGen stopInline call.

    ].

    codeGen codeComment: 'STOP - Generated from state: ', state asString.

!

generateTransitionsFor: state

    (state transitions size = 0) ifTrue: [  

        self generateReturnFor: state.

        ^ self	

    ].

    (state transitions size = 1) ifTrue: [  

        self generateForSingleTransition: state transitions anyOne from: state.

        ^ self

    ].

    codeGen codeNl.

    state transitions do: [ :t |

        self generateForTransition: t from: state

    ].

    codeGen indent.

    self generateReturnFor: state.

    codeGen dedent.

    codeGen codeNl.

    state transitions size timesRepeat: [ codeGen addOnLine: ']' ].

    codeGen addOnLine: '.'.

"	self closedJoinPoints isEmpty ifFalse: [ 

        | jp |

        self assert: self closedJoinPoints size == 1.

        jp := self closedJoinPoints anyOne.

        self removeJoinPoint: jp.

        self generateFor: jp.

    ]

"

! !

!PPCScannerCodeGenerator methodsFor:'compiling'!

compileScannerClass

    | builder |

    builder := PPCClassBuilder new.

    builder compiledClassName: arguments scannerName.

    builder compiledSuperclass: PPCScanner.

    builder methodDictionary: codeGen methodDictionary.

    builder constants: codeGen constants.

    ^ builder compileClass.	

! !

!PPCScannerCodeGenerator methodsFor:'initialization'!

initialize

    super initialize.

    codeGen := PPCFSACodeGen new.

    arguments := PPCArguments default.

! !

!PPCScannerCodeGenerator methodsFor:'support'!

removeJoinPoint: state

    self assert: (joinPoints at: state) size = 0.

    joinPoints removeKey: state

!

removeJoinTransition: t

    (self joinTransitionsTo: t destination) remove: t ifAbsent: [ self error: 'this should not happen' ].

! !