prototypes ensureNamespace: #Syntax.

Syntax addPrototype: #Node derivedFrom: {Cloneable}.
"The general syntax object for expressions."
Syntax Node addSlot: #type valued: Types Any.
"So that any syntax expression may be annotated with a type, by the inferencer
or manually."
Syntax Node addSlot: #lineNumber valued: Nil.
"The line number in the source code at which the node was read."

node@(Syntax Node traits) evaluate
[node evaluateIn: lobby].

node@(Syntax Node traits) evaluateIn: namespace
[overrideThis].

node@(Syntax Node traits) walk: block
"A depth-first do:-style iteration through Syntax Nodes; a code/tree-walker."
[
  block applyWith: node.
].

node@(Syntax Node traits) transformBy: block
"Transforms the tree's nodes in-place by the block closure.
Only transformChildren: needs to be overridden."
[
  (block applyWith: node) transformChildren: block
].

node@(Syntax Node traits) transformChildren: block
"Act on each of a node's children in-place.
This gets overridden for the various compound node types."
[
  node
].

node@(Syntax Node traits) deepCopy: scope
"Copies the entire syntax tree, with the given scope as the lexical reference.
This gets overridden for each type that is compound or relates to the scope."
[
  node
].

node@(Syntax Node traits) deepCopy
"Copies the entire syntax tree with the (default) scope being the lobby."
[
  node deepCopy: Syntax Lobby
].

Syntax addPrototype: #Annotation derivedFrom: {Syntax Node}.
"A wrapper for other Syntax Nodes that adds an annotative object."
Syntax Annotation addSlot: #value.
"The annotation."

ann@(Syntax Annotation traits) walk: block
[
  block applyWith: ann.
  ann value walk: block
].

ann@(Syntax Annotation traits) transformChildren: block
[
  ann value: (ann value transformBy: block).
  ann
].

ann@(Syntax Annotation traits) deepCopy: scope
[| newAnn |
  newAnn: ann clone.
  newAnn value: (ann value deepCopy: scope).
  newAnn
].

n@(Syntax Annotation traits) evaluateIn: namespace
[n value evaluateIn: namespace].

Syntax addPrototype: #Comment derivedFrom: {Syntax Annotation}.
"Comments are nodes that contain the expression that they annotate."
Syntax Comment addSlot: #comment valued: ''.
"The comment object, an empty String by default."

n@(Syntax Node traits) comment: comment
"Returns a new Comment with the given comment wrapping the original
Syntax Node. Usable as a macro."
[| newCom |
  newCom: Syntax Comment clone.
  newCom comment: comment evaluate.
  newCom value: n.
  newCom
].

Syntax addPrototype: #ImplicitArgument derivedFrom: {Syntax Node}.
"Implicit arguments include anything sent to the local context, as well as
the lobby."

node@(Syntax ImplicitArgument traits) evaluateIn: namespace
"The default is to simply return the namespace as the result."
[namespace].

Syntax addPrototype: #Macro derivedFrom: {Syntax Node}.
"Macro nodes are just like regular message-sends, except being applied at
compile-time to the Syntax Node trees for the expressions."
Syntax Macro addSlot: #selector.
Syntax Macro addSlot: #arguments.

macro@(Syntax Macro traits) sending: selector to: arguments
[| newMacro |
  newMacro: macro clone.
  newMacro selector: selector.
  newMacro arguments: arguments.
  newMacro
].

macro@(Syntax Macro traits) walk: block
[
  resend.
  macro arguments 
    do: [| :argument | argument walk: block]
].

macro@(Syntax Macro traits) transformChildren: block
[ 
  macro arguments infect: [| :argument | argument transformBy: block].
  macro
]. 

macro@(Syntax Macro traits) deepCopy: scope
[| newMacro |
  newMacro: macro clone.
  newMacro arguments: (macro arguments collect: [| :argument | argument deepCopy: scope]).
  newMacro
].

macro@(Syntax Macro traits) evaluateIn: namespace
[
  macro macroExpand evaluateIn: namespace
].

macro@(Syntax Macro traits) evaluateIn: namespace
"Evaluate the expansion. Should this be relied on? (I.e. should this throw a
condition which is resumable via macro-expansion?)"
[macro macroExpand evaluateIn: namespace].

Syntax addPrototype: #UnaryMacro derivedFrom: {Syntax Macro}.

Syntax addPrototype: #BinaryMacro derivedFrom: {Syntax Macro}.

Syntax addPrototype: #KeywordMacro derivedFrom: {Syntax Macro}.

Syntax addPrototype: #OptionalKeywords derivedFrom: {Syntax Node}.
"Annotates a Message with optional keywords and values given."
Syntax OptionalKeywords addSlot: #message.
Syntax OptionalKeywords addSlot: #keywords.
Syntax OptionalKeywords addSlot: #arguments.

opts@(Syntax OptionalKeywords traits) for: message
[| newO |
  newO: opts clone.
  newO message: message.
  newO
].

opts@(Syntax OptionalKeywords traits) walk: block
[
  block applyWith: opts.
  opts message walk: block.
  opts arguments
    do: [| :argument | argument walk: block]
].

opts@(Syntax OptionalKeywords traits) transformChildren: block
[
  opts message: (opts message transformBy: block).
  opts arguments infect: [| :argument | argument transformBy: block].
  opts
].

opts@(Syntax OptionalKeywords traits) deepCopy: scope
[| newOpts |
  newOpts: opts clone.
  newOpts message: (opts message deepCopy: scope).
  newOpts arguments: (opts arguments collect: [| :argument | argument deepCopy: scope]).
  newOpts
].

opts@(Syntax OptionalKeywords traits) evaluateIn: namespace
[| optValues |
  optValues: {} writer.
  opts keywords 
    with: opts arguments 
    do: [| :key :arg | 
      optValues nextPut: key. 
      optValues nextPut: (arg evaluateIn: namespace)].
  opts message selector
    sendTo: (opts message arguments collect: [| :arg | arg evaluateIn: namespace])
    &optionals: optValues contents
].

Syntax addPrototype: #Message derivedFrom: {Syntax Node}.
"Represents a message send."
Syntax Message addSlot: #selector valued: #'' .
Syntax Message addSlot: #arguments valued: {}.

message@(Syntax Message traits) sending: selector to: arguments
[| newMessage |
  newMessage: message clone.
  newMessage selector: selector.
  newMessage arguments: arguments.
  newMessage
].

message@(Syntax Message traits) walk: block
[
  resend.
  message arguments
    do: [| :argument | argument walk: block]
].

message@(Syntax Message traits) transformChildren: block
[
  message arguments infect: [| :argument | argument transformBy: block].
  message
].

message@(Syntax Message traits) deepCopy: scope
[| newMessage |
  newMessage: message clone.
  newMessage arguments: (message arguments collect: [| :argument | argument deepCopy: scope]).
  newMessage
].

message@(Syntax Message traits) evaluateIn: namespace
"Overridden to support the evaluateIn: for ImplicitArgument."
[
  message selector sendTo:
    (message arguments collect: [| :argument | argument evaluateIn: namespace])
].

b@(Syntax Node traits) allSelectors
"Answer an Array of all selectors sent in the source."
[| result |
  result: {} writer.
  b walk: [| :node | (node is: Syntax Message) ifTrue:
    [result nextPut: node selector]].
  result contents
].

Syntax addPrototype: #UnaryMessage derivedFrom: {Syntax Message}.

message@(Syntax UnaryMessage traits) sending: selector
"Send the selector to the implicit context."
[message sending: selector to: {Syntax ImplicitArgument}].

node@(Syntax UnaryMessage traits) argument
[node arguments first].

Syntax addPrototype: #BinaryMessage derivedFrom: {Syntax Message}.

Syntax addPrototype: #KeywordMessage derivedFrom: {Syntax Message}.

