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

"{ NameSpace: Smalltalk }"

Object subclass:#PPCCodeGen

	instanceVariableNames:'compilerStack compiledParser methodCache currentMethod constants

		returnVariable arguments idGen'

	classVariableNames:''

	poolDictionaries:''

	category:'PetitCompiler-Compiler-Codegen'

!

!PPCCodeGen class methodsFor:'instance creation'!

new

    "return an initialized instance"

    ^ self on: PPCArguments default

!

on: aPPCArguments

    "return an initialized instance"

    ^ self basicNew

        initialize;

        arguments: aPPCArguments

! !

!PPCCodeGen methodsFor:'accessing'!

arguments: args

    arguments := args

!

constants

    ^ constants

!

currentMethod

    ^ currentMethod 

!

currentNonInlineMethod

    ^ compilerStack 

        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

!

methodCategory

    ^ 'generated'

!

methodDictionary

    ^ methodCache

!

methodFor: object

    | id |

    id := self idFor: object.

    ^ methodCache at: id ifAbsent: [ nil ]

! !

!PPCCodeGen methodsFor:'code generation'!

add: string

    currentMethod add: string.

!

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

!

addOnLine: string

    currentMethod addOnLine: string.

!

addVariable: name

    ^ self currentNonInlineMethod addVariable: name

    "Modified: / 23-04-2015 / 17:34:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

call: anotherMethod

    currentMethod add: anotherMethod call.

!

callOnLine: anotherMethod

    currentMethod addOnLine: anotherMethod call.

!

dedent

    currentMethod dedent

!

indent

    currentMethod indent

!

nl

    currentMethod nl

!

smartRemember: parser to: variableName 

    parser isContextFree ifTrue: [ 

        self 	codeAssign: 'context lwRemember.' 

                to: variableName.

    ] ifFalse: [ 

        self  codeAssign: 'context remember.'

                to: variableName.

    ]

!

smartRestore: parser from: mementoName

    parser isContextFree ifTrue: [ 

        self add: 'context lwRestore: ', mementoName, '.'.

    ] ifFalse: [ 

        self add: 'context restore: ', mementoName, '.'.

    ]

! !

!PPCCodeGen methodsFor:'coding'!

code:aStringOrBlockOrRBParseNode

    currentMethod code: aStringOrBlockOrRBParseNode

    "Created: / 01-06-2015 / 23:49:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

codeAssert: aCode

    self add: 'self assert: (', aCode, ').'.

!

codeAssign: code to: variable

    self assert: variable isNil not.

    "TODO JK: Hack alert, whatever is magic constant!!"

    (variable == #whatever) ifFalse: [ 

        "Do not assign, if somebody does not care!!"

        self add: variable ,' := ', code.

    ]

!

codeAssignParsedValueOf: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 isKindOf: PPCMethod).	

    method isInline ifTrue:[

        self callOnLine:method

    ] ifFalse:[

        self codeEvaluateAndAssign:(method call) to:aString.

    ]

    "Created: / 23-04-2015 / 18:21:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

codeBlock: contents

    currentMethod codeBlock: contents

    "Created: / 01-06-2015 / 22:35:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

codeCall: aMethod

    self assert: (aMethod isKindOf: PPCMethod).

    self add: aMethod call.

!

codeClearError

    self add: 'self clearError.'.

!

codeComment: string

    currentMethod add: '"', string, '"'.

!

codeDot

    self addOnLine:'.'.

    "Created: / 16-06-2015 / 06:09:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

codeError

    self add: 'self error: ''message notspecified''.'.

!

