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

"{ NameSpace: Smalltalk }"

RBParser subclass:#TParser
	instanceVariableNames:'parsingPrimitive'
	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:'initialization & release'!

scanner: aScanner 
    parsingPrimitive := 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>"
!

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

parseKeywordPragma
    | selectorParts arguments |

    selectorParts := OrderedCollection new: 2.
    arguments := OrderedCollection new: 2.
    [ currentToken isKeyword ] whileTrue: [
        selectorParts add: currentToken.
        self step.        
        "Hack to handle <primitive: [:asm | asm ret: 1 ]>
         style primitives"
        (selectorParts size == 1 
            and:[selectorParts last value = 'primitive:'
            and:[currentToken isSpecial 
            and:[currentToken value == $[]]]) ifTrue: [                        
            parsingPrimitive := true.
            arguments addLast: self parseBlock.
            parsingPrimitive := false.
        ] ifFalse:[
            arguments addLast: self parsePragmaLiteral 
        ]
    ].
    ^ RBPragmaNode
        selectorParts: selectorParts
        arguments: arguments.

    "Created: / 22-09-2015 / 16:49:36 / 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
    parsingPrimitive 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>"
! !