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

"{ NameSpace: Smalltalk }"

RBParser subclass:#TParser
	instanceVariableNames:'parsingInlineAssembly'
	classVariableNames:''
	poolDictionaries:''
	category:'Languages-Tea-Compiler-AST'
!

!TParser class methodsFor:'parsing'!

parseMethod: aString 
    ^ self parseMethod: aString onError: [:msg :pos | self error: msg , ' at ', pos printString ]

    "Created: / 20-08-2015 / 17:04:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

parseMethodHeader: aString 
        | parser |
        parser := self new.
        parser errorBlock: [:msg :pos | self error: msg , ' at ', pos printString ].
        parser initializeParserWith: aString type: #searchOn:errorBlock:.
        ^parser parseMessagePattern

    "Created: / 13-09-2015 / 06:39:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 13-09-2015 / 07:55:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!TParser methodsFor:'accessing'!

initializeParserWith: aString type: aSymbol 
        |stream|

        stream := ReadStream on: aString.
        source := aString.
        self scanner: (TScanner 
                                perform: aSymbol
                                with: stream
                                with: self errorBlock)

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

!TParser methodsFor:'initialization & release'!

scanner: aScanner 
    parsingInlineAssembly := false.
    super scanner: aScanner.

    "Created: / 02-09-2015 / 06:34:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!TParser methodsFor:'private-parsing'!

parseArgOrLocal
    "Parse either method/block argument or a local (inside | | )"

    | variable |

    variable := self parseVariableNode.
    variable typeSpec: (self parseTypeSpec: false).
    ^ variable

    "Created: / 20-08-2015 / 16:57:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 21-08-2015 / 21:20:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

parseBinaryPattern
    | method |

    method := super parseBinaryPattern.
    method returnTypeSpec: (self parseTypeSpec: true).
    ^ method

    "Created: / 21-08-2015 / 22:55:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

parseBlockArgsInto: node
    | verticalBar args colons |
    args := OrderedCollection new: 2.
    colons := OrderedCollection new: 2.
    verticalBar := false.
    [currentToken isSpecial and: [currentToken value == $:]] whileTrue: [
        colons add: currentToken start.
        self step.      ":"
        verticalBar := true.
        args add: self parseArgOrLocal
    ].   
    (currentToken isBinary and:[ currentToken value == #< ]) ifTrue:[ 
        "Return type spec"
        node returnTypeSpec: (self parseTypeSpec: true).
        verticalBar := true.
    ].
    verticalBar ifTrue:[ 
        currentToken isBinary ifTrue: [
            node bar: currentToken start.
            currentToken value == #| ifTrue: [
                self step
            ] ifFalse: [
                currentToken value == #'||' ifTrue:[
                    "Hack the current token to be the start 
                     of temps bar"
                    currentToken
                            value: #|;
                            start: currentToken start + 1
                ] ifFalse: [
                    self parserError: '''|'' expected'
                ]
            ]
        ] ifFalse: [
            (currentToken isSpecial and: [currentToken value == $]]) ifFalse: [
                self parserError: '''|'' expected'
            ]
        ].                    
    ].
    node
        arguments: args;
        colons: colons.
    ^node

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

parseInlineAssembly
        | position blockNode firstLine prevScope|

        position := currentToken start.
        firstLine := currentToken lineNumber.
        parsingInlineAssembly := true.
        self step. "/ To eat %[ token
        blockNode := self parseBlockArgsInto: TInlineAssemblyNode new.
