prototypes addPrototype: #Method derivedFrom: {Cloneable}.
"The abstract type of Slate Methods, implemented in various ways."
CompiledMethod traits atSlotNamed: #parent0 put: Method traits.
PrimitiveMethod traits atSlotNamed: #parent0 put: Method traits.

m@(Method traits) selector
[Nil].

m@(Method traits) do
[m applyTo: {}].

m@(Method traits) applyWith: x
[m applyTo: {x}].

m@(Method traits) applyWith: x with: y
[m applyTo: {x. y}].

m@(Method traits) applyWith: x with: y with: z
[m applyTo: {x. y. z}].

s@(Symbol traits) sendWith: x
[s sendTo: {x}].

s@(Symbol traits) sendWith: x with: y
[s sendTo: {x. y}].

s@(Symbol traits) sendWith: x with: y with: z
[s sendTo: {x. y. z}].

m@(Method traits) replaceWith: newM on: args
[
  m removeFrom: args.
  newM asMethod: m selector on: args
].

name@(Symbol traits) findSignatureOn: args
"Returns a collection of the objects on which the first-applicable method is
defined for the given arguments."
[| result |
  result: (args newSizeOf: args).
  args doWithIndex:
    [| :each :index |
     ].
  result
].

x@(Root traits) perform: selector
"Included for Smalltalk compatibility and brevity."
[
  selector sendTo: {x}
].

condition@(Method traits) whileTrue: body
[
  [
    condition do
      ifFalse: [^ Nil].
    body do.
  ] loop
].

condition@(Method traits) whileTrue
[
  condition whileTrue: []
].

condition@(Method traits) whileFalse: body
[
  [
    condition do
      ifTrue: [^ Nil].
    body do.
  ] loop
].

condition@(Method traits) whileFalse
[
  condition whileFalse: []
].

count@(Integer traits) timesRepeat: block
[
  [count > 0]
    whileTrue:
      [
        block do.
        count: count - 1
      ]
].

start@(Integer traits) to: end do: block
"Auto-detects the direction of the progression."
[
  start < end
    ifTrue: [start upTo: end do: block]
    ifFalse: [start downTo: end do: block]
].

start@(Integer traits) upTo: end do: block
[
  [start <= end]
    whileTrue:
      [
        block applyWith: start.
        start: start + 1
      ]
].

start@(Integer traits) below: end do: block
[
  [start < end]
    whileTrue:
      [
        block applyWith: start.
        start: start + 1
      ]
].

start@(Integer traits) downTo: end do: block
[
  [start >= end]
    whileTrue:
      [
        block applyWith: start.
        start: start - 1
      ]
].

start@(Integer traits) above: end do: block
[
  [start > end]
    whileTrue:
      [
        block applyWith: start.
        start: start - 1
      ]
].

start@(Number traits) downTo: end by: inc do: block
[
  [start >= end]
    whileTrue: [
      block applyWith: start.
      start: start - inc]
].

start@(Number traits) upTo: end by: inc do: block
[
  [start <= end]
    whileTrue: [
        block applyWith: start.
        start: start + inc]
].

_@(Method traits) newAlwaysReturning: obj
"Answers a new block which takes an argument and ignores it, returning the
one (constant) object it was created for."
[
  [| :_ | obj]
].

Method traits addImmutableSlot: #Identity valued: [| :x | x].
"The method Identity does nothing but return its sole argument."

Method traits addPrototype: #Converse derivedFrom: {Cloneable}.
Method Converse addSlot: #block.
"A Method's converse takes the arguments in reverse to produce the same
result. This implementation works on any method arity, but the client needs
to be aware of this arity, naturally."

m@(Method traits) converse
"Creates a new method converse."
[| newM |
  newM: m Converse clone.
  newM block: m.
  newM
].

mc@(Method Converse traits) converse
"A converse of a converse is the original method."
[
  mc block
].

mc@(Method Converse traits) do
[
  mc block do
].

mc@(Method Converse traits) applyWith: obj
[
  mc block applyWith: obj
].

mc@(Method Converse traits) applyWith: obj1 with: obj2
[
  mc block applyWith: obj2 with: obj1
].

mc@(Method Converse traits) applyWith: obj1 with: obj2 with: obj3
[
  mc block applyWith: obj3 with: obj2 with: obj1
].

mc@(Method Converse traits) applyTo: array
[
  mc block applyTo: array reversed
].

Method traits addPrototype: #Signature derivedFrom: {Cloneable}.
Method Signature addSlot: #selector valued: #'' .
Method Signature addSlot: #roles valued: {}.

sig@(Method Signature traits) newNamed: selector over: roleArray
[| newSig |
  newSig: sig clone.
  newSig selector: selector.
  newSig roles: roleArray.
  newSig
].

m@(Method traits) signatureAsDefined
"Answer a Signature object corresponding to the method's definition. Note that
roles clone with their objects, so a Method really can have many signatures
as such."
"FIXME: This will not work on Methods as is, since they do not currently know
their own signature / remember it."
[
  m Signature newNamed: m selector over: m roles
].

sig1@(Method Signature traits) = sig2@(Method Signature traits)
[
  sig1 selector = sig2 selector and: [sig1 roles = sig2 roles]
].

sig@(Method Signature traits) hash
[
  sig selector hash bitXor: sig roles hash
].

sig@(Method Signature traits) copy
[| newSig |
  newSig: resend.
  newSig roles: sig roles copy.
  newSig
].

sig@(Method Signature traits) isDefined
"Whether a Method is actually installed on the given roles with the same
selector."
[
  (sig selector findSignatureOn: sig roles) = sig roles
].

sig@(Method Signature traits) nearestMethod
[
  sig selector findOn: sig roles
].