Syntax addPrototype: #Parser derivedFrom: {ReadStream}.
"Reads tokens from a Lexer and builds a Syntax Node tree for it."
Syntax Parser addSlot: #lexer valued: Syntax Lexer clone.
Syntax Parser addSlot: #lookAheadBuffer valued: ExtensibleArray newEmpty.
Syntax Parser addSlot: #currentScope valued: Syntax Lobby.
Syntax Parser addSlot: #typesNamespace valued: Types.

node readFrom: p@(Syntax Parser traits)
[
  node lineNumber: p lexer lineNumber.
  node
].

p@(Syntax Parser traits) on: stream
"Target the parser to the particular stream."
[
  p lexer: (p lexer newOn: stream).
  p lookAheadBuffer: p lookAheadBuffer newEmpty.
  p currentScope: Syntax Lobby.
  p
].

p@(Syntax Parser traits) readNotCommentToken
" Allows to read lexer tokens while ignoring comments "
[| token |
  [(token: p lexer readToken) isSameAs: Syntax CommentToken] whileTrue.
  token
].

p@(Syntax Parser traits) nextToken
"Takes the next token from either the buffer or the lexer transparently."
[
  p lookAheadBuffer isEmpty
    ifTrue: [p readNotCommentToken]
    ifFalse: [p lookAheadBuffer removeFirst]
].

p@(Syntax Parser traits) peekToken
"Return the next token that the lexer has returned, but leave it in the buffer
and don't update the position."
[
  p lookAheadBuffer isEmpty
    ifTrue: [p lookAheadBuffer addLast: p readNotCommentToken].
  p lookAheadBuffer first
].

p@(Syntax Parser traits) isAtEnd
[
  p lookAheadBuffer isEmpty and: [p lexer isAtEnd]
].

p@(Syntax Parser traits) undoToken: token
"Place the token back onto the stream buffer."
[
  p lookAheadBuffer addFirst: token
].

Syntax Parser addPrototype: #Error derivedFrom: {Syntax Lexer Error}.
"An error that occurred in parsing, always requiring a description."

p@(Syntax Parser traits) error: description
[| newE |
  newE: (p Error newDescription:
    'Line ' ; p lexer lineNumber print ; ': ' ; description).
  newE lineNumber: p lexer lineNumber.
  newE signal
].

p@(Syntax Parser traits) parseOptionalKeywords: message
[| token opts keywords args |
  opts: (Syntax OptionalKeywords for: message).
  keywords: {} writer.
  args: {} writer.
  [token: p nextToken.
    (token isSameAs: Syntax SelectorToken)
      and: [token selector isOptionalSelector]]
    whileTrue:
      [keywords nextPut: token selector.
       args nextPut: (p parseBinaryMessage: Nil)].
  opts keywords: keywords contents.
  opts arguments: args contents.
  opts readFrom: p.
  p undoToken: token.
  opts
].

p@(Syntax Parser traits) parseStatement
"Find a complete expression suitable as a statement."
"TODO: compare this with parseExpression to make sure that this does not
have any bad-behaving edge cases."
[| expression token |
  expression: p parseExpression.
  token: p peekToken.
  ((token isSameAs: Syntax SelectorToken)
    and: [token selector isOptionalSelector])
    ifTrue:
      [
        expression: (p parseOptionalKeywords: expression).
        token: p peekToken
      ].
  expression
].

p@(Syntax Parser traits) next
"The top-level Stream processing to return the next syntax node."
[| statement token |
  statement: p parseStatement.
  token: p nextToken.
  ((token isSameAs: Syntax EndStatementToken)
    or: [token isSameAs: Syntax EndStreamToken])
    ifFalse:
      [p error: 'Expected . at line ' ; p lexer lineNumber print].
  statement ifNil: [(Syntax Literal for: Nil) readFrom: p]
].

p@(Syntax Parser traits) parseLiteral
"Take the next token and try to form a literal from it."
[
  p parseLiteral: p nextToken
].

