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

"{ NameSpace: Smalltalk }"

Object subclass:#PPCConfiguration
	instanceVariableNames:'context ir history'
	classVariableNames:''
	poolDictionaries:''
	category:'PetitCompiler-Core'
!

!PPCConfiguration class methodsFor:'as yet unclassified'!

default
    ^ self universal
!

new
    ^ self basicNew
        initialize;
        yourself
!

tokenizing
    ^ PPCTokenizingConfiguration new
!

universal
    ^ PPCUniversalConfiguration new
! !

!PPCConfiguration methodsFor:'accessing'!

context
    ^ context
!

defaultArguments
    ^ PPCCompilationOptions default

    "Modified: / 24-08-2015 / 23:39:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

input: aPPParser
    ir := aPPParser asCompilerTree.    
    self remember: (self copyTree: ir) as: #input

    "Modified (format): / 29-08-2015 / 07:18:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

ir
    ^ ir
!

ir: whatever
    ir := whatever
! !

!PPCConfiguration methodsFor:'accessing - defaults'!

defaultParserSuperclass
    self subclassResponsibility

    "Created: / 01-09-2015 / 08:46:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!PPCConfiguration methodsFor:'compiling'!

buildClass: clazz
    |  builder |
    builder := PPCClassBuilder new.
    
    builder compiledClassName: clazz name.
    builder compiledSuperclass: clazz superclass.
    builder methodDictionary: clazz methodDictionary.
    builder constants: clazz constants.

    ^ builder compileClass.	
!

compile: whatever
    | time |
    self input: whatever.
    
    time := [ self invokePhases ] timeToRun.
    ((Smalltalk respondsTo:#isSmalltalkX) and:[Smalltalk isSmalltalkX]) ifFalse:[ 
        "Assume Pharo"
        time := time asMilliSeconds.
    ].
    self reportTime: time.
    
    ^ ir

    "Modified: / 17-08-2015 / 13:06:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

generateParser
    | parserClass parserSuper rootMethod |

    context options generate ifFalse:[
        ^ self
    ].
    parserSuper := context options parserSuperclass.
    parserSuper isNil ifTrue:[ 
        parserSuper := self defaultParserSuperclass.
    ].
    rootMethod := context parserClass propertyAt:#rootMethod.
    context parserClass name:context options parserName.
    context parserClass superclass: parserSuper.
    parserClass := self buildClass:context parserClass.
    parserClass startSymbol:rootMethod methodName.
    self remember:parserClass as:#parser.
    ir := parserClass new

    "Modified: / 25-08-2015 / 00:05:49 / Jan Vrany"
    "Modified: / 01-09-2015 / 08:46:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

generateScanner
    | scanner |

    context options generate ifFalse:[
        ^ self
    ].
    context scannerClass name:context options scannerName.
    context scannerClass superclass:context options scannerSuperclass.
    scanner := (self buildClass:context scannerClass).
    context parserClass addConstant:scanner as:#scannerClass.
    ir := scanner.
    self remember:scanner as:#scanner

    "Modified: / 25-08-2015 / 00:06:49 / Jan Vrany"
    "Modified: / 26-08-2015 / 19:58:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

invokePhases
    self subclassResponsibility
! !

!PPCConfiguration methodsFor:'debugging'!

copy: somethingTransformable
    self deprecated: 'copy on your own, or whatever, but dont use me'.
    ^ somethingTransformable transform: [ :e | e copy ]
!

copyTree: somethingTransformable
    ^ somethingTransformable transform: [ :e | e copy ]
!

remember: key
    self deprecated: 'use remember:as:'.
    
    self options debug ifTrue: [ 
        history add: key -> (self copy: ir).
    ]
!

remember: value as: key
    context options debug ifTrue: [ 
        history add: key -> value.
    ]

    "Modified: / 28-08-2015 / 14:14:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!PPCConfiguration methodsFor:'error handling'!

options
    ^ context options

    "Modified: / 26-08-2015 / 19:48:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

options: aPPCCompilationOptions
    context options: aPPCCompilationOptions

    "Created: / 26-08-2015 / 19:56:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!PPCConfiguration methodsFor:'initialization'!

initialize
    history := OrderedCollection new.
    context := PPCCompilationContext new.

    "Modified: / 26-08-2015 / 19:49:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!PPCConfiguration methodsFor:'reporting'!

reportTime: timeInMs
    context options profile ifTrue: [ 
        Transcript show: 'Time to compile: ', timeInMs asString, ' ms'; cr.
    ]

    "Modified: / 26-08-2015 / 16:35:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!PPCConfiguration methodsFor:'running'!

runPass: pass
    | p |

    p := pass asPPCPass.
    ir := p run: ir in: context.
    self remember:(self copyTree:ir) as:p class name

    "Created: / 26-08-2015 / 22:35:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 29-08-2015 / 07:16:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !