Compiler addSlot: #Parser.
Compiler Parser: Cloneable derive.
Compiler Parser addSlot: #lexer.
Compiler Parser addSlot: #lookAheadBuffer.
Compiler Parser addSlot: #currentScope.

p@(Compiler Parser traits) newOn: stream
"Target the parser to the particular stream."
[| newP |
  newP: p clone.
  newP lexer: (Compiler Lexer newOn: stream).
  newP lookAheadBuffer: ExtensibleSequence newEmpty.
  newP currentScope: Compiler LobbyNode.
  newP
].

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

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

p@(Compiler 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@(Compiler Parser traits) undoToken: token
"Place the token back onto the stream buffer."
[
  p lookAheadBuffer addFirst: token
].

p@(Compiler Parser traits) parseStatement
"Find a complete expression. If the next token is an end-statement marker,
consume that token. In either case, return the expression."
"TODO: compare this with parseExpression to make sure that this does not
have any bad-behaving edge cases."
[| expression |
  expression: p parseExpression.
  p peekToken traits == Compiler EndStatementToken traits
    ifTrue: [p nextToken].
  expression
].

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

p@(Compiler Parser traits) parseAtom
[| token node |
  token: p nextToken.
  node: (p parseAtom: token).
  node 
    ifNil:
      [
        p undoToken: token.
        ^ Nil
      ].
  [
    token: p nextToken.
    token traits == Compiler TypeToken traits
  ]
    whileTrue:
      [node type: p parseAtom].
  p undoToken: token.
  (node traits == Compiler ParenthesisNode traits
    and: [node type isNotNil]
    and: [node statements last type isNil])
    ifTrue:
      [
        node statements last type: node type.
        node type: Nil
      ].
  node
].

p@(Compiler Parser traits) parseUnaryMessage
[| token argument |
  argument: p parseAtom.
  token: p nextToken.
  [
    (token is: Compiler SelectorToken)
     and:
       [token selector isUnarySelector]
  ]
    whileTrue:
      [| node |
        node: (token traits == Compiler MacroSelectorToken traits
                ifTrue: [Compiler UnaryMacroNode clone]
                ifFalse: [Compiler UnaryMessageNode clone]).
        node selector: token selector.
        node arguments: { argument }.
        [
          token: p nextToken.    
          token traits == Compiler TypeToken traits
        ]
          whileTrue:
            [node type: p parseAtom].
        argument: node
      ].
  p undoToken: token.
  argument
].

p@(Compiler Parser traits) parseBinaryMessage
[| token argument |
  argument: p parseUnaryMessage.
  [
    token: p nextToken.
    (token is: Compiler SelectorToken)
      and:
        [
          token selector isBinarySelector
        ]
  ]
    whileTrue:
      [| node |
        ((token selector = #^ or: [token selector = #^^]) and: [argument isNil]) 
          ifTrue:
            [
              node: 
                (token selector = #^ 
                  ifTrue: [Compiler ReturnCloseNode clone]
                  ifFalse: [Compiler ReturnFarNode clone]).
              node value: (p parseUnaryMessage)
            ]
          ifFalse:
            [
              node: (token traits == Compiler MacroSelectorToken traits
                      ifTrue: [Compiler BinaryMacroNode clone]
                      ifFalse: [Compiler BinaryMessageNode clone]).
              node selector: token selector.
              node 
                arguments: 
                  { 
                    argument ifNil: [Compiler ImplicitArgumentNode].
                    p parseUnaryMessage 
                  }.
            ].
        argument: node.
      ].
  p undoToken: token.
  argument
].

p@(Compiler Parser traits) parseKeywordMessage: argument
[| front token arguments selector node |
  argument ifNil: [argument: p parseBinaryMessage].
  (p peekToken is: Compiler SelectorToken)
    ifFalse: [^ argument].
  arguments: (WriteStream newWith: { argument ifNil: [Compiler ImplicitArgumentNode] }).
  [
    token: p nextToken.
    token is: Compiler SelectorToken
  ]
    whileTrue:
      [
        front ifNil: [front: token].
        token selector isKeywordSelector
          ifFalse:
            [error: 'Line ' ; p lexer lineNumber print ; ': Bad keyword message'].
        selector
          ifNil: [selector: (token selector as: String)]
          ifNotNil: [selector: selector ; (token selector as: String)].
        arguments nextPut: p parseBinaryMessage
      ].
  p undoToken: token.
  arguments: arguments contents.
  (argument == Compiler ImplicitArgumentNode 
    and: [arguments size = 2])
    ifTrue:
      [
        (p currentScope 
          findVariable: 
            ((selector 
              copyFrom: 0 
              to: selector size - 2) as: Symbol))
          ifNotNilDo:
            [| :variable |
              node: Compiler StoreVariableNode clone.
              node variable: variable.
              node value: (arguments at: 1).
              ^ node
            ]
      ].
  selector: (selector as: Symbol).
  node: (front traits == Compiler MacroSelectorToken traits 
          ifTrue: [Compiler KeywordMacroNode clone]
          ifFalse: [Compiler KeywordMessageNode clone]).
  node selector: selector.
  node arguments: arguments.
  node
].

p@(Compiler Parser traits) parseBlock: block
[| token statements lineNumber inputVariables |
  lineNumber: p lexer lineNumber.
  block freeVariables: Dictionary newEmpty.
  block localVariables: Dictionary newEmpty.
  block inputVariables ifNil: [ block inputVariables: (WriteStream newOn: {}) contents].
  inputVariables: (WriteStream newOn: {}).
  block parentScope: p currentScope.
  block depth: (p currentScope depth + 1).
  p currentScope: block.
  token: p nextToken.
  token traits == Compiler BeginVariablesToken traits
    ifTrue:
      [
        token: p nextToken.
        [
          token traits == Compiler BeginVariablesToken traits
        ]
          whileFalse:
            [| variable name tmpname |
              token traits == Compiler SelectorToken traits
                ifFalse:
                  [error: 'Line ' ; p lexer lineNumber print ; ': Bad variable declaration'].
              name: token selector.
                    variable: Compiler VariableNode clone.
                    variable scope: block.
              name isUnarySelector
                ifTrue:
                  [

                    block localVariables at: name put: variable
                  ]
                ifFalse:
                  [           
                    tmpname: (token selector as: String).
                    (tmpname at: 0) = $:
                      ifFalse:
                        [error: 'Line ' ; p lexer lineNumber print ; ': Bad input variable declaration'].
                    tmpname: ((tmpname copyFrom: 1 to: tmpname size - 1) as: Symbol).
                    tmpname isUnarySelector
                      ifFalse:
                        [error: 'Line ' ; p lexer lineNumber print ; ': Bad input variable declaration'].
                    variable name: tmpname.
                    inputVariables nextPut: variable
                  ].
              [
                token: p nextToken.
                token traits == Compiler TypeToken traits
              ]
                whileTrue:
                  [variable type: p parseAtom].
            ]
      ]
    ifFalse:
      [p undoToken: token].
  statements: (WriteStream newOn: {}).
  [
    token: p peekToken.
    token traits == Compiler EndBlockToken traits
  ]
    whileFalse:
      [
        (token traits == Compiler EndParenthesisToken traits
          or: [token traits == Compiler EndArrayToken traits]
          or: [token traits == Compiler EndStreamToken traits])
          ifTrue:
            [error: 'Line ' ; p lexer lineNumber print ; ': Expected ] for [ at line ' ; lineNumber print].
        statements nextPut: p parseStatement
      ].
  p nextToken.
  p currentScope: block parentScope.
  block statements: statements contents.
  block inputVariables do: [ | :each | inputVariables nextPut: each ].
  block inputVariables: inputVariables contents.
  block
].
  
p@(Compiler Parser traits) parseDefinition
[| selector roles inputVariables token method |
  roles: (WriteStream newOn: {}).
  inputVariables: (WriteStream newOn: {}).
  method: Compiler MethodNode clone.
  [
    token: p nextToken.
    token traits == Compiler BeginBlockToken traits
  ]
    whileFalse:
      [| variable |
        (token traits == Compiler SelectorToken traits
          and: [token selector isUnarySelector])
          ifFalse: [error: 'Line ' ; p lexer lineNumber print ; ': Bad input variable name in method definition'].
        variable: Compiler VariableNode clone.
        variable name: token selector.
        variable scope: method.
        inputVariables nextPut: variable.
        token: p nextToken.
        token traits == Compiler AtToken traits
          ifTrue:
            [
              roles nextPut: p parseAtom.
              token: p nextToken
            ]
          ifFalse:
            [| literal |
              literal: Compiler LiteralNode clone.
              literal value: NoRole.
              roles nextPut: literal
            ].
        token traits == Compiler SelectorToken traits
          ifTrue:
            [
              selector 
                ifNil: [selector: (token selector as: String)]
                ifNotNil:
                  [
                    ((selector as: Symbol) isKeywordSelector
                      and: [token selector isKeywordSelector])
                      ifFalse: [error: 'Line ' ; p lexer lineNumber print ; ': Bad selector name in method definition'].
                    selector: selector ; (token selector as: String)
                  ]
            ]
          ifFalse:
            [
              token traits == Compiler BeginBlockToken traits
                ifFalse:
                  [error: 'Line ' ; p lexer lineNumber print ; ': Bad selector name in method definition'].
              p undoToken: token
            ]
      ].
  selector ifNil: [error: 'Line ' ; p lexer lineNumber print ; ': No selector name specified in method definition'].
  method selector: (selector as: Symbol).
  method roles: roles contents.
  method inputVariables: inputVariables contents.
  "method"
  p parseKeywordMessage: (p parseBlock: method)
].

p@(Compiler 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 traits == Compiler AtToken traits
      or:
        [token traits == Compiler BeginBlockToken traits
          and: [p lookAheadBuffer isNotEmpty]
          and: [p lookAheadBuffer last traits == Compiler SelectorToken traits]
          and: [p lookAheadBuffer last selector isUnarySelector]])
      ifTrue: [^ p parseDefinition].
    token traits == Compiler SelectorToken traits
  ] whileTrue.
  p parseKeywordMessage: Nil
].