Added a Binding Syntax node and implemented bindTo: to use it, enforcing immutable...

[cslatevm.git] / src / syntax / node.slate

ensureNamespace: #nodes &delegate: True.

nodes define: #Node &parents: {Cloneable} &slots:
{#type -> Types Any. "The annotated type, by the inferencer or manually."
 #source -> Nil. "The source of the lexer stream"
 #lineNumber -> Nil "The line number in the source code at which the node was read."}.
"The general syntax object for expressions."

node@(nodes Node traits) new
[resend `setting: #{#type. #lineNumber} to: {Types Any. Nil}].

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

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

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

node@(nodes 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@(nodes 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@(nodes 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@(nodes Node traits) deepCopy
"Copies the entire syntax tree with the (default) scope being the lobby."
[
  node deepCopy: nodes Ground
].

node@(nodes Node traits) definitionLocation
[
  (node source hasSlotNamed: #resource)
    ifTrue: [node source resource locator
               ifNil: ['stdin:' ; (node lineNumber - 2) printString]
               ifNotNilDo: [| :loc | (loc as: String) ; ':' ; node lineNumber printString]]
    ifFalse: [node source
                ifNil: ['Nil']
                ifNotNil: [node source printString ; ':' ; node lineNumber printString]]
].

nodes define: #Annotation &parents: {nodes Node}
  &slots: {#value "The annotated node."}.
"A wrapper for other Nodes that adds an annotative object."

x@(nodes Annotation traits) = y@(nodes Annotation traits)
[x value = y value].

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

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

ann@(nodes Annotation traits) deepCopy: scope
[ann clone `setting: #{#value} to: {ann value deepCopy: scope}].

ann@(nodes Annotation traits) evaluateIn: namespace
[ann value evaluateIn: namespace].

nodes define: #Comment &parents: {nodes Annotation}
&slots: {#comment -> '' "The comment object, an empty String by default."}.
"Comments are nodes that contain the expression that they annotate."

x@(nodes Comment traits) = y@(nodes Comment traits)
[x value = y value /\ [x comment = y comment]].

node@(nodes Node traits) comment: comment
"Returns a new Comment with the given comment wrapping the original
Node. Usable as a macro."
[nodes Comment clone `setting: #{#comment. #value} to: {comment evaluate. node}].

nodes define: #ImplicitArgument &parents: {nodes Node}.
"Implicit arguments include anything sent to the local context, as well as
the lobby."

node1@(nodes ImplicitArgument traits) = node2@(nodes ImplicitArgument traits)
[True].

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

nodes define: #Message &parents: {nodes Node}
  &slots: {#selector -> #'' . #arguments -> #{}}.
"Represents a message send."

m@(nodes Message traits) prototypeFor: selector
[
  `conditions: (
    [Syntax isUnarySelector: selector] -> [nodes UnaryMessage].
    [Syntax isBinarySelector: selector] -> [nodes BinaryMessage]
  ) otherwise: [nodes KeywordMessage]
].

message@(nodes Message traits) sending: selector to: arguments
[(message prototypeFor: selector) clone `setting: #{#selector. #arguments} to:
  {selector intern. arguments}].

x@(nodes Message traits) as: y@(nodes Message traits)
[y sending: x selector to: x arguments].

node1@(nodes Message traits) = node2@(nodes Message traits)
[
  node1 selector = node2 selector
   /\ [node1 isSameAs: node2]
   /\ [node1 arguments = node2 arguments]
].

message@(nodes Message traits) walk: block
[
  resend.
  message arguments do: #(_ walk: block) `er
].

message@(nodes Message traits) transformChildren: block
[
  message arguments infect: #(_ transformBy: block) `er.
  message
].

message@(nodes Message traits) deepCopy: scope
[
  message clone `>> [arguments := message arguments collect: #(deepCopy: scope) `er. ]
].

message@(nodes Message traits) evaluateIn: namespace &optionals: opts
"Overridden to support the evaluateIn: for ImplicitArgument."
[
  message selector sendTo:
    (message arguments collect: #(evaluateIn: namespace) `er)
    &optionals: opts
].

b@(nodes Node traits) allSelectorsSent
"Answer a Set of all selectors sent in the source."
[
  [| :result |
   b walk: [| :node | (node is: nodes Message) ifTrue:
     [result nextPut: node selector.
      ({#sendTo:. #sendTo:through:} includes: result selector)
        /\ [node arguments first is: Symbol]
        ifTrue: [result nextPut: node arguments first]]]]
    writingAs: IdentitySet
].

nodes define: #UnaryMessage &parents: {nodes Message}.

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

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

nodes define: #BinaryMessage &parents: {nodes Message}.
nodes define: #KeywordMessage &parents: {nodes Message}.

nodes define: #Macro &parents: {nodes Message}.
"Macro nodes are just like regular message-sends, except being applied at
compile-time to the Node trees for the expressions."

macro@(nodes Macro traits) evaluateIn: namespace &optionals: opts
"Evaluate the expansion. Should this be relied on? (I.e. should this throw a
condition which is resumable via macro-expansion?)"
[
  (macro macroExpand &optionals:
    (opts
      ifNotNil:
        [nodes OptionalKeywords new `>>
           [message := macro.
            keywords := opts atAll: (0 below: opts size by: 2).
            arguments := opts atAll: (1 below: opts size by: 2). ]]))
    evaluateIn: namespace
].

m@(nodes Macro traits) prototypeFor: selector
[
  `conditions: (
    [Syntax isUnarySelector: selector] -> [nodes UnaryMacro].
    [Syntax isBinarySelector: selector] -> [nodes BinaryMacro]
  ) otherwise: [nodes KeywordMacro]
].

nodes define: #UnaryMacro &parents: {nodes Macro}.
nodes define: #BinaryMacro &parents: {nodes Macro}.
nodes define: #KeywordMacro &parents: {nodes Macro}.

nodes define: #Deferred &parents: {nodes Message}.
"Deferred nodes are just like regular message-sends, except being applied
only when all argument promises are entirely resolved."

message@(nodes Message traits) deferred
[message as: nodes Deferred].

message@(nodes Deferred traits) evaluateIn: namespace &optionals: opts
[
  (message arguments collect: #(evaluateIn: namespace) `er)
    whenFulfilled: [| *args |
      message selector sendTo: args &optionals: opts]
].

m@(nodes Deferred traits) prototypeFor: selector
[
  `conditions: (
    [Syntax isUnarySelector: selector] -> [nodes UnaryDeferred].
    [Syntax isBinarySelector: selector] -> [nodes BinaryDeferred]
  ) otherwise: [nodes KeywordDeferred]
].

nodes define: #UnaryDeferred &parents: {nodes Deferred}.
nodes define: #BinaryDeferred &parents: {nodes Deferred}.
nodes define: #KeywordDeferred &parents: {nodes Deferred}.

nodes define: #MessageWrapper &parents: {nodes Node}
  &slots: {#message}.

w@(nodes MessageWrapper traits) for: message
[w new `setting: #{#message} to: {message}].

w@(nodes MessageWrapper traits) selector
[w message selector].

w@(nodes MessageWrapper traits) transformChildren: block
[
  w message := w message transformBy: block.
  w
].

w@(nodes MessageWrapper traits) walk: block
[
  block applyWith: w.
  w message walk: block.
].

w@(nodes MessageWrapper traits) deepCopy: scope
[
  w clone `>> [message := w message deepCopy: scope. ]
].

nodes define: #OptionalKeywords &parents: {nodes MessageWrapper}
  &slots: {#keywords -> {}. #arguments -> {}}.
"Annotates a Message with optional keywords and values given."

x@(nodes OptionalKeywords traits) = y@(nodes OptionalKeywords traits)
[x message = y message /\ [x keywords = y keywords] /\ [x arguments = y arguments]].

opts@(nodes OptionalKeywords traits) new
[resend clone `setting: #{#keywords. #arguments} to: #{{}. {}}].

opts@(nodes OptionalKeywords traits) walk: block
[
  resend.
  opts arguments
    do: #(walk: block) `er
].

opts@(nodes OptionalKeywords traits) transformChildren: block
[
  resend.
  opts arguments infect: #(_ transformBy: block) `er.
  opts
].

opts@(nodes OptionalKeywords traits) deepCopy: scope
[
  resend `>> [arguments := opts arguments collect: #(deepCopy: scope) `er. ]
].

opts@(nodes OptionalKeywords traits) evaluateIn: namespace
[
  opts message evaluateIn: namespace &optionals:
    ([| :result |
       opts keywords with: opts arguments
         do: [| :key :arg | result nextPutAll: {key intern. arg evaluateIn: namespace}]
     ] writingAs: #{})
].

nodes define: #RestArguments &parents: {nodes MessageWrapper}
  &slots: {#arguments}.

x@(nodes RestArguments traits) = y@(nodes RestArguments traits)
[x message = y message /\ [x arguments = y arguments]].

rest@(nodes RestArguments traits) new
[resend clone `setting: #{#arguments} to: #{{}}].

rest@(nodes RestArguments traits) walk: block
[
  resend.
  rest arguments do: #(_ walk: block) `er
].

rest@(nodes RestArguments traits) transformChildren: block
[
  resend.
  rest arguments infect: #(_ transformBy: block) `er.
  rest
].

rest@(nodes RestArguments traits) deepCopy: scope
[
  resend `>> [arguments := rest arguments collect: #(deepCopy: scope) `er. ]
].

rest@(nodes RestArguments traits) allArguments
[
  rest message arguments ; rest arguments
].

rest@(nodes RestArguments traits) evaluateIn: namespace &optionals: opts
[
  rest selector sendTo:
    (rest allArguments collect: #(evaluateIn: namespace) `er)
    &optionals: opts
].

nodes define: #Placeholder &parents: {nodes Node}.

node@(nodes Node traits) as: _@(nodes Placeholder traits)
[
  node
].

node@(nodes UnaryMessage traits) as: ph@(nodes Placeholder traits)
[
  node selector = #_ /\ [node arguments first == nodes ImplicitArgument]
    ifTrue: [ph] ifFalse: [node]
].

ph@(nodes Placeholder traits) evaluateIn: namespace &optionals: opts
[
  ph
].

nodes define: #Pattern &parents: {nodes MessageWrapper}.
"Pattern nodes are just like regular message-sends, except having only
some arguments filled initially at parse-time. They may be treated as
records or curry-able message-sends."

pattern@(nodes Pattern traits) keywords
[pattern selector keywords].

pattern@(nodes Pattern traits) values
[pattern message arguments].

nodes Pattern traits define: #BlankTokens &builder:
  [{nodes Placeholder. nodes ImplicitArgument}].

pattern@(nodes Pattern traits) isPlaceholder: node
[
  pattern BlankTokens includes: node
].

pattern@(nodes Pattern traits) arity
[| count countedImplicit |
  count := 0.
  pattern walk:
    [| :node |
     `conditions: (
        [node == nodes Placeholder]
          -> [count += 1].
        [node == nodes ImplicitArgument /\ [countedImplicit isNil]]
          -> [countedImplicit := node. count += 1]
    )].
  count
].

pattern@(nodes Pattern traits) isComplete
"Answers whether it can be evaluated successfully."
[
  pattern walk: [| :node | node == nodes Placeholder ifTrue: [^ False]].
  True
].

pattern@(nodes Pattern traits) completeWith: values
[| valuesIn countedImplicit |
  valuesIn := values reader.
  pattern transformBy:
    [| :node |
     valuesIn isAtEnd
       ifTrue: [node]
       ifFalse:
         [`conditions: (
            [node == nodes ImplicitArgument /\ [countedImplicit isNil]]
              -> [countedImplicit := node. valuesIn next].
            [node == nodes Placeholder]
              -> [valuesIn next]
          ) otherwise: [node]]]
].

pattern@(nodes Pattern traits) deepCopy: scope
[
  pattern for: (pattern message deepCopy: scope)
].

pattern@(nodes Pattern traits) evaluateIn: namespace &optionals: opts
"Patterns are auto-quasiquoting, in that their arguments get evaluated,
but the message is not sent."
[
  pattern for: pattern message clone `>>
    [arguments := pattern message arguments collect: #(evaluateIn: namespace) `er. ]
].

nodes define: #Literal &parents: {nodes Node} &slots: {#value}.
"The syntax for a literal Slate object, i.e. something the Lexer can create
directly."

nodes Literal traits define: #ReusableValues &builder: [Dictionary new].
nodes Literal traits define: #Nil &builder: [nodes Literal clone].

l@(nodes Literal traits) noteReusable: obj
[l ReusableValues at: obj ifAbsentPut:
  [l new `setting: #{#value} to: {obj}]].

[| :each | nodes Literal noteReusable: each] for:
  {Array new. ByteArray new. #''. ''}.

node@(nodes Literal traits) for: obj
[node ReusableValues at: obj ifAbsent: [node new `setting: #{#value} to: {obj}]].

node@(nodes Literal traits) for: _@Nil [node Nil].

x@(nodes Literal traits) = y@(nodes Literal traits)
[x value = y value].

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

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

nodes define: #CompoundStatement &parents: {nodes Node}
  &slots: {#statements -> #{}}.

array@(Sequence traits) as: group@(nodes CompoundStatement traits)
[group new `setting: #{#statements} to: {array as: group statements}].

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

node1@(nodes CompoundStatement traits) = node2@(nodes CompoundStatement traits)
[(node1 isSameAs: node2) /\ [node1 statements = node2 statements]].

group@(nodes CompoundStatement traits) walk: block
[
  resend.
  group statements do: #(_ walk: block) `er
].

group@(nodes CompoundStatement traits) transformChildren: block
[
  group statements infect: #(_ transformBy: block) `er.
  group
].

group@(nodes CompoundStatement traits) deepCopy: scope
[
  (group statements collect:
    #(_ deepCopy: scope) `er) as: group
].

nodes define: #Array &parents: {nodes CompoundStatement}.

group@(nodes Array traits) evaluateIn: namespace
[
  group statements collect: #(evaluateIn: namespace) `er
].

nodes define: #Parenthesis &parents: {nodes CompoundStatement}.

group@(nodes Parenthesis traits) evaluateIn: namespace
[
  group statements isEmpty
    ifTrue: [Nil]
    ifFalse:
      [group statements allButLastDo: #(_ evaluateIn: namespace) `er.
       group statements last evaluateIn: namespace]
].

group@(nodes Parenthesis traits) parenthesize
[
  group
].

node@(nodes Node traits) parenthesize
[
  {node} parenthesize
].

seq@(Sequence traits) parenthesize
[
  seq size = 1 ifTrue: [seq first] ifFalse: [seq as: nodes Parenthesis]
].

nodes define: #Namespace &parents: {nodes Node} &slots: {#namespace -> lobby}.

node@(nodes Namespace traits) for: namespace
[node new `setting: #{#namespace} to: {namespace}].

node1@(nodes Namespace traits) = node2@(nodes Namespace traits)
[node1 namespace = node2 namespace].

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

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

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

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

namespace@(nodes Namespace traits) includesScope: scope
[namespace == scope].

nodes define: #Ground &builder: [nodes Namespace for: lobby].

nodes define: #Block &parents: {nodes CompoundStatement} &slots:
{#parentScope -> nodes Ground.
 #inputVariables -> #{}.
"Holds Variable nodes representing the block's inputs in order."
 #restVariable -> Nil.
"Holds a Variable node representing the block's rest parameter if it
accepts one."
 #optionalKeywords -> #{}.
 #optionalVariables -> #{}.
"Holds Variable nodes representing the block's optional local slots."
 #localVariables -> #{}
"Holds Variable nodes representing the block's local slots (including
inputs in order and optionals)."}.

node1@(nodes Block traits) = node2@(nodes Block traits)
"TODO: ensure this is correct and that local variable order is ignored."
[
  resend
   /\ [node1 inputVariables = node2 inputVariables]
   /\ [node1 parentScope = node2 parentScope]
   /\ [node1 localVariables = node2 localVariables]
].

block@(nodes Block traits) compile
"Invoke the VM ByteCompiler."
[
  VM SSACompiler new generate: block result: Nil
].

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

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

b@(nodes Block traits) new
[
  resend `>>
   [inputVariables := b inputVariables new.
    localVariables := b localVariables new.
    optionalKeywords := b optionalKeywords new.
    optionalVariables := b optionalVariables new.
    restVariable := Nil. ]
].

b@(nodes Block traits) body: body@(nodes Node traits)
"Makes a given Node the body."
[b statements := {body}].

b@(nodes Block traits) body: body@(nodes Parenthesis traits)
"Takes the statements as the body of the block."
[b statements := body statements].

b@(nodes Block traits) newFor: body@(nodes Node traits)
"Creates a new Block with the given node as the body."
[b new `>> [body := body. ]].

block@(nodes Block traits) addVariable: var
"Adds the Variable node to the block's locals and sets it as the
variable's scope (used to compile closures properly), and answers it."
[
  (block localVariables anySatisfy: [| :other | other name = var name])
    ifTrue:
      [var name := block uniqueVariableName].
  var scope := block.
  block localVariables := block localVariables ; { var }.
  var
].

block@(nodes Block traits) addVariableNamed: name
"Creates a new Variable with the given name and adds it as a local,
then returning it."
[block addVariable: (nodes Variable clone `setting: #{#name} to: {name})].

block@(nodes Block traits) uniqueVariableName &prefix: prefix
[| nameIndex |
  prefix `defaultsTo: '_'.
  nameIndex := 0.
  [nameIndex < 100 /\
     [(block findVariable: (prefix ; nameIndex printString) intern) isNotNil]]
    whileTrue:
      [nameIndex += 1].
  nameIndex < 100
    ifFalse:
      [error: 'Could not generate a unique variable name.'].
  (prefix ; nameIndex printString) intern
].

block@(nodes Block traits) addVariable &name: name &prefix: prefix
"Calls addVariable: with a name guaranteed not to clash with other such names."
[
  name `defaultsTo: (block uniqueVariableName &prefix: prefix).
  block addVariableNamed: name
].

block@(nodes Block traits) addInputVariableNamed: name
"Creates a new Variable with the given name and adds it as an input,
then returning it."
[| var |
  var := block addVariableNamed: name.
  block inputVariables := block inputVariables ; { var }.
  var
].

block@(nodes Block traits) addInputVariable &name: name &prefix: prefix
"Calls addInputVariable: with a name guaranteed not to clash with other such
names."
[
  name `defaultsTo: (block uniqueVariableName &prefix: prefix).
  block addInputVariableNamed: name
].

block@(nodes Block traits) addOptionalKeyword: key named: name
"Creates a new Variable with the given name and adds it as an optional,
then returning it."
[| var |
  var := block addVariableNamed: name.
  block optionalKeywords := block optionalKeywords ; { key intern }.
  block optionalVariables := block optionalVariables ; { var }.
  var
].

block@(nodes Block traits) topLevel
"Recurses up the scope to find the top-level scope."
[
  block parentScope topLevel
].

block@(nodes Block traits) outermostBlock
"Answers the outermost scope that is still a Block or MethodDefinition and not
a Namespace."
[| scope |
  scope := block.
  [scope parentScope isSameAs: nodes Namespace]
    whileFalse: [scope := scope parentScope].
  scope
].

block@(nodes Block traits) hasVariableNamed: name
[
  block localVariables anySatisfy: [| :var | name =~ var name]
].

block@(nodes Block traits) outermostScopeNotBinding: name
"Answers the outermost scope that does not have a given binding or slot."
[| scope |
  (block hasVariableNamed: name) ifFalse:
    [scope := block.
     [(scope hasVariableNamed: name) \/ [scope parentScope isSameAs: nodes Namespace]]
       whileFalse: [scope := scope parentScope]].
  scope
].

block@(nodes 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 | name =~ var name]
    ifNone: [block parentScope findVariable: name]
].

block@(nodes Block traits) includesScope: scope
[block == scope \/ [block parentScope includesScope: scope]].

block@(nodes Block traits) from: varNames to: codeBlock &locals: localNames &linkVariables: linkVariables
"Takes an Array of symbol names or Nil's for unnamed variables, and runs the
code block with corresponding VariableNodes as inputs. The code block is
expected to return the method body expression. The method then answers a new
Block with that method body and those input variables."
[| result |
  result := block new.
  varNames do: [| :var | result addInputVariable &name: var].
  localNames ifNotNil: [localNames do: [| :var | result addVariable &name: var]].
  "ASSUME: newFor: does not clear inputs."
  result body := codeBlock applyTo: result localVariables.
  linkVariables ifNotNil: [result linkVariables].
  result
].

b@(nodes Block traits) deepCopy: scope &into: target
"Copies up to the level of the given scope, and sets the scope to that one."
[
  (target ifNil: [b]) clone `>>
   [| :newBlock |
    parentScope := scope.
    localVariables :=
      b localVariables collect:
        [| :var newVar | var clone `>> [scope := newBlock. ]].
    inputVariables :=
      b inputVariables collect: [| :var | newBlock findVariable: var name].
    optionalVariables :=
      b optionalVariables collect: [| :var | newBlock findVariable: var name].
    restVariable :=
      b restVariable ifNotNil: [newBlock findVariable: b restVariable name].
    statements :=
      b statements collect: #(deepCopy: newBlock) `er.
  ]
].

block@(nodes Block traits) deepCopy &into: target
"Copies the entire syntax tree with the (default) scope being the block's parent."
[
  block deepCopy: block parentScope
].

block@(nodes Block traits) as: target@(nodes Block traits)
"This should allow Block and MethodDefinition objects to be converted (with
loss of Signature information, of course."
[block deepCopy &into: target].

block@(nodes Block traits) arity
[block inputVariables size].

dst@(nodes Block traits) addVariablesFrom: src@(nodes Block traits)
"Copies over the local variable entries from the source block to the
destination. Answers the locals found."
[
  src localVariables do: #(dst addVariable: _) `er
].

b@(nodes Block traits) modifiesOwnVariables
"Answers whether there are any direct variable stores."
"TODO: Avoid re-implementing detect:!"
[
  b walk: [| :node | (node is: nodes StoreVariable) ifTrue: [^ True]].
  False
].

b@(nodes Block traits) modifiesInputVariables
"Answers whether there are any direct variable stores to inputs."
[
  b walk: [| :node | (node is: nodes StoreVariable) /\
             [b inputVariables includes: node variable] ifTrue: [^ True]].
  False
].

b@(nodes Block traits) allSelectorsSent
[
  [| :result |
   b walk:
     [| :node |
      (node isSameAs: nodes LoadVariable) \/
        [node isSameAs: nodes StoreVariable]
      ifTrue: [result nextPut: node variable name]
      ifFalse: [(node is: nodes Message)
                ifTrue: [result nextPut: node selector]]].
   ] writingAs: Set
].

b@(nodes Block traits) allSelectorsSentToVar: var
"Answers the Set of all selectors called in this method on the Variable object."
[| loadExpr |
  loadExpr := var load.
  [| :result |
   b statements walk:
     [| :expr | (expr is: nodes Message)
        /\ [expr arguments includes: loadExpr]
        ifTrue: [result nextPut: expr selector]]
   ] writingAs: Set
].

b@(nodes Block traits) allSelectorsSentToInputAt: argIndex
"Answers the Set of all selectors called in this method on the argument object."
[
  (b inputVariables acceptsKey: argIndex)
    ifTrue: [b allSelectorsSentToVar: (b inputVariables at: argIndex)]
    ifFalse: [error: 'No such input argument.']
].

b@(nodes Block traits) allSelectorsSentToInputs
[
  [| :result |
   b inputVariables keysDo:
     [| :index | result ; (b allSelectorsSentToInputAt: index)].
   ] writingAs: Set
].

b@(nodes Block traits) allSelectorsSentImplicitly
[
  [| :result |
   b statements walk:
     [| :node | (node is: nodes Message)
                ifTrue: [node arguments do:
                  [| :arg | (arg is: nodes LoadVariable) /\
                     [arg variable = nodes ImplicitArgument]
                            ifTrue: [result nextPut: node selector]]]].
   ] writingAs: Set
].

nodes define: #MethodDefinition &parents: {nodes Block}
  &slots: {#selector. #roles -> #{}}.
"The object representing the definition of a Method."

method@(nodes MethodDefinition traits) new
[resend `>> [selector := Nil. roles := method roles new. ]].

method@(nodes MethodDefinition traits) of: selector on: roles
  from: varNames to: codeBlock &locals: localNames &linkVariables: linkVariables
[
  (method from: varNames to: codeBlock &locals: localNames &linkVariables: linkVariables) `>>
    [selector := selector. roles := roles. ]
].

node1@(nodes MethodDefinition traits) = node2@(nodes MethodDefinition traits)
[resend /\ [node1 selector = node2 selector] /\ [node1 roles = node2 roles]].

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

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

method@(nodes MethodDefinition traits) deepCopy: scope &into: target
[
  resend `>>
    [roles := method roles
       collect: [| :role | role ifNotNil: [role deepCopy: scope]]. ]
].

method@(nodes MethodDefinition traits) evaluateIn: namespace
[
  resend
    asMethod: method selector
    on: (method roles collect: #(evaluateIn: namespace) `er)
].

nodes define: #Signature &parents: {nodes Node} &slots: {
  #selector.
  #roles -> #{}.
  #inputVariables -> #{}.
  #restVariable -> Nil.
  #optionalKeywords -> #{}.
  #optionalVariables -> #{}
}.
"The object representing the definition of a Method without the body."

sig@(nodes Signature traits) new
[
  resend `>>
    [selector := Nil.
     roles := sig roles new.
     inputVariables := sig inputVariables new.
     restVariable := Nil.
     optionalKeywords := sig optionalKeywords new.
     optionalVariables := sig optionalVariables new. ]
].

method@(nodes MethodDefinition traits) as: sig@(nodes Signature traits)
[
  sig new `>>
    [selector := method selector.
     roles := method roles.
     inputVariables := method inputVariables.
     inputVariables do: [| :var | var scope := Nil].
     restVariable := method restVariable.
     optionalKeywords := method optionalKeywords.
     optionalVariables := method optionalVariables. ]
].

sig@(nodes Signature traits) as: method@(nodes MethodDefinition traits)
[
  method new `>>
    [| :result |
     selector := sig selector.
     roles := sig roles.
     inputVariables := sig inputVariables copy.
     inputVariables do: [| :var | var scope := result].
     localVariables := result inputVariables copy.
     restVariable := sig restVariable.
     optionalKeywords := sig optionalKeywords.
     optionalVariables := sig optionalVariables. ]
].

node1@(nodes Signature traits) = node2@(nodes Signature traits)
[node1 selector = node2 selector /\ [node1 roles = node2 roles]].

sig@(nodes Signature traits) walk: block
[
  sig roles do: [| :role | role ifNotNil: [role walk: block]]
].

sig@(nodes Signature traits) transformChildren: block
[
  sig roles infect: [| :role | role ifNotNil: [role transformBy: block]].
].

sig@(nodes Signature traits) deepCopy: scope &into: target
[
  resend `>>
    [roles := sig roles
       collect: [| :role | role ifNotNil: [role deepCopy: scope]]. ]
].

sig@(nodes Signature traits) evaluateIn: namespace
[
  sig
].

nodes define: #Variable &parents: {nodes Node} &slots: {
  #name -> #''.
  #scope -> nodes Ground
}.

node1@(nodes Variable traits) = node2@(nodes Variable traits)
[node1 name = node2 name /\ [node1 scope = node2 scope]].

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

var@(nodes Variable traits) isImmutable [False].

nodes define: #Binding &parents: {nodes Variable}.

var@(nodes Binding traits) isImmutable [True].

nodes define: #RestVariable &parents: {nodes Variable}.

nodes define: #VariableOperation &parents: {nodes Node} &slots: {#variable}.

nodes define: #LoadVariable &parents: {nodes VariableOperation} &slots: {}.

load@(nodes LoadVariable traits) from: variable
[load new `setting: #{#variable} to: {variable}].

var@(nodes Variable traits) load
[nodes LoadVariable from: var].

node1@(nodes LoadVariable traits) = node2@(nodes LoadVariable traits)
[node1 variable = node2 variable].

load@(nodes LoadVariable traits) deepCopy: scope
[
  (scope findVariable: load variable name)
    ifNil: [nodes UnaryMessage
              sending: load variable name
              to: {nodes ImplicitArgument}]
    ifNotNilDo: #(load from: _) `er
].

load@(nodes LoadVariable traits) evaluateIn: namespace &optionals: opts
[
  load variable name sendTo: {namespace} &optionals: opts
].

nodes define: #LoadRestVariable &parents: {nodes LoadVariable}.

nodes define: #StoreVariable &parents: {nodes VariableOperation}
  &slots: {#value}.

store@(nodes StoreVariable traits) of: value into: variable
[store new `setting: #{#value. #variable} to: {value. variable}].

var@(nodes Variable traits) store: value
[nodes StoreVariable of: value into: var].

var@(nodes Binding traits) store: value
[error: 'Cannot rebind'].

load@(nodes LoadVariable traits) store: value
[load variable store: value].

store@(nodes StoreVariable traits) load
[store variable load].

node1@(nodes StoreVariable traits) = node2@(nodes StoreVariable traits)
[node1 variable = node2 variable /\ [node1 value = node2 value]].

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

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

store@(nodes StoreVariable traits) deepCopy: scope
[
  (scope findVariable: store variable name)
    ifNil:
      [nodes KeywordMessage
        sending: store variable name name ; ':'
        to: {nodes ImplicitArgument. store value deepCopy: scope}]
    ifNotNilDo:
      [| :var | store of: (store value deepCopy: scope) into: var]
].

store@(nodes StoreVariable traits) evaluateIn: namespace &optionals: opts
[
  (store variable name name ; ':') intern
    sendTo: {namespace. store value evaluateIn: namespace}
    &optionals: opts
].

nodes define: #Return &parents: {nodes Node} &slots: {#value}.

ret@(nodes Return traits) of: value
[ret new `setting: #{#value} to: {value}].

node1@(nodes Return traits) = node2@(nodes Return traits)
[node1 value = node2 value /\ [node1 isSameAs: node2]].

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

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

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

nodes define: #ReturnClose &parents: {nodes Return}.

ret@(nodes ReturnClose traits) selector [#^].

nodes define: #ReturnFar &parents: {nodes Return}.

ret@(nodes ReturnFar traits) selector [#^^].

nodes define: #ReturnLevel &parents: {nodes Return} &slots: {#level -> 1}.

ret@(nodes ReturnLevel traits) selector [('^' ; ret level printString) intern].

ret@(nodes ReturnLevel traits) by: offset
[ret new `setting: #{#level} to: {offset}].

nodes define: #Resend &parents: {nodes Node}.

_@(nodes Resend traits) selector [ #resend ].

node1@(nodes Resend traits) = node2@(nodes Resend traits)
[True].

"Non-core utilities follow."

n@(nodes Node traits) allSelectorsSent
"Answer a Set of selectors for the messages sent in this parse tree."
[
  [| :calls |
   n walk: [| :node | (node is: nodes Message)
                        ifTrue: [calls nextPut: node selector]]]
    writingAs: (IdentitySet new &capacity: 100)
].

n@(nodes Node traits) allMacroSelectorsSent
"Answer a Set of selectors for the macro-messages sent in this parse tree."
[
  [| :calls |
   n walk: [| :node | (node is: nodes Macro)
                        ifTrue: [calls nextPut: node selector]]]
    writingAs: (IdentitySet new &capacity: 100)
].

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

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