Syntax addPrototype: #Literal derivedFrom: {Syntax Node}.
Syntax Literal addSlot: #value.

node@(Syntax Literal traits) for: obj
[| newNode |
  newNode: node clone.
  newNode value: obj.
  newNode
].

node@(Syntax Literal traits) evaluateIn: namespace
"A literal just evaluates to its expression-value."
[
  node value
].

b@(Syntax Node traits) allLiterals
"Answer an Array of all literal values from the source."
[| result |
  result: {} writer.
  b walk: [| :node | (node is: Syntax Literal) ifTrue:
    [result nextPut: node value]].
  result contents
].

Syntax addPrototype: #CompoundStatement derivedFrom: {Syntax Node}.
Syntax CompoundStatement addSlot: #statements valued: {}.

array@(Sequence traits) as: group@(Syntax CompoundStatement traits)
[| newGroup |
  newGroup: group clone.
  newGroup statements: (array as: group statements).
  newGroup
].

group@(Syntax CompoundStatement traits) size
"The number of statements/elements in the expression."
[group statements size].

group@(Syntax CompoundStatement traits) walk: block
[
  resend.
  group statements
    do: [| :statement | statement walk: block]
].

group@(Syntax CompoundStatement traits) transformChildren: block
[
  group statements infect: [| :statement | statement transformBy: block].
  group
].

Syntax addPrototype: #Array derivedFrom: {Syntax CompoundStatement}.

group@(Syntax Array traits) deepCopy: scope
[
  (group statements collect:
    [| :statement | statement deepCopy: scope]) as: group
].

group@(Syntax Array traits) evaluateIn: namespace
[
  group statements collect: [| :statement | statement evaluateIn: namespace]
].

Syntax addPrototype: #Parenthesis derivedFrom: {Syntax CompoundStatement}.

group@(Syntax Parenthesis traits) evaluateIn: namespace
[
  group statements isEmpty
    ifTrue: [Nil]
    ifFalse:
      [
        group statements allButLastDo: [| :statement | statement evaluateIn: namespace].
        group statements last evaluateIn: namespace
      ]
].

Syntax addPrototype: #Namespace derivedFrom: {Syntax Node}.
Syntax Namespace addSlot: #namespace valued: lobby.

node@(Syntax Namespace traits) for: namespace
[| newNode |
  newNode: node clone.
  newNode namespace: namespace.
  newNode
].

_@(Syntax Namespace traits) evaluateIn: namespace
[shouldNotImplement].

_@(Syntax Namespace traits) parentScope
[
  error: 'The top-level namespace has no parent scope.'
].

node@(Syntax Namespace traits) topLevel
[
  node
].

_@(Syntax Namespace traits) findVariable: _
"Present for compatibility with Block findVariable:."
[Nil].

Syntax addImmutableSlot: #Lobby valued: (Syntax Namespace for: lobby).

Syntax addPrototype: #Block derivedFrom: {Syntax CompoundStatement}.
Syntax Block addSlot: #parentScope valued: Syntax Lobby.
Syntax Block addSlot: #inputVariables valued: {}.
Syntax Block addSlot: #restVariable valued: Nil.
Syntax Block addSlot: #optionalKeywords valued: {}.
Syntax Block addSlot: #optionalVariables valued: {}.
Syntax Block addSlot: #localVariables valued: {}.

block@(Syntax Block traits) compile
"Invoke the VM ByteCompiler."
[
  VM ByteCompiler newEmpty generate: block
].

block@(Syntax Block traits) compileAndRun
"Compile the block using the VM ByteCompiler and then run it."
[
  (block compile) do
].

block@(Syntax Block traits) evaluateIn: namespace
"Compile the block and return it."
[block compile].

b@(Syntax Block traits) newEmpty
[| newB |
  newB: b clone.
  newB localVariables: b localVariables newEmpty.
  newB
].

