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

     2 

     3 "{ NameSpace: Smalltalk }"

     4 

     5 Object subclass:#PPCIdGenerator

     6 	instanceVariableNames:'idCache numericIdCache'

     7 	classVariableNames:''

     8 	poolDictionaries:''

     9 	category:'PetitCompiler-Compiler-Codegen'

    10 !

    11 

    12 !PPCIdGenerator class methodsFor:'as yet unclassified'!

    13 

    14 new

    15     ^ self basicNew initialize

    16 ! !

    17 

    18 !PPCIdGenerator methodsFor:'accessing'!

    19 

    20 ids

    21     ^ idCache keys

    22 !

    23 

    24 numericIdCache

    25     ^ numericIdCache

    26 !

    27 

    28 numericIds

    29     ^ numericIdCache keys

    30 ! !

    31 

    32 !PPCIdGenerator methodsFor:'as yet unclassified'!

    33 

    34 asSelector: string

    35     "e.g. '234znak 43 ) 2' asLegalSelector = #v234znak432"

    36     

    37     | toUse |

    38 

    39     toUse := string select: [:char | char isAlphaNumeric or: [ char = $_ ] ].

    40     (toUse isEmpty or: [ toUse first isLetter not ])

    41         ifTrue: [ toUse := 'v', toUse ].

    42     toUse first isUppercase ifFalse:[

    43         toUse := toUse copy.

    44         toUse at: 1 put: toUse first asLowercase

    45     ].

    46     ^toUse

    47 

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

    49 !

    50 

    51 cachedSuchThat: block ifNone: noneBlock

    52     | key |

    53     key := idCache keys detect: block ifNone: [ nil ].

    54     key isNil ifTrue: [ ^ noneBlock value ].

    55     

    56     ^ idCache at: key

    57 !

    58 

    59 generateIdFor: object defaultName: defaultName prefix: prefix suffix: suffix  

    60     | name count |

    61     object canHavePPCId ifTrue: [ 

    62         name := object hasName ifTrue: [ object name ] ifFalse: [ object defaultName ].

    63         name := self asSelector: name asString.

    64         

    65         "JK: I am not sure, if prefix and suffix should be applied to the name or not..."

    66         suffix isNil ifFalse: [ 

    67             name := name, '_', suffix.		

    68         ].

    69     

    70         prefix isNil ifFalse: [ 

    71             name := prefix , '_', name.		

    72         ].	

    73         

    74         "(idCache contains: [ :e | e = name ]) ifTrue: [  self error: 'Duplicit names?' ]."

    75     ] ifFalse: [ 

    76         name := defaultName.

    77 

    78         prefix isNil ifFalse: [ 

    79             name := prefix , '_', name.		

    80         ].

    81 

    82         suffix isNil ifFalse: [ 

    83             name := name, '_', suffix.		

    84         ].

    85 

    86         name := self asSelector: name asString.

    87         

    88     ].

    89 

    90     (idCache contains: [ :e | e = name ]) ifTrue: [  

    91         count := 2. 

    92         

    93         [	| tmpName |	

    94             tmpName := (name, '_', count asString).

    95             idCache contains: [:e | e = tmpName ]

    96         ] whileTrue: [ count := count + 1 ].

    97 

    98         name := name, '_', count asString

    99     ].

   100     

   101     ^ name asSymbol

   102 !

   103 

   104 idFor: object

   105     self assert: object canHavePPCId.

   106     ^ self idFor: object defaultName: object defaultName prefix: object prefix suffix: object suffix

   107 !

   108 

   109 idFor: object defaultName: defaultName

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

   111 !

   112 

   113 idFor: object defaultName: defaultName prefix: prefix

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

   115 !

   116 

   117 idFor: object defaultName: defaultName prefix: prefix suffix: suffix

   118     ^ idCache at: object ifAbsentPut: [ 

   119         self generateIdFor: object defaultName: defaultName prefix: prefix suffix: suffix

   120     ]

   121 !

   122 

   123 isCachedSuchThat: block

   124     ^ idCache keys contains: block

   125 !

   126 

   127 isCachedSuchThat: block ifTrue: trueBlock ifFalse: falseBlock

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

   129 !

   130 

   131 numericIdFor: object

   132     self assert: object isSymbol.

   133     ^ numericIdCache at: object ifAbsentPut: [ 

   134         numericIdCache at: object put: (numericIdCache size) + 1

   135     ]

   136 ! !

   137 

   138 !PPCIdGenerator methodsFor:'initialization'!

   139 

   140 initialize

   141     super initialize.

   142     idCache := IdentityDictionary new.

   143     numericIdCache := IdentityDictionary new.

   144 ! !

   145