"{ 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 <jan.vrany@fit.cvut.cz>"

!

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 <jan.vrany@fit.cvut.cz>"

! !

!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 <jan.vrany@fit.cvut.cz>"

!

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 <jan.vrany@fit.cvut.cz>"

!

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>"

!

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 <jan.vrany@fit.cvut.cz>"

!

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>"

!

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>"

!

stopInline

    ^ self pop.

    "Modified: / 01-06-2015 / 21:37:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

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 <jan.vrany@fit.cvut.cz>"

    "Modified: / 15-06-2015 / 17:52:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

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>"

!

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>"

! !