b@(Syntax Block traits) newFor: body@(Syntax Node traits)
"Creates a new Block with the given node as the body."
[| newB |
  newB: b newEmpty.
  newB statements: {body}.
  newB
].

b@(Syntax Block traits) newFor: body@(Syntax Parenthesis traits)
"Takes the statements as the body of the new block."
[| newB |
  newB: b newEmpty.
  newB statements: body statements.
  newB
].

block@(Syntax Block traits) addVariableNamed: name
[| var | 
  var: Syntax Variable clone.
  var name: name.
  var scope: block.
  block localVariables: block localVariables ; { var }.
  var
].

block@(Syntax Block traits) addInputVariableNamed: name
[| var |
  var: (block addVariableNamed: name).
  block inputVariables: block inputVariables ; { var }.
  var
].
 
block@(Syntax Block traits) addOptionalKeyword: key named: name
[| var |
  var: (block addVariableNamed: name).
  block optionalKeywords: block optionalKeywords ; { key }.
  block optionalVariables: block optionalVariables ; { var }.
  var
].

block@(Syntax Block traits) topLevel
[
  block parentScope topLevel
].

block@(Syntax Block traits) findVariable: name
"Searches through the current scope, and then upward, for the entry
corresponding to the given name, and answers what it can find, or Nil if none."
[
  block localVariables 
    detect: [| :var | var name = name]
    ifNone: [block parentScope findVariable: name]
].

b@(Syntax Block traits) deepCopy: scope
[| newBlock |
  newBlock: b clone.
  newBlock parentScope: scope.
  newBlock
    localVariables:
      (b localVariables collect: [| :var | var deepCopy: scope]).
  newBlock 
    inputVariables:
      (b inputVariables collect: [| :var | newBlock findVariable: var name]).
  newBlock
    optionalVariables:
      (b optionalVariables collect: [| :var | newBlock findVariable: var name]).
  newBlock restVariable: (newBlock findVariable: b restVariable name).
  newBlock 
    statements: 
      (b statements collect: [| :statement | statement deepCopy: newBlock]).
  newBlock
].

dst@(Syntax Block traits) addVariablesFrom: src@(Syntax Block traits)
"Copies over the local variable entries from the source block to the
destination. Answers the locals found."
[
  src localVariables
    do:
      [| :var |
        (dst localVariables detect: [| :conflict | conflict name = var name])
          ifNotNil:
            [name: (('|' ; (dst localVariables size as: String)) as: Symbol).
             var name: name].
        dst localVariables: dst localVariables ; { var }].
  src localVariables
].

_@(Syntax Block traits) linkVariablesIn: node
[
  node
].

b@(Syntax Block traits) linkVariablesIn: msg@(Syntax UnaryMessage traits)
[
  (msg arguments first isSameAs: Syntax ImplicitArgument)
    ifFalse: [^ msg].
  (b findVariable: msg selector)
    ifNil:
      [msg]
    ifNotNilDo:
      [| :var |
        Syntax LoadVariable from: var]
].

b@(Syntax Block traits) linkVariablesIn: msg@(Syntax KeywordMessage traits)
[
  ((msg arguments first isSameAs: Syntax ImplicitArgument)
    and: [msg arguments size = 2]) 
    ifFalse: [^ msg].
  (b findVariable: msg selector name allButLast intern)
    ifNil:
      [msg]
    ifNotNilDo:
      [| :var |
        Syntax StoreVariable of: msg arguments second into: var]
].

b@(Syntax Block traits) linkVariables
[
   b transformBy: [| :node | b linkVariablesIn: node]
].

Syntax addPrototype: #MethodDefinition derivedFrom: {Syntax Block}.
Syntax MethodDefinition addSlot: #selector.
Syntax MethodDefinition addSlot: #roles valued: {}.

method@(Syntax MethodDefinition traits) walk: block
[
  resend.
  method roles do: [| :role | role ifNotNil: [role walk: block]]
].

