" I am a basic structure represing a class being compiled. The CodeGen (or more of them) can operate on me, adding methods. I keep track of methods, ids, and inlined methods as well as the return variables for code gen. In the end ClassBuilder can create a Smalltalk class from my data. " Class { #name : 'PPCClass', #superclass : 'Object', #instVars : [ 'methodDictionary', 'currentMethod', 'constants', 'idGen', 'methodStack', 'returnVariable', 'properties' ], #category : 'PetitCompiler-Compiler-Codegen' } { #category : 'instance creation' } PPCClass class >> new [ "return an initialized instance" ^ self basicNew initialize. ] { #category : 'constants' } PPCClass >> addConstant: value as: name [ (constants includesKey: name) ifTrue:[ (constants at: name) ~= value ifTrue:[ self error:'Duplicate constant!'. ]. ^ self. ]. constants at: name put: value "Modified: / 29-05-2015 / 07:22:39 / Jan Vrany " ] { #category : 'variables' } PPCClass >> allocateReturnVariable [ ^ self allocateReturnVariableNamed: 'retval' "Created: / 23-04-2015 / 18:03:40 / Jan Vrany " "Modified: / 15-06-2015 / 17:52:56 / Jan Vrany " ] { #category : 'variables' } PPCClass >> allocateReturnVariableNamed: name [ "Allocate (or return previously allocated one) temporary variable used for storing a parser's return value (the parsed object)" ^ currentMethod allocateReturnVariableNamed: name "Created: / 15-06-2015 / 18:04:48 / Jan Vrany " ] { #category : 'variables' } PPCClass >> allocateTemporaryVariableNamed: preferredName [ "Allocate a new variable with (preferably) given name. Returns a real variable name that should be used." ^ self currentNonInlineMethod allocateTemporaryVariableNamed: preferredName "Created: / 23-04-2015 / 17:33:31 / Jan Vrany " ] { #category : 'ids' } PPCClass >> asClassName: string [ "e.g. '234znak 43 ) 2' asLegalSelector = #v234znak432" | toUse | toUse := string asString select: [:char | char isAlphaNumeric or: [ char = $_ ] ]. (toUse isEmpty or: [ toUse first isLetter not ]) ifTrue: [ toUse := 'v', toUse ]. toUse first isLowercase ifTrue: [ toUse := toUse copy. toUse at: 1 put: toUse first asUppercase ]. ^ toUse asSymbol "Modified: / 10-05-2015 / 07:29:57 / Jan Vrany " ] { #category : 'ids' } PPCClass >> 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 : 'method cache' } PPCClass >> cachedMethod: id [ ^ methodDictionary at: id ifAbsent: [ nil ] ] { #category : 'method cache' } PPCClass >> cachedMethod: id ifPresent: aBlock [ ^ methodDictionary at: id ifPresent: aBlock ] { #category : 'accessing' } PPCClass >> classVariables [ ^ constants keys asArray ] { #category : 'accessing' } PPCClass >> constants [ ^ constants ] { #category : 'accessing' } PPCClass >> currentMethod [ ^ currentMethod ] { #category : 'accessing' } PPCClass >> currentNonInlineMethod [ ^ methodStack detect:[:m | m isInline not ] ifNone:[ self error: 'No non-inlined method'] "Created: / 23-04-2015 / 17:33:31 / Jan Vrany " ] { #category : 'accessing' } PPCClass >> currentReturnVariable [ ^ currentMethod returnVariable ] { #category : 'accessing-properties' } PPCClass >> hasProperty: aKey [ "Test if the property aKey is present." ^ properties notNil and: [ properties includesKey: aKey ] ] { #category : 'ids' } PPCClass >> idFor: anObject [ ^ idGen idFor: anObject ] { #category : 'ids' } PPCClass >> idFor: anObject defaultName: defaultName [ ^ idGen idFor: anObject defaultName: defaultName ] { #category : 'accessing' } PPCClass >> idGen [ ^ idGen ] { #category : 'accessing' } PPCClass >> idGen: anObject [ idGen := anObject ] { #category : 'accessing' } PPCClass >> ids [ ^ idGen ids ] { #category : 'initialization' } PPCClass >> initialize [ super initialize. methodStack := Stack new. methodDictionary := IdentityDictionary new. constants := Dictionary new. idGen := PPCIdGenerator new. ] { #category : 'accessing' } PPCClass >> instanceAndClassVariables [ | collection | collection := OrderedCollection new. collection addAll: self instanceVariables. collection addAll: self classVariables. ^ collection ] { #category : 'accessing' } PPCClass >> instanceVariables [ ^ #() ] { #category : 'accessing' } PPCClass >> methodDictionary [ ^ methodDictionary ] { #category : 'accessing' } PPCClass >> name [ ^ self asClassName: (self propertyAt: #name) ] { #category : 'accessing' } PPCClass >> name: value [ ^ self propertyAt: #name put: value ] { #category : 'ids' } PPCClass >> numberIdFor: object [ ^ idGen numericIdFor: object ] { #category : 'support' } PPCClass >> parsedValueOf: aBlock to: aString [ | tmpVarirable method | self assert:aBlock isBlock. self assert:aString isNil not. tmpVarirable := returnVariable. returnVariable := aString. method := [ aBlock value ] ensure:[ returnVariable := tmpVarirable ]. self assert: (method isMethod). ^ method ] { #category : 'support' } PPCClass >> pop [ | retval | retval := methodStack pop. currentMethod := methodStack isEmpty ifTrue: [ nil ] ifFalse: [ methodStack top ]. ^ retval "Modified: / 21-11-2014 / 12:27:25 / Jan Vrany " ] { #category : 'accessing-properties' } PPCClass >> properties [ ^ properties ] { #category : 'accessing-properties' } PPCClass >> properties: aDictionary [ properties := aDictionary ] { #category : 'accessing-properties' } PPCClass >> propertyAt: aKey [ ^ self propertyAt: aKey ifAbsent: [ nil ] ] { #category : 'accessing-properties' } PPCClass >> propertyAt: aKey ifAbsent: aBlock [ "Answer the property value associated with aKey or, if aKey isn't found, answer the result of evaluating aBlock." ^ properties isNil ifTrue: [ aBlock value ] ifFalse: [ properties at: aKey ifAbsent: aBlock ] ] { #category : 'accessing-properties' } PPCClass >> propertyAt: aKey ifAbsentPut: aBlock [ "Answer the property associated with aKey or, if aKey isn't found store the result of evaluating aBlock as new value." ^ self propertyAt: aKey ifAbsent: [ self propertyAt: aKey put: aBlock value ] ] { #category : 'accessing-properties' } PPCClass >> propertyAt: aKey put: anObject [ "Set the property at aKey to be anObject. If aKey is not found, create a new entry for aKey and set is value to anObject. Answer anObject." ^ (properties ifNil: [ properties := Dictionary new: 1 ]) at: aKey put: anObject ] { #category : 'support' } PPCClass >> push [ methodStack push: currentMethod. (methodStack size > 500 )ifTrue: [ self error: 'unless it is very complex grammar, there is an error somewhere' ] "Modified: / 21-11-2014 / 12:27:18 / Jan Vrany " ] { #category : 'support' } PPCClass >> returnVariable [ self error: 'Should never be called and accessed outside this class'. ^ returnVariable ] { #category : 'accessing' } PPCClass >> rootMethod [ ^ self propertyAt: #rootMethod ifAbsent: nil ] { #category : 'accessing' } PPCClass >> rootMethod: value [ ^ self propertyAt: #rootMethod put: value ] { #category : 'accessing' } PPCClass >> selectors [ ^ methodDictionary keys ] { #category : 'support' } PPCClass >> startInline [ | indentationLevel | indentationLevel := currentMethod indentationLevel. currentMethod := PPCInlinedMethod new. currentMethod returnVariable: returnVariable. currentMethod indentationLevel: indentationLevel. self push. "Modified: / 01-06-2015 / 21:48:35 / Jan Vrany " ] { #category : 'support' } PPCClass >> startInline: id [ | indentationLevel | (methodDictionary includesKey: id) ifTrue: [ self error: 'OOOUPS!' ]. indentationLevel := currentMethod indentationLevel. currentMethod := PPCInlinedMethod new. currentMethod id: id. currentMethod returnVariable: returnVariable. currentMethod indentationLevel: indentationLevel. self push. "Modified: / 01-06-2015 / 21:48:35 / Jan Vrany " ] { #category : 'support' } PPCClass >> startMethod: id category: category [ (methodDictionary includesKey: id) ifTrue: [ self error: 'OOOUPS!' ]. currentMethod := PPCMethod new. currentMethod id: id. currentMethod category: category. self push. self store: currentMethod as: id. "Modified: / 01-06-2015 / 21:19:41 / Jan Vrany " ] { #category : 'support' } PPCClass >> stopInline [ ^ self pop. "Modified: / 01-06-2015 / 21:37:59 / Jan Vrany " ] { #category : 'support' } PPCClass >> stopMethod [ self store: currentMethod as: currentMethod methodName. ^ self pop. ] { #category : 'method cache' } PPCClass >> store: method as: id [ self assert: (method isKindOf: PPCMethod). methodDictionary at: id put: method. ] { #category : 'accessing' } PPCClass >> superclass [ ^ self propertyAt: #superclass ] { #category : 'accessing' } PPCClass >> superclass: value [ ^ self propertyAt: #superclass put: value ]