diff -r b5316ef15274 -r f6f68d32de73 compiler/PPCClass.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/compiler/PPCClass.st Mon Aug 24 15:34:14 2015 +0100 @@ -0,0 +1,298 @@ +"{ Package: 'stx:goodies/petitparser/compiler' }" + +"{ NameSpace: Smalltalk }" + +Object subclass:#PPCClass + instanceVariableNames:'methodDictionary currentMethod constants idGen arguments + methodStack returnVariable properties' + classVariableNames:'' + poolDictionaries:'' + category:'PetitCompiler-Compiler-Codegen' +! + +!PPCClass methodsFor:'accessing'! + +arguments: args + arguments := args +! + +constants + ^ constants +! + +currentMethod + ^ currentMethod +! + +currentNonInlineMethod + ^ methodStack + detect:[:m | m isInline not ] + ifNone:[ self error: 'No non-inlined method'] + + "Created: / 23-04-2015 / 17:33:31 / Jan Vrany " +! + +currentReturnVariable + ^ currentMethod returnVariable +! + +idGen + ^ idGen +! + +idGen: anObject + idGen := anObject +! + +ids + ^ idGen ids +! + +methodDictionary + ^ methodDictionary +! + +name + ^ self propertyAt: #name +! + +name: value + ^ self propertyAt: #name put: value +! + +superclass + ^ self propertyAt: #superclass +! + +superclass: value + ^ self propertyAt: #superclass put: value +! ! + +!PPCClass methodsFor:'accessing-properties'! + +hasProperty: aKey + "Test if the property aKey is present." + + ^ properties notNil and: [ properties includesKey: aKey ] +! + +properties + ^ properties +! + +properties: aDictionary + properties := aDictionary +! + +propertyAt: aKey + ^ self propertyAt: aKey ifAbsent: [ nil ] +! + +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 ] +! + +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 ] +! + +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 +! ! + +!PPCClass methodsFor:'constants'! + +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 " +! ! + +!PPCClass methodsFor:'ids'! + +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 " +! + +idFor: anObject + ^ idGen idFor: anObject +! + +idFor: anObject defaultName: defaultName + ^ idGen idFor: anObject defaultName: defaultName +! + +numberIdFor: object + ^ idGen numericIdFor: object +! ! + +!PPCClass methodsFor:'initialization'! + +initialize + super initialize. + + methodStack := Stack new. + methodDictionary := IdentityDictionary new. + constants := Dictionary new. + idGen := PPCIdGenerator new. +! ! + +!PPCClass methodsFor:'method cache'! + +cachedMethod: id + ^ methodDictionary at: id ifAbsent: [ nil ] +! + +cachedMethod: id ifPresent: aBlock + ^ methodDictionary at: id ifPresent: aBlock +! + +store: method as: id + self assert: (method isKindOf: PPCMethod). + methodDictionary at: id put: method. +! ! + +!PPCClass methodsFor:'support'! + +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 +! + +pop + | retval | + retval := methodStack pop. + currentMethod := methodStack isEmpty + ifTrue: [ nil ] + ifFalse: [ methodStack top ]. + ^ retval + + "Modified: / 21-11-2014 / 12:27:25 / Jan Vrany " +! + +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 " +! + +returnVariable + self error: 'Should never be called and accessed outside this class'. + ^ returnVariable +! + +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 " +! + +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 " +! + +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 " +! + +stopInline + ^ self pop. + + "Modified: / 01-06-2015 / 21:37:59 / Jan Vrany " +! + +stopMethod + self store: currentMethod as: currentMethod methodName. + ^ self pop. +! ! + +!PPCClass methodsFor:'variables'! + +allocateReturnVariable + ^ self allocateReturnVariableNamed: 'retval' + + "Created: / 23-04-2015 / 18:03:40 / Jan Vrany " + "Modified: / 15-06-2015 / 17:52:56 / Jan Vrany " +! + +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 " +! + +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 " +! ! +