method@(Syntax MethodDefinition traits) transformChildren: block
[
  method roles infect: [| :role | role ifNotNil: [role transformBy: block]].
  resend
].

method@(Syntax MethodDefinition traits) deepCopy: scope
[| newMethod |
  newMethod: resend.
  newMethod 
    roles:
      (method roles
        collect: [| :role | role ifNotNil: [role deepCopy: scope]]).
  newMethod
].

method@(Syntax MethodDefinition traits) evaluateIn: namespace
[
  resend 
    asMethod: method selector 
    on: 
      (method roles collect: [| :role | role evaluateIn: namespace])
].

Syntax addPrototype: #Variable derivedFrom: {Syntax Node}.
Syntax Variable addSlot: #name.
Syntax Variable addSlot: #scope.

var@(Syntax Variable traits) deepCopy: scope
[
  scope findVariable: var name
].

Syntax addPrototype: #LoadVariable derivedFrom: {Syntax Node}.
Syntax LoadVariable addSlot: #variable.

load@(Syntax LoadVariable traits) from: variable
[| newLoad |
  newLoad: load clone.
  newLoad variable: variable.
  newLoad
].

load@(Syntax LoadVariable traits) deepCopy: scope
[
  (scope findVariable: load variable name)
    ifNil: [Syntax UnaryMessage sending: load variable name
				      to: {Syntax ImplicitArgument}]
    ifNotNil: [load from: (load variable deepCopy: scope)]
].

Syntax addPrototype: #StoreVariable derivedFrom: {Syntax Node}.
Syntax StoreVariable addSlot: #variable.
Syntax StoreVariable addSlot: #value.

store@(Syntax StoreVariable traits) of: value into: variable
[| newStore |
  newStore: store clone.
  newStore value: value.
  newStore variable: variable.
  newStore
].

store@(Syntax StoreVariable traits) walk: block
[
  resend.
  store value walk: block
].

store@(Syntax StoreVariable traits) transformChildren: block
[
  store value: (store value transformBy: block).
  store
].

store@(Syntax StoreVariable traits) deepCopy: scope
[
  (scope findVariable: store variable name)
    ifNil:
      [Syntax KeywordMessage
	sending: ((store variable name as: String) ; ':' as: Symbol)
	to: {Syntax ImplicitArgument. store value deepCopy: scope}]
    ifNotNil: [store of: (store variable deepCopy: scope)
		     into: (store value deepCopy: scope)]
].

Syntax addPrototype: #Return derivedFrom: {Syntax Node}.
Syntax Return addSlot: #value.

ret@(Syntax Return traits) of: value
[| newRet |
  newRet: ret clone.
  newRet value: value.
  newRet
].

ret@(Syntax Return traits) walk: block
[
  resend.
  ret value walk: block
].

ret@(Syntax Return traits) deepCopy: scope
[
  ret of: (ret value deepCopy: scope)
].

ret@(Syntax Return traits) transformChildren: block
[
  ret value: (ret value transformBy: block).
  ret
].

Syntax addPrototype: #ReturnClose derivedFrom: {Syntax Return}.
Syntax addPrototype: #ReturnFar derivedFrom: {Syntax Return}.

Syntax addPrototype: #Resend derivedFrom: {Syntax Node}.

"Non-core utilities follow."

n@(Syntax Node traits) allSelectorsSent
"Answer a Set of selectors for the messages sent in this parse tree."
[| calls |
  calls: (IdentitySet newSize: 100).
  n walk: [| :node |
	   (node is: Syntax Message traits)
	     ifTrue: [calls include: node selector]].
  calls
].

n@(Syntax Node traits) nodeCount
"Answer the number of nodes in this tree, analogous to the size of the tree."
[| count |
  count: 0.
  n walk: [| :_ | count: count + 1].
  count
].

n@(Syntax Node traits) hasExplicitReturn
"Answer whether there is an explicit/early return call."
[
  n walk: [| :node | (node is: Syntax Return) ifTrue: [^ True]].
  False
].