p@(Syntax Parser traits) parseTypeOf: node 
[| token oldScope |
  oldScope: p currentScope.
  p currentScope: (Syntax Namespace for: p typesNamespace).
  [token: p nextToken. token isSameAs: Syntax TypeToken]
    whileTrue: [node type: (p parseAtom evaluateIn: p typesNamespace)].
  p undoToken: token.
  p currentScope: oldScope.
  node
].

p@(Syntax Parser traits) parseAtom
[| token node |
  token: p nextToken.
  node: (p parseAtom: token).
  node
    ifNil: [p undoToken: token. ^ Nil].
  p parseTypeOf: node.
  ((node isSameAs: Syntax Parenthesis)
    and: [node type isNotNil]
    and: [node statements last type isNil])
    ifTrue: [node statements last type: node type.
	     node type: Nil].
  node
].

p@(Syntax Parser traits) parseUnaryMessage: argument
[| token |
  argument ifNil: [argument: p parseAtom].
  token: p nextToken.
  [(token is: Syntax SelectorToken) and: [token selector isUnarySelector]]
    whileTrue:
      [| node |
       node: (((token isSameAs: Syntax MacroSelectorToken)
                ifTrue: [Syntax UnaryMacro]
                ifFalse: [Syntax UnaryMessage])
	      sending: token selector to: {argument}).
       node readFrom: p.
       p parseTypeOf: node.
       argument: node.
       token: p nextToken].
  p undoToken: token.
  argument
].

