"{ 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
    arguments profile ifTrue: [ 
        self add: 'context tokenRead: ', tokenName storeString, '.'
    ]
! !

!PPCCodeGen methodsFor:'support'!

cache: id as: value
    methodCache at: id put: value.
!

cachedValue: id
    ^ methodCache at: id ifAbsent: [ nil ]
!

cachedValue: id ifPresent: block
    ^ methodCache at: id ifPresent: block
!

checkCache: id
    | method  |
    self flag: 'deprecated?'.
    
    "Check if method is hand written"
    method := compiledParser ifNotNil: [ compiledParser compiledMethodAt: id ifAbsent: [ nil ] ].
    method ifNotNil: [ ^ PPCCompiledMethod new id: id; yourself ].
    
    ^ self cachedValue: id
!

pop
    | retval |
    retval := compilerStack pop.
    currentMethod := compilerStack isEmpty 
        ifTrue: [ nil ]
        ifFalse: [ compilerStack top ].
    ^ retval

    "Modified: / 21-11-2014 / 12:27:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

push
    compilerStack push: currentMethod.
    (compilerStack 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>"
!

startInline: id
    | indentationLevel |
    (methodCache 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
    (methodCache includesKey: id) ifTrue: [ self error: 'OOOUPS!!' ].

    currentMethod := PPCMethod new.
    currentMethod id: id.
    currentMethod category: self methodCategory.
    
    arguments profile ifTrue:[ 
        self codeProfileStart.
    ].
    self push.      
                
    self cache: id as: currentMethod.

    "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 cache: currentMethod methodName as: currentMethod.
	"arguments profile ifTrue: [ Transcript show: currentMethod code; cr. ]."
	^ self pop.

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

top
    ^ compilerStack top
! !

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