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

"{ NameSpace: Smalltalk }"

Object subclass:#PPCScannerCodeGenerator

	instanceVariableNames:'codeGen fsa backlinkStates backlinkTransitions arguments openSet

		incommingTransitions methodCache id resultStrategy fsaCache'

	classVariableNames:''

	poolDictionaries:''

	category:'PetitCompiler-Scanner'

!

!PPCScannerCodeGenerator methodsFor:'accessing'!

arguments

    ^ arguments 

!

arguments: anObject

    arguments := anObject

!

codeGen

    ^ codeGen 

!

compiler

    ^ self codeGen 

! !

!PPCScannerCodeGenerator methodsFor:'analysis'!

analyzeBacklinks

    backlinkTransitions := fsa backTransitions.

    backlinkStates := IdentityDictionary new.

    backlinkTransitions do: [ :t |

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

    ].

!

analyzeDistinctRetvals

    (fsa hasDistinctRetvals) ifTrue: [

        resultStrategy := PPCDistinctResultStrategy new

            codeGen: codeGen;

            yourself

    ] ifFalse: [ 

        resultStrategy := PPCUniversalResultStrategy new

            codeGen: codeGen;

            tokens: fsa retvals asArray;

            yourself

    ]

!

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 ] 

!

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

!

startsSimpleLoop: state

    |   |

    "

        This accepts more or less something like $a star

        for now.. might extend later

    "

    ((self incommingTransitionsFor: state) size == 2) ifFalse: [ ^ false ].

    ^ (state transitions select: [ :t | t destination == state ]) size == 1

! !

!PPCScannerCodeGenerator methodsFor:'caching'!

cache: anFsa method: method

    fsaCache at: anFsa put: method

!

cachedValueForIsomorphicFsa: anFsa

    | key |

    key := fsaCache keys detect: [ :e | e isIsomorphicTo: anFsa ].

    ^ fsaCache at: key

!

isomorphicIsCached: anFsa

    ^ fsaCache keys anySatisfy: [ :e | e isIsomorphicTo: anFsa ]

! !

!PPCScannerCodeGenerator methodsFor:'code generation'!

generate

    | method |

    self assert: fsa isDeterministic.

    self assert: fsa isWithoutEpsilons.

    self assert: fsa checkConsistency.

    (self isomorphicIsCached: fsa) ifTrue: [ 

        ^ self cachedValueForIsomorphicFsa: fsa 

    ].

    self analyzeBacklinks.

    self analyzeTransitions.

    self analyzeDistinctRetvals.

    openSet := IdentitySet new.

    codeGen startMethod: (codeGen idFor: fsa).

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

    resultStrategy reset.

    self generateFor: fsa startState.

    method := codeGen stopMethod.	

    self cache: fsa method: method.

    ^ method.

!

generate: aPEGFsa

    fsa := aPEGFsa.

    self assert: fsa isDeterministic.

    self assert: fsa isWithoutPriorities.

    fsa minimize.

    fsa checkSanity.

    ^ self generate

!

generateAndCompile

    self generate.

    ^ self compile

!

generateAndCompile: aPEGFsa

    fsa := aPEGFsa.

    fsa minimize.

    fsa checkSanity.

    ^ self generateAndCompile

!

generateFinalFor: state

    ^ self generateFinalFor: state offset: 0

!

generateFinalFor: state offset: offset

    state retvalsAndInfosDo: [:retval :info |

        info isFinal ifTrue: [ 

            info isFsaFailure ifTrue: [ 

                resultStrategy recordFailure: retval offset: offset

            ] ifFalse: [ 

                resultStrategy recordMatch: retval offset: offset

            ]

        ].

    ]

!

generateFor: state

    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 startsSimpleLoop: state) ifTrue: [ 

        ^ self generateSimpleLoopFor: state

    ].

    ^ self generateStandardFor: state

!

generateForSingleTransition: t from: state

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

    codeGen codeAssertPeek: t ifFalse: [ 

        resultStrategy returnResult: state 

    ].

"	(self isBacklink: t) ifTrue: [ 

        codeGen add: 'true'

    ] ifFalse: [ 

        self generateFor: t destination.

    ]

"

    self generateFor: t destination

!

generateForTransition: t from: state		

"	(self isBacklink: t) ifTrue: [ 

        codeGen codeAssertPeek: (t characterSet) ifTrue: [ 

            codeGen add: 'true'

        ]

    ] ifFalse: [ 

        codeGen codeAssertPeek: (t characterSet) ifTrue: [.

            self generateFor: t destination.

        ].

    ].

"

        self generateFor: t destination.

    ].

    codeGen codeIfFalse.

!

generateNextFor: state

    state transitions isEmpty ifTrue: [  ^ self ].

    codeGen codeNextChar.

!

generateReturnFor: state

    codeGen codeNl.

    resultStrategy returnResult: state.

!

generateSimpleLoopFor: state

    | selfTransition |

    selfTransition := state transitions detect: [ :t | t destination == state ].

    codeGen codeStartBlock.

    codeGen codeNextChar.

    codeGen codeNl.

    codeGen codeAssertPeek: selfTransition.

    codeGen codeEndBlockWhileTrue.

    "Last transition did not passed the loop, therefore, we have to record succes with offset -1"

    self generateFinalFor: state offset: 1.

    self generateTransitions: (state transitions reject: [ :t | t == selfTransition  ]) for: state.

!

generateStandardFor: state

    self generateStartMethod: state.

    self generateFinalFor: state.

    self generateNextFor: state.

    self generateTransitionsFor: state.

    self generateStopMethod: state.

!

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.

!

generateTransitions: transitions for: state

    (transitions size = 0) ifTrue: [  

        self generateReturnFor: state.

        ^ self	

    ].

"	(state transitions size = 1) ifTrue: [  

        self generateForSingleTransition: state transitions anyOne from: state.

        ^ self

    ]."

    codeGen codeNl.

    transitions do: [ :t |

        self generateForTransition: t from: state

    ].

    codeGen indent.

    self generateReturnFor: state.

    codeGen dedent.

    codeGen codeNl.

    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.

    ]

"

!

generateTransitionsFor: state

    ^ self generateTransitions: state transitions for: state

!

setMaxNumericId

    codeGen addConstant: codeGen idGen numericIds size as: #MaxSymbolNumber 

!

setTokens

    | tokens |

    tokens := Array new: codeGen idGen numericIdCache size.

    codeGen idGen numericIdCache keysAndValuesDo: [ :key :value |

        tokens at: value put: key

    ].

    codeGen addConstant: tokens as: #Tokens 

! !

!PPCScannerCodeGenerator methodsFor:'compiling'!

compile

    ^ self compileScannerClass new

!

compileScannerClass

    | builder |

    self setMaxNumericId.

    self setTokens.

    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.

    fsaCache := IdentityDictionary new.

! !