conditions addSlot: #DebugConsole valued: Console.
"The interaction to which Error messages are sent and handler input is
received. This should be StdErr and overridable."

conditions addPrototype: #Debugger derivedFrom: {Cloneable}.
conditions Debugger addSlot: #condition.
"The Condition that raised the debugging context."
conditions Debugger addSlot: #restarts valued: ExtensibleArray newEmpty.
"The available Restart objects, in linear precedence order."

c@(Condition traits) invokeDebugger
"The hook for any Condition to start the debugger and enter its loop."
[| debug |
  debug: Debugger clone.
  debug condition: c.
  debug restarts: debug restarts newEmpty.
  debug enter
].

d@(Debugger traits) printBacktrace
"Shows the sequence of method calls, with source location or primitive-ness
information per line, up until the actual Condition-signalling."
[
  False
].

d@(Debugger traits) findRestarts
"Rebuilds the list of applicable restarts."
[
  d restarts clear.
  conditionStack
    reverseDo:
      [| :context |
        ((context is: Restart) and: [context appliesTo: d condition])
          ifTrue: [d restarts addLast: context]].
  d restarts
].

d@(Debugger traits) describeRestarts
"Describes the restarts available in the context, if any."
[
  DebugConsole ; 'The following condition was signaled:\n'.
  d condition describe.
  DebugConsole ; '\n'.
  DebugConsole ; (d restarts isEmpty
    ifTrue: ['No restarts are available.\n']
    ifFalse: ['The following restarts are available:\n']).
  d restarts
    doWithIndex:
      [| :restart :index |
        DebugConsole ; index print ; ')\t'.
        restart describe]
].

d@(Debugger traits) queryRestart
"Prints out the restarting options with a prompt and numeric labels, and reads
in the selected option number, returning it if valid."
[| line restart |
  DebugConsole ; 'Debug'.
  d restarts isEmpty
    ifFalse: [DebugConsole ; ' [0'.
	      d restarts size > 1 ifTrue:
		[DebugConsole ; '..' ; d restarts indexLast print].
	      DebugConsole ; ']'].
  DebugConsole ; ': '.
  [line: (DebugConsole reader upTo: $\n).
    line isEmpty] whileTrue.
  (line size > 0 and: [line allSatisfy: [| :c | c isDigit]])
    ifFalse: [^ Nil].
  restart: ((line as: String) as: Integer).
  (d restarts acceptsKey: restart)
    ifTrue: [restart]
    ifFalse: [Nil]
].

d@(Debugger traits) signalRestartAt: index
"Takes the restart option number from the queryRestart and invokes it."
[| restart |
  restart: ((d restarts at: index) newCondition: (d condition)).
  restart query.
  restart signal
].

d@(Debugger traits) enter
"The main interactive debugger loop."
[
  [
    d printBacktrace.
    d findRestarts.
    d describeRestarts.
    d queryRestart
      ifNotNilDo: [| :index | d signalRestartAt: index]
  ] loop
].