"
    Copyright (C) 2015-now Jan Vrany

    This code is not an open-source (yet). You may use this code
    for your own experiments and projects, given that:

    * all modification to the code will be sent to the
      original author for inclusion in future releases
    * this is not used in any commercial software

    This license is provisional and may (will) change in
    a future.
"
"{ Package: 'jv:tea/compiler' }"

"{ NameSpace: Smalltalk }"

Object subclass:#TSourceReader
	instanceVariableNames:'stream unit currentChunk currentChunkTree'
	classVariableNames:''
	poolDictionaries:''
	category:'Languages-Tea-Compiler-Model'
!

!TSourceReader class methodsFor:'documentation'!

copyright
"
    Copyright (C) 2015-now Jan Vrany

    This code is not an open-source (yet). You may use this code
    for your own experiments and projects, given that:

    * all modification to the code will be sent to the
      original author for inclusion in future releases
    * this is not used in any commercial software

    This license is provisional and may (will) change in
    a future.
"
! !

!TSourceReader class methodsFor:'reading'!

read: aStringOrFilenameOrStream
    ^ self new read: aStringOrFilenameOrStream

    "Created: / 31-08-2015 / 15:26:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!TSourceReader methodsFor:'processing'!

process
    "raise an error: this method should be implemented (TODO)"

    currentChunkTree isMessage ifTrue:[ 
        | handler |

        handler := ('process_' , (currentChunkTree selector copyReplaceAll: $: with: $_)) asSymbolIfInterned.
        (handler notNil and:[ self respondsTo: handler ]) ifTrue:[ 
            self perform: handler.
            ^ self.
        ].
    ].
    self error: 'Unknown chunk'

    "Created: / 28-08-2015 / 07:12:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 31-08-2015 / 15:49:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

process_methodsFor_
    self processMethodDefinitions

    "Created: / 31-08-2015 / 15:57:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

process_subclass_category_
    self processClassDefinition

    "Created: / 31-08-2015 / 15:50:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

process_subclass_instanceVariableNames_classVariableNames_poolDictionaries_category_
    self processClassDefinition

    "Created: / 28-08-2015 / 07:15:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!TSourceReader methodsFor:'processing-helpers'!

processClassDefinition
    | superName className class |

    currentChunkTree receiver isVariable ifTrue:[
        superName := currentChunkTree receiver name.
    ] ifFalse:[ 
        currentChunkTree receiver isLiteral ifTrue:[ 
            currentChunkTree receiver value isNil ifTrue:[ 
                superName := nil.
            ] ifFalse:[ 
                self error:'Invalid superclass'
            ].
        ] ifFalse:[ 
            self error:'Invalid superclass'
        ].
    ].
    className := currentChunkTree arguments first value.
    class := TClassDefinition newClass.
    class superclassName: superName.
    class name: className.
    2 to: currentChunkTree selectorParts size do:[:i | 
        | property value |

        property := (currentChunkTree selectorParts at: i) value.
        value    := (currentChunkTree arguments at: i) value.

        property = 'instanceVariableNames:' ifTrue:[ 
            class instanceVariableNamed: value.
        ] ifFalse:[ 
        property = 'classVariableNames:' ifTrue:[ 
            class classVariableNames: value.
        ] ifFalse:[
        property = 'poolDictionaries:' ifTrue:[ 
            class poolDictionaryNames: value.
        ] ifFalse:[
        property = 'category:' ifTrue:[ 
            class category: value.
        ]]]].
    ].

    unit addElement: class.

    "Created: / 28-08-2015 / 07:16:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 13-09-2015 / 07:56:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

processMethodDefinitions
    | className classIsMeta category source |

    currentChunkTree receiver isVariable ifTrue:[ 
        className := currentChunkTree receiver name.
        classIsMeta := false.
    ] ifFalse:[ 
        currentChunkTree receiver isMessage ifTrue:[ 
            currentChunkTree receiver receiver isVariable ifTrue:[ 
                currentChunkTree receiver selector = #class ifTrue:[ 
                    className := currentChunkTree receiver receiver name.
                    classIsMeta := true.
                ] ifFalse:[ 
                    self error: 'Invalid class name'
                ].
            ] ifFalse:[ 
                self error: 'Invalid class name'
            ].
        ] ifFalse:[ 
            self error: 'Invalid class name'
        ].
    ].
    currentChunkTree arguments first isLiteralNode ifTrue:[ 
        category := currentChunkTree arguments first value.
    ] ifFalse:[ 
        self error: 'Invalid category name'.
    ].

    [ source := stream nextChunk. source notEmptyOrNil ] whileTrue:[ 
        | method |
        method := TMethodDefinition new.
        method source: source.
        method category: category.
        classIsMeta ifTrue:[
            method className: className , ' class'.
        ] ifFalse:[ 
            method className: className.
        ].
        unit addElement: method
    ].

    "Created: / 31-08-2015 / 16:02:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 13-09-2015 / 07:56:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!TSourceReader methodsFor:'reading'!

read: aStringOrFilenameOrStream
    "Read Tea source from source and return a compilation unit from it (as TCompilationUnitDefinition)"

    unit := TCompilationUnitDefinition new.
    stream := aStringOrFilenameOrStream readStream.
    stream isEncodedStream ifFalse:[
        "/ By default, Tea sources are UTF8 encoded...
        stream := EncodedStream stream: stream encoder:(CharacterEncoder encoderToEncodeFrom:#utf8 into:#unicode). 
    ].

    [ stream atEnd ] whileFalse:[ 
        currentChunk := nil.
        currentChunkTree := nil.
        [ currentChunk isEmptyOrNil and:[ stream atEnd not ] ] whileTrue:[  
            currentChunk := stream nextChunk
        ].
        currentChunk notEmptyOrNil ifTrue:[
            currentChunkTree := TParser 
                        parseExpression: currentChunk 
                        onError: [:msg :pos | ChangeSet invalidChangeChunkError raiseRequestErrorString: ('Invalid chunk: %1 at %2' bindWith: msg with: pos) ].
            self process
        ].
    ].
    ^ unit

    "Created: / 31-08-2015 / 15:23:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 13-09-2015 / 07:56:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !