"{ Package: 'jv:tea/compiler' }"

"{ NameSpace: Smalltalk }"

Object subclass:#TSourceReader

	instanceVariableNames:'stream unit currentChunk currentChunkTree'

	classVariableNames:''

	poolDictionaries:''

	category:'Languages-Tea-Compiler-Model'

!

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

! !