Class { #name : 'PPCIdGenerator', #superclass : 'Object', #instVars : [ 'idCache', 'numericIdCache' ], #category : 'PetitCompiler-Compiler-Codegen' } { #category : 'as yet unclassified' } PPCIdGenerator class >> new [ ^ self basicNew initialize ] { #category : 'as yet unclassified' } PPCIdGenerator >> 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 " ] { #category : 'as yet unclassified' } PPCIdGenerator >> cachedSuchThat: block ifNone: noneBlock [ | key | key := idCache keys detect: block ifNone: [ nil ]. key isNil ifTrue: [ ^ noneBlock value ]. ^ idCache at: key ] { #category : 'as yet unclassified' } PPCIdGenerator >> 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 ]. "self haltIf: [ name = 'prim' ]." ^ name asSymbol ] { #category : 'as yet unclassified' } PPCIdGenerator >> idFor: object [ self assert: object canHavePPCId. ^ self idFor: object defaultName: object defaultName prefix: object prefix suffix: object suffix ] { #category : 'as yet unclassified' } PPCIdGenerator >> idFor: object defaultName: defaultName [ ^ self idFor: object defaultName: defaultName prefix: nil suffix: nil ] { #category : 'as yet unclassified' } PPCIdGenerator >> idFor: object defaultName: defaultName prefix: prefix [ ^ self idFor: object defaultName: defaultName prefix: prefix suffix: '' ] { #category : 'as yet unclassified' } PPCIdGenerator >> idFor: object defaultName: defaultName prefix: prefix suffix: suffix [ ^ idCache at: object ifAbsentPut: [ self generateIdFor: object defaultName: defaultName prefix: prefix suffix: suffix ] ] { #category : 'accessing' } PPCIdGenerator >> ids [ ^ idCache keys ] { #category : 'initialization' } PPCIdGenerator >> initialize [ super initialize. idCache := IdentityDictionary new. numericIdCache := IdentityDictionary new. ] { #category : 'accessing' } PPCIdGenerator >> numericIdCache [ ^ numericIdCache ] { #category : 'as yet unclassified' } PPCIdGenerator >> numericIdFor: object [ self assert: object isSymbol. ^ numericIdCache at: object ifAbsentPut: [ numericIdCache at: object put: (numericIdCache size) + 1 ] ] { #category : 'accessing' } PPCIdGenerator >> numericIds [ ^ numericIdCache keys ]