"/        node arguments do:[:eachArg | eachArg parent:self].
        blockNode left: position.
        blockNode firstLineNumber:firstLine.
        prevScope := currentScope.
        currentScope := blockNode.
        self rememberLastNode:blockNode.
        blockNode body: (self parseStatements: false).
        RBParser isSmalltalkX ifTrue:[
            self addComments:(scanner getCommentsBeforeToken) afterNode:blockNode body.
        ].
        "/ ensure that right is set, even if parse aborted due to an error
        blockNode right: currentToken start-1.

        (currentToken isTInlineAssemblyEnd ) 
                ifFalse: [self parserError: '''$]'' expected'].
        "/ fix right
        blockNode right: currentToken start.
        blockNode lastLineNumber:currentToken lineNumber.
        parsingInlineAssembly := false.

        self step.
        self addComments:(scanner getCommentsBeforeToken) afterNode:blockNode.
        currentScope := prevScope.
        ^ blockNode

    "Created: / 02-09-2015 / 06:25:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

parseKeywordMessageWith: node 
    | message |
    message := super parseKeywordMessageWith: node.
    message ~~ node ifTrue:[ 
        "/ Check for special forms here...
        (TSpecialFormNode specialSelectors includes: message selector) ifTrue:[ 
            message := TSpecialFormNode receiver: message receiver  
                                        selectorParts: message selectorParts
                                        arguments: message arguments.
        ].
    ].
    ^ message

    "Created: / 14-09-2015 / 12:24:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

parseKeywordPattern
    | method |

    method := super parseKeywordPattern.
    method returnTypeSpec: (self parseTypeSpec: true).
    ^ method

    "Created: / 20-08-2015 / 17:33:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 21-08-2015 / 22:50:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

parseStatementList: tagBoolean into: sequenceNode 
        | statements return periods returnPosition returnLineNumber node valueNode|
        return := false.
        statements := OrderedCollection new.
        periods := OrderedCollection new.
        self addComments:(scanner getCommentsBeforeToken) beforeNode:sequenceNode.
        tagBoolean ifTrue: [self parseResourceTag].
        
        [
         "skip empty statements"
         emptyStatements ifTrue: 
                 [[currentToken isSpecial and: [currentToken value == $.]] whileTrue: 
                                 [periods add: currentToken start.
                                 self step]].

         self atEnd 
                or: [(currentToken isSpecial and: ['])}' includes: currentToken value ])
                or: [(currentToken isTInlineAssemblyEnd)]]
        ] whileFalse:[ 
            self addComments:(scanner getCommentsBeforeToken) beforeNode:node "value".

            return ifTrue: [
                self class isSmalltalkX 
                    ifTrue:
                        ["could output a warning"]
                    ifFalse:
                        [self 
                            parserError: 'End of statement list encounted (statements after return)'
                            lastNode:node]].
            (currentToken isTInlineAssemblyBegin) ifTrue:[ 
                node := self parseInlineAssembly.
                statements add: node.
            ] ifFalse:[
            (currentToken isSTXPrimitiveCode) 
                ifTrue:[
                    " primPosition := currentToken start. "
                    node := RBSTXPrimitiveCCodeNode new codeToken: currentToken.
                    self addComments:(scanner getCommentsBeforeToken) afterNode:node.
                    statements add: node.
                    self step.
                ] ifFalse:[
                    (currentToken isSpecial and: [currentToken value == $^])
                        ifTrue: 
                                [
                                returnPosition := currentToken start.
                                returnLineNumber := currentToken lineNumber.
                                self step.

                                valueNode := self parseAssignment.
                                node := RBReturnNode return: returnPosition value: valueNode.
                                node lineNumber:returnLineNumber.
                                scanner atEnd ifFalse:[
                                    self addComments:(scanner getCommentsBeforeToken) afterNode:node value.
                                ].

                                statements add: node.
                                return := true]
                        ifFalse: 
                                [
                                node := self parseAssignment.
                                node notNil ifTrue:[
                                    self addComments:(scanner getCommentsAfterTokenIfInLine:node lastLineNumber) afterNode:node.
                                    scanner atEnd ifFalse:[
                                        self addComments:(scanner getCommentsAfterToken) afterNode:node.
                                        self addComments:(scanner getCommentsBeforeToken) afterNode:node.
                                    ].

                                    statements add: node
                                ]].
                ].
            ].

            (currentToken isSpecial and: [currentToken value == $.])
                ifTrue: 
                    [periods add: currentToken start.
                    self step]
                ifFalse: 
                    [return := true].
            emptyStatements 
                ifTrue: 
                    [[currentToken isSpecial and: [currentToken value == $.]] whileTrue: 
                                    [periods add: currentToken start.
                                    self step]]].

        sequenceNode 
            statements: statements;
            periods: periods.

        self addComments:(scanner getCommentsBeforeToken) afterNode:node "value".
        ^sequenceNode

    "Created: / 02-09-2015 / 06:23:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

parseType
    "
    type ::= type_simple
    "
    ^ self parseTypeSimple.

    "Created: / 20-08-2015 / 17:18:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 02-09-2015 / 17:01:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

parseTypeSimple
    "
    type_simple::= identifier ('[' type_parameters ']')?
    "
    | type |
        
    currentToken isIdentifier ifTrue:[ 
        type  := TSimpleTypeNode new.
        type name: currentToken value.
    ] ifFalse:[ 
        (currentToken isLiteral and:[ currentToken value isNil ]) ifFalse:[
            self parserError: 'type identifier expected'.
        ].
        type := TSimpleTypeNode new.
        type name: 'nil'.
    ].
    type
        start: currentToken start;
        stop: currentToken stop;
        lineNumber: currentToken lineNumber.  
    self step. "/ eat identifier.
    ^ type

    "Created: / 20-08-2015 / 17:20:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 21-08-2015 / 21:13:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

parseTypeSpec: forReturn
    parsingInlineAssembly ifTrue:[ ^ nil ].
    
    (currentToken isBinary and: [currentToken value == #<]) ifTrue: [
        | start stop type |    
        start := currentToken start.
        self step.
        forReturn ifTrue:[ 
            (currentToken isSpecial and:[ currentToken value == $^ ]) ifFalse:[ 
                self parserError: '''^'' expected'.
            ].
            self step.
        ].          

        type := self parseType.

        (currentToken isBinary and: [currentToken value == #>]) 
                ifFalse: [self parserError: '''>'' expected'].
        stop := currentToken stop.
        self step.
        ^ TTypeSpecNode new
            type: type;
            start: start;
            stop: stop.
    ] ifFalse:[ 
        self parserError: 'type annotation expected'
    ].

    "Created: / 20-08-2015 / 17:13:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 02-09-2015 / 07:01:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

parseUnaryPattern
    | method |

    method := super parseUnaryPattern.
    method returnTypeSpec: (self parseTypeSpec: true).
    ^ method

    "Created: / 21-08-2015 / 22:54:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !