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

! !