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

"{ NameSpace: Smalltalk }"

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


!PPCCompiler class methodsFor:'as yet unclassified'!

default
    ^ self universal
!

new
    ^ self basicNew
        initialize;
        yourself
!

tokenizing
    | options |

    options := PPCCompilationOptions default.
    options tokenize:true.
    ^ (PPCCompiler new)
        options:options;
        yourself

    "Modified: / 04-09-2015 / 16:21:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

universal
    | options |

    options := PPCCompilationOptions default.
    options tokenize:false.
    ^ (PPCCompiler new)
        options:options;
        yourself

    "Modified: / 04-09-2015 / 16:21:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!PPCCompiler methodsFor:'accessing'!

context
    ^ context
!

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

passes
    ^ passes
!

passes:aCollection
    passes := aCollection asOrderedCollection

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

!PPCCompiler methodsFor:'accessing - defaults'!

defaultPassesForTokenizingParser
    ^  {
        PPCTokenDetector .
        PPCCacheFirstFollowPass .
        PPCLL1Visitor .
        PPCTokenizingVisitor .
        PPCMergingVisitor .
        PPCSpecializingVisitor .
        PPCInliningVisitor .
        PPCMergingVisitor .
        PPCCheckingVisitor .
        PPCCacheFirstFollowPass .
        PPCTokenizingCodeGenerator .
        PPCFSAVisitor .
        PPCTokenCodeGenerator .
        PPCScannerCodeGenerator .    
    } asOrderedCollection.

    "Created: / 04-09-2015 / 15:56:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

defaultPassesForUniversalParser
    ^ {
        PPCTokenDetector.
        PPCCacheFirstFollowPass. 
        PPCSpecializingVisitor .
        PPCRecognizerComponentDetector .
        PPCSpecializingVisitor .
        PPCInliningVisitor .
        PPCMergingVisitor .
        PPCCheckingVisitor .
        PPCUniversalCodeGenerator
    } asOrderedCollection.

    "Created: / 04-09-2015 / 15:56:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!PPCCompiler methodsFor:'adding / removing passes'!

removePass: pass
    | index |

    self initializePassesIfNotAlready.
    [ 
        index := passes indexOf: pass.
        index ~~ 0
    ] whileTrue:[ 
        passes removeAtIndex: index
    ].

    "Created: / 04-09-2015 / 11:24:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 04-09-2015 / 16:02:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!PPCCompiler methodsFor:'compiling'!

compile: aPPParser
    | time |
    self input: aPPParser.
    
    time := [ self compile ] 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>"
! !

!PPCCompiler methodsFor:'initialization'!

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

    "Modified: / 04-09-2015 / 15:56:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

initializePassesIfNotAlready
    passes isNil ifTrue:[ 
        context options tokenize ifTrue:[ 
            passes := self defaultPassesForTokenizingParser
        ] ifFalse:[ 
            passes := self defaultPassesForUniversalParser
        ].
    ].

    "Created: / 04-09-2015 / 16:02:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!PPCCompiler methodsFor:'private'!

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
    self runPasses.
    self generateScanner.
    self generateParser.

    "Modified: / 07-09-2015 / 07:53:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

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

generateParser
    | parserClass parserSuper rootMethod |

    context options generate ifFalse:[
        ^ self
    ].
    context parserClass methodDictionary isEmpty ifTrue:[ 
        ^ self
    ].

    parserSuper := context options parserSuperclass.
    parserSuper isNil ifTrue:[ 
        parserSuper := context options tokenize 
                        ifTrue:[ PPTokenizingCompiledParser ]
                        ifFalse:[ PPCompiledParser ]   
    ].
    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: / 04-09-2015 / 16:07:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

generateScanner
    | scanner |

    context options generate ifFalse:[
        ^ self
    ].
    context scannerClass methodDictionary isEmpty ifTrue:[ 
        ^ 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: / 04-09-2015 / 15:33:12 / 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
!

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

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

    "Modified: / 07-09-2015 / 07:55:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

runPasses
    self initializePassesIfNotAlready.
    passes do:[:each | self runPass: each  ]

    "Created: / 07-09-2015 / 07:53:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

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

!PPCCompiler class methodsFor:'documentation'!

version_HG

    ^ '$Changeset: <not expanded> $'
! !