p@(Syntax Parser traits) parseBinaryMessage: argument
[| token |
  argument: (p parseUnaryMessage: argument).
  [token: p nextToken.
   (token is: Syntax SelectorToken)
      and: [token selector isBinarySelector]]
    whileTrue:
      [argument: (((token selector = #^ or: [token selector = #^^ ])
			 and: [argument isNil])
          ifTrue:
            [(token selector = #^
               ifTrue: [Syntax ReturnClose]
               ifFalse: [Syntax ReturnFar]) of: (p parseUnaryMessage: Nil)]
          ifFalse:
            [((token isSameAs: Syntax MacroSelectorToken)
               ifTrue: [Syntax BinaryMacro]
               ifFalse: [Syntax BinaryMessage])
                   sending: token selector
	           to: {argument ifNil: [Syntax ImplicitArgument].
                         p parseUnaryMessage: Nil}]).
       argument readFrom: p].
  p undoToken: token.
  argument
].

p@(Syntax Parser traits) parseKeywordMessage: argument
[| front token arguments selector |
  argument: (p parseBinaryMessage: argument).
  ((p peekToken is: Syntax SelectorToken)
    and: [p peekToken selector isKeywordSelector])
    ifFalse: [^ argument].
  arguments: {} writer.
  arguments nextPut: (argument ifNil: [Syntax ImplicitArgument]).
  [token: p nextToken. 
    (token isSameAs: Syntax SelectorToken)
      and: [token selector isOptionalSelector not]]
    whileTrue:
      [front ifNil: [front: token].
       token selector isKeywordSelector
          ifFalse:
            [p error: 'Bad keyword message'].
        selector: (selector
          ifNil: [token selector as: String]
          ifNotNil: [selector ; (token selector as: String)]).
        arguments nextPut: (p parseBinaryMessage: Nil)].
  p undoToken: token.
  arguments: arguments contents.
  (arguments first == Syntax ImplicitArgument 
    and: [arguments size = 2])
    ifTrue:
      [(p currentScope 
          findVariable: 
            (selector 
              copyFrom: 0 
              to: selector size - 2) intern)
        ifNotNilDo:
          [| :variable |
           ^ ((Syntax StoreVariable of: (arguments at: 1)
		       into: variable) readFrom: p)]].
  selector: selector intern.
  (((front isSameAs: Syntax MacroSelectorToken)
      ifTrue: [Syntax KeywordMacro]
      ifFalse: [Syntax KeywordMessage])
    sending: selector to: arguments) readFrom: p
].

p@(Syntax Parser traits) parseBlock: block
[| token statements lineNumber inputVariables optKeywords optVariables |
  lineNumber: p lexer lineNumber.
  inputVariables: {} writer.
  optKeywords: {} writer.
  optVariables: {} writer.
  block parentScope: p currentScope.
  p currentScope: block.
  token: p nextToken.
  (token isSameAs: Syntax BeginVariablesToken)
    ifTrue:
      [token: p nextToken.
       [token isSameAs: Syntax BeginVariablesToken]
         whileFalse:
           [| variable name tmpName |
            (token isSameAs: Syntax SelectorToken)
              ifFalse:
                [p error: 'Bad variable declaration'].
            name: token selector.
            name isUnarySelector
              ifTrue:
                [
                  (block localVariables detect: [| :var | var name = name and: [name ~= #_]])
                    ifNil: 
                      [variable: Syntax Variable clone.
                        variable scope: block.
                        variable name: name]
                    ifNotNilDo: 
                      [| :var | variable: var].
                ]
              ifFalse:
                [tmpName: (name as: String).
                 (':&*' includes: tmpName first)
		   ifFalse:
                     [p error: 'Bad input variable declaration: ' ; (name as: String)].
         variable: Syntax Variable clone.
         variable scope: block.
         tmpName first
           caseOf:
             {
               $* -> [
                       tmpName: tmpName allButFirst intern. 
                       tmpName isUnarySelector
                         ifFalse:
                           [p error: 'Bad rest variable declaration: ' ; (name as: String)].
                       (tmpName ~= #_ and: [block localVariables anySatisfy: [| :var | var name = tmpName]])
                         ifTrue: [p error: 'Variable already declared: ' ; (tmpName as: String)].
                       variable name: tmpName.
                       block restVariable: variable
                     ].
               $: -> [
                       tmpName: tmpName allButFirst intern.
                       tmpName isUnarySelector
                         ifFalse:
                           [p error: 'Bad input variable declaration: ' ; (name as: String)].
                       (tmpName ~= #_ and: [block localVariables anySatisfy: [| :var | var name = tmpName]])
                         ifTrue: [p error: 'Variable already declared: ' ; (tmpName as: String)].
                       variable name: tmpName. 
                       inputVariables nextPut: variable
                     ].
               $& -> [
                       token: p nextToken.
                       ((token isSameAs: Syntax SelectorToken)
                         and: [token selector isUnarySelector])
                         ifFalse:
                           [p error: 'Bad keyword declaration: ' ; (name as: String)].
                       (token selector ~= #_ and: [block localVariables anySatisfy: [| :var | var name = token selector]])
                         ifTrue: [p error: 'Variable already declared: ' ; (token selector as: String)].
                       variable name: token selector.
                       optKeywords nextPut: name.
		               optVariables nextPut: variable
		             ]
             }].
            p parseTypeOf: variable.
            token: p nextToken.
            (variable name = #_ or: [block localVariables noneSatisfy: [| :var | var name = variable name]])
              ifTrue: [block localVariables: block localVariables ; { variable }]]]
    ifFalse:
      [p undoToken: token].
  block inputVariables: block inputVariables ; inputVariables contents.
  block optionalKeywords: block optionalKeywords ; optKeywords contents.
  block optionalVariables: block optionalVariables ; optVariables contents.
  block localVariables:
    block inputVariables ; 
    block optionalVariables ; 
    (block restVariable ifNil: [{}] ifNotNil: [{ block restVariable }]) ;
    ((block localVariables reader select:
      [| :var | 
        (block inputVariables includes: var) not
          and: [(block optionalVariables includes: var) not]
          and: [block restVariable ~== var]]) upToEnd as: Array).
  statements: {} writer.
  statements nextPut: (p parseStatement ifNil: [(Syntax Literal for: Nil) readFrom: p]).
  [token: p nextToken. token isSameAs: Syntax EndBlockToken]
    whileFalse:
      [((token isSameAs: Syntax EndParenthesisToken)
         or: [token isSameAs: Syntax EndArrayToken]
         or: [token isSameAs: Syntax EndStreamToken])
          ifTrue:
            [p error: 'Expected ] for [ at line ' ; lineNumber print].
       (token isSameAs: Syntax EndStatementToken)
         ifFalse: [p undoToken: token].
       statements nextPut: (p parseStatement ifNil: [(Syntax Literal for: Nil) readFrom: p])].
  p currentScope: block parentScope.
  block statements: statements contents.
  block
].

p@(Syntax Parser traits) parseDefinition
[| selector roles inputVariables optKeywords optVariables opts token method |
  selector: Nil.
  roles: {} writer.
  inputVariables: {} writer.
  optKeywords: {} writer.
  optVariables: {} writer.
  opts: False.
  method: Syntax MethodDefinition newEmpty.
  method readFrom: p.
  [token: p nextToken. token isSameAs: Syntax BeginBlockToken]
    whileFalse:
      [| variable |
        ((token isSameAs: Syntax SelectorToken)
          and: [token selector isUnarySelector])
          ifFalse: [p error: 'Bad input variable name in method definition'].
        variable: Syntax Variable clone.
        variable readFrom: p.
        variable name: token selector.
        variable scope: method.
        token: p nextToken.
        opts
          ifTrue:
            [optVariables nextPut: variable.
             ((token isSameAs: Syntax SelectorToken)
                and: [token selector isOptionalSelector])
                ifTrue:
                  [optKeywords nextPut: token selector]
                ifFalse:
                  [(token isSameAs: Syntax BeginBlockToken)
                    ifFalse:
                      [p error: 'Bad optional keyword in method definition'].
                   p undoToken: token]]
          ifFalse:
            [inputVariables nextPut: variable.
             (token isSameAs: Syntax AtToken)
               ifTrue:
                 [roles nextPut: p parseAtom. token: p nextToken]
               ifFalse:
                 [roles nextPut: ((Syntax Literal for: NoRole) readFrom: p)].
              (token isSameAs: Syntax SelectorToken)
                ifTrue:
                  [(selector isNotNil
                     and: [token selector isOptionalSelector not]
                     and: [selector isKeywordSelector not 
                       or: [token selector isKeywordSelector not]])
                    ifTrue: 
                      [p error: 'Bad selector name in method definition'].
                    token selector isUnarySelector
                      ifTrue:
                        [selector: token selector.
                          ((p peekToken isSameAs: Syntax SelectorToken)
                            and: [p peekToken selector isOptionalSelector])
                            ifTrue: [token: p nextToken]].
                    token selector isBinarySelector
                      ifTrue:
                        [selector: token selector].
                    token selector isKeywordSelector
                      ifTrue:
                        [selector:
                          (selector
                            ifNil: [token selector]
                            ifNotNil: [((selector as: String) ; (token selector as: String)) intern])].
                    token selector isOptionalSelector
                      ifTrue:
                        [optKeywords nextPut: token selector.
                          opts: True]]
                ifFalse:
                  [(token isSameAs: Syntax BeginBlockToken)
                     ifFalse:
                       [p error: 'Bad selector name in method definition'].
                   p undoToken: token]].
          method localVariables: method localVariables ; { variable }
        ].
  selector ifNil: [p error: 'No selector name specified in method definition'].
  method selector: selector.
  method roles: roles contents.
  method inputVariables: inputVariables contents.
  method optionalKeywords: optKeywords contents.
  method optionalVariables: optVariables contents.
  "method"
  p parseBlock: method
].

p@(Syntax Parser traits) parseExpression
[| token index |
  index: 0.
  [token: (index < p lookAheadBuffer size
             ifTrue: [p lookAheadBuffer at: index]
             ifFalse: [p lookAheadBuffer addLast: p readNotCommentToken]).
   index: index + 1.
   ((token isSameAs: Syntax AtToken)
      or:
        [(token isSameAs: Syntax BeginBlockToken)
          and: [p lookAheadBuffer isNotEmpty]
          and: [p lookAheadBuffer last isSameAs: Syntax SelectorToken]
          and: [p lookAheadBuffer last selector isUnarySelector]])
      ifTrue: [^ (p parseKeywordMessage: (p parseTypeOf: p parseDefinition))].
   token isSameAs: Syntax SelectorToken] whileTrue.
  p parseKeywordMessage: Nil
].