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

generateForSingleTransition: t from: 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: [ 
        codeGen codeAssertPeek: (t characterSet) ifTrue: [
            self generateFor: t destination.
        ].
    ].
"
    codeGen codeAssertPeek: (t characterSet) ifTrue: [
        self generateFor: t destination.
    ].
    codeGen codeIfFalse.
!

generateNextFor: state
    state transitions isEmpty ifTrue: [  ^ self ].
    codeGen codeNextChar.
!

generateReturnFor: state
    codeGen codeNlReturnResult: state priority.
!

generateStartMethod: state
    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' ].
! !