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

"{ NameSpace: Smalltalk }"

Object subclass:#PPCIdGenerator
	instanceVariableNames:'idCache numericIdCache'
	classVariableNames:''
	poolDictionaries:''
	category:'PetitCompiler-Compiler-Codegen'
!

!PPCIdGenerator class methodsFor:'as yet unclassified'!

new
    ^ self basicNew initialize
! !

!PPCIdGenerator methodsFor:'accessing'!

ids
    ^ idCache keys
!

numericIdCache
    ^ numericIdCache
!

numericIds
    ^ numericIdCache keys
! !

!PPCIdGenerator methodsFor:'as yet unclassified'!

asSelector: string
    "e.g. '234znak 43 ) 2' asLegalSelector = #v234znak432"
    
    | toUse |

    toUse := string select: [:char | char isAlphaNumeric or: [ char = $_ ] ].
    (toUse isEmpty or: [ toUse first isLetter not ])
        ifTrue: [ toUse := 'v', toUse ].
    toUse first isUppercase ifFalse:[
        toUse := toUse copy.
        toUse at: 1 put: toUse first asLowercase
    ].
    ^toUse

    "Modified: / 10-05-2015 / 07:29:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

cachedSuchThat: block ifNone: noneBlock
    | key |
    key := idCache keys detect: block ifNone: [ nil ].
    key isNil ifTrue: [ ^ noneBlock value ].
    
    ^ idCache at: key
!

generateIdFor: object defaultName: defaultName prefix: prefix suffix: suffix  
    | name count |
    object canHavePPCId ifTrue: [ 
        name := object hasName ifTrue: [ object name ] ifFalse: [ object defaultName ].
        name := self asSelector: name asString.
        
        "JK: I am not sure, if prefix and suffix should be applied to the name or not..."
        suffix isNil ifFalse: [ 
            name := name, '_', suffix.		
        ].
    
        prefix isNil ifFalse: [ 
            name := prefix , '_', name.		
        ].	
        
        "(idCache contains: [ :e | e = name ]) ifTrue: [  self error: 'Duplicit names?' ]."
    ] ifFalse: [ 
        name := defaultName.

        prefix isNil ifFalse: [ 
            name := prefix , '_', name.		
        ].

        suffix isNil ifFalse: [ 
            name := name, '_', suffix.		
        ].

        name := self asSelector: name asString.
        
    ].

    (idCache contains: [ :e | e = name ]) ifTrue: [  
        count := 2. 
        
        [	| tmpName |	
            tmpName := (name, '_', count asString).
            idCache contains: [:e | e = tmpName ]
        ] whileTrue: [ count := count + 1 ].

        name := name, '_', count asString
    ].
    
    ^ name asSymbol
!

idFor: object
    self assert: object canHavePPCId.
    ^ self idFor: object defaultName: object defaultName prefix: object prefix suffix: object suffix
!

idFor: object defaultName: defaultName
    ^ self idFor: object defaultName: defaultName prefix: nil suffix: nil
!

idFor: object defaultName: defaultName prefix: prefix
    ^ self idFor: object defaultName: defaultName prefix: prefix suffix: ''
!

idFor: object defaultName: defaultName prefix: prefix suffix: suffix
    ^ idCache at: object ifAbsentPut: [ 
        self generateIdFor: object defaultName: defaultName prefix: prefix suffix: suffix
    ]
!

isCachedSuchThat: block
    ^ idCache keys contains: block
!

isCachedSuchThat: block ifTrue: trueBlock ifFalse: falseBlock
    ^ (idCache keys contains: block) ifTrue: [trueBlock value] ifFalse: [falseBlock value]
!

numericIdFor: object
    self assert: object isSymbol.
    ^ numericIdCache at: object ifAbsentPut: [ 
        numericIdCache at: object put: (numericIdCache size) + 1
    ]
! !

!PPCIdGenerator methodsFor:'initialization'!

initialize
    super initialize.
    idCache := IdentityDictionary new.
    numericIdCache := IdentityDictionary new.
! !