codeError: errorMessage

    self add: 'self error: ''', errorMessage, '''.'

!

codeError: errorMessage at: position

    self add: 'self error: ''', errorMessage, ''' at: ', position asString, '.'

!

codeEvaluate: selector argument: argument on: variable

    self assert: variable isNil not.

    "TODO JK: Hack alert, whatever is magic constant!!"

    (variable == #whatever) ifFalse: [ 

        "Do not assign, if somebody does not care!!"

        self add: variable, ' ', selector,' ', argument.

 	] ifTrue: [ 

        "In case argument has a side effect"

 		self add: argument	

    ]

!

codeEvaluateAndAssign: argument to: variable

    self assert: variable isNil not.

    "TODO JK: Hack alert, whatever is magic constant!!"

    (variable == #whatever) ifFalse: [ 

        "Do not assign, if somebody does not care!!"

        self add: variable ,' := ', argument.

    ] ifTrue: [ 

        "In case an argument has a side effect"

        self add: argument.	

    ]

!

codeHalt

    self add: 'self halt. '

!

codeHaltIfShiftPressed

    arguments debug ifTrue: [

        ((Smalltalk respondsTo: #isSmalltalkX) and:[Smalltalk isSmalltalkX]) ifFalse:[  

            self add: 'Halt ifShiftPressed.'

        ]

    ]

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

!

codeIf: condition then: then 

    self codeIf: condition then: then else: nil

    "Created: / 16-06-2015 / 06:07:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

codeIf: condition then: then else: else

    currentMethod 

        add: '(';

        codeOnLine: condition;

        addOnLine: ')'.

    then notNil ifTrue:[ 

        currentMethod 

            addOnLine:' ifTrue: ';

            codeBlock: then.

    ].

    else notNil ifTrue:[ 

        currentMethod 

            addOnLine:' ifFalse: ';

            codeBlock: else.

    ].

    self codeDot.

    "Created: / 01-06-2015 / 22:43:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 16-06-2015 / 06:09:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

codeIfErrorThen: then

    ^ self codeIf: 'error' then: then else: nil

    "Created: / 16-06-2015 / 06:06:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

codeIfErrorThen: then else: else

    ^ self codeIf: 'error' then: then else: else

    "Created: / 16-06-2015 / 06:05:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

codeNextToken

    self add: 'self nextToken.'

    "Created: / 23-04-2015 / 18:01:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 23-04-2015 / 20:51:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

codeOnLIne:aStringOrBlockOrRBParseNode

    currentMethod codeOnLine: aStringOrBlockOrRBParseNode

    "Created: / 01-06-2015 / 23:49:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

codeParsedValueOf: aBlock 

    | tmpVarirable  method |

    self assert: aBlock isBlock.	

    tmpVarirable := returnVariable.

    returnVariable := #whatever.

    method := [

        aBlock value

    ] ensure:[ returnVariable := tmpVarirable ].

    self assert: returnVariable == tmpVarirable.

    self assert: (method isKindOf: PPCMethod).

    self codeCall: method.

!

codeProfileStart

    self add: 'context methodInvoked: #', currentMethod methodName, '.'

    "Created: / 01-06-2015 / 21:17:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

codeProfileStop

    self add: 'context methodFinished: #', currentMethod methodName, '.'

    "Created: / 01-06-2015 / 21:19:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

codeReturn

   currentMethod isInline ifTrue: [

				"If inlined, the return variable already holds the value"

		] ifFalse: [

				arguments profile ifTrue:[ 

						self codeProfileStop.

				]. 

				self add: '^ ', currentMethod returnVariable  

		].

		"Created: / 23-04-2015 / 18:01:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"

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

!

codeReturn: code

    " - returns whatever is in code OR

      - assigns whatever is in code into the returnVariable"

    currentMethod isInline ifTrue:[

        self codeEvaluateAndAssign: code to: currentMethod returnVariable. 

    ] ifFalse: [ 

        arguments profile ifTrue:[ 

            self codeProfileStop.

        ].   

        self add: '^ ', code            

    ]

    "Created: / 23-04-2015 / 18:01:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"

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

!

codeReturnParsedValueOf: aBlock 

    | tmpVarirable  method |

    self assert:aBlock isBlock.	

    tmpVarirable := returnVariable.

    method := aBlock value. 

    self assert: returnVariable == tmpVarirable.

    self assert: (method isKindOf: PPCMethod).

    method isInline ifTrue:[

        self callOnLine:method.

        self codeReturn: returnVariable.

    ] ifFalse:[

        self codeReturn: method call.

    ]

    "Created: / 23-04-2015 / 18:21:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

codeStoreValueOf: aBlock intoVariable: aString

    | tmpVarirable method |

    self assert: aBlock isBlock.

    self assert: aString isNil not.

    tmpVarirable := returnVariable.

    returnVariable := aString.

    method := [  

        aBlock value 

    ] ensure: [ 

        returnVariable := tmpVarirable 

    ].

    method isInline ifTrue: [ 

        self callOnLine: method 

    ] ifFalse: [ 

        self codeEvaluateAndAssign: (method call) to: aString.

    ]	

    "Created: / 23-04-2015 / 18:21:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

codeTokenGuard: node ifFalse: codeBlock

    | guard id |

    guard := PPCTokenGuard on: node.

    (guard makesSense) ifTrue: [ 

        id := self idFor: guard firstToken.

        self add: 'self ', id asString, ' ifFalse: ['.

            self indent.

            codeBlock value.

            self dedent.

        self add: '].'.

    ]

!

codeTranscriptShow: text

    (arguments profile) ifTrue: [ 

        self add: 'Transcript show: ', text storeString, '; cr.'.

    ]

! !

!PPCCodeGen 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

!

idFor: object prefixed: prefix

    ^ self idFor: object prefixed: prefix suffixed: ''

!

idFor: object prefixed: prefix suffixed: suffix

    self error: 'Should no longer be used'.

    "

    | name id |

    ^ idCache at: object ifAbsentPut: [ 

        ((object canHavePPCId) and: [object name isNotNil]) ifTrue: [ 

            ""Do not use prefix, if there is a name""

            name := self asSelector: (object name asString).

            id := (name, suffix) asSymbol.

            ""Make sure, that the generated ID is uniqe!!""

            (idCache includes: id) ifTrue: [ 

                (id, '_', idCache size asString) asSymbol 

            ] ifFalse: [ 

                id

            ]

        ] ifFalse: [ 

            (prefix, '_', (idCache size asString), suffix) asSymbol

        ]

    ]

    "

    "Modified: / 17-08-2015 / 12:00:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

idFor: object suffixed: suffix

    self assert: (object isKindOf: PPCNode) description: 'Shold use PPCNode for ids'.

    ^ self idFor: object prefixed: object prefix suffixed: suffix effect: #none

!

numberIdFor: object

    ^ idGen numericIdFor: object

! !

!PPCCodeGen methodsFor:'initialization'!

copy: parser

    self halt: 'deprecated?'.

    ^ parser transform: [ :p | p copy ].

!

initialize

    super initialize.

    compilerStack := Stack new.

    methodCache := IdentityDictionary new.

    constants := Dictionary new.

    idGen := PPCIdGenerator new.

! !

!PPCCodeGen methodsFor:'profiling'!

profileTokenRead: tokenName