--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCIdGenerator.st	Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,145 @@
+"{ 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.
+! !
+