394 lines
9.3 KiB
Smalltalk
394 lines
9.3 KiB
Smalltalk
"
|
|
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 <jan.vrany@fit.cvut.cz>"
|
|
]
|
|
|
|
{ #category : 'variables' }
|
|
PPCClass >> allocateReturnVariable [
|
|
^ self allocateReturnVariableNamed: 'retval'
|
|
|
|
"Created: / 23-04-2015 / 18:03:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
|
|
"Modified: / 15-06-2015 / 17:52:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
|
|
]
|
|
|
|
{ #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 <jan.vrany@fit.cvut.cz>"
|
|
]
|
|
|
|
{ #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 <jan.vrany@fit.cvut.cz>"
|
|
]
|
|
|
|
{ #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 <jan.vrany@fit.cvut.cz>"
|
|
]
|
|
|
|
{ #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 <jan.vrany@fit.cvut.cz>"
|
|
]
|
|
|
|
{ #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 <jan.vrany@fit.cvut.cz>"
|
|
]
|
|
|
|
{ #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 <jan.vrany@fit.cvut.cz>"
|
|
]
|
|
|
|
{ #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 <jan.vrany@fit.cvut.cz>"
|
|
]
|
|
|
|
{ #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 <jan.vrany@fit.cvut.cz>"
|
|
]
|
|
|
|
{ #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 <jan.vrany@fit.cvut.cz>"
|
|
]
|
|
|
|
{ #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 <jan.vrany@fit.cvut.cz>"
|
|
]
|
|
|
|
{ #category : 'support' }
|
|
PPCClass >> stopInline [
|
|
^ self pop.
|
|
|
|
"Modified: / 01-06-2015 / 21:37:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
|
|
]
|
|
|
|
{ #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
|
|
]
|