! Copyright (C) 2004, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: slots arrays definitions generic hashtables summary io
-kernel math namespaces make prettyprint prettyprint.config
-sequences assocs sequences.private strings io.styles
-io.pathnames vectors words system splitting math.parser
-classes.mixin classes.tuple continuations continuations.private
-combinators generic.math classes.builtin classes compiler.units
-generic.standard generic.single vocabs init kernel.private io.encodings
-accessors math.order destructors source-files parser
-classes.tuple.parser effects.parser lexer
+USING: slots arrays definitions generic hashtables summary io kernel
+math namespaces make prettyprint prettyprint.config sequences assocs
+sequences.private strings io.styles io.pathnames vectors words system
+splitting math.parser classes.mixin classes.tuple continuations
+continuations.private combinators generic.math classes.builtin classes
+compiler.units generic.standard generic.single vocabs init
+kernel.private io.encodings accessors math.order destructors
+source-files parser classes.tuple.parser effects.parser lexer
generic.parser strings.parser vocabs.loader vocabs.parser see
source-files.errors ;
IN: debugger
GENERIC: error-help ( error -- topic )
M: object error. . ;
+
M: object error-help drop f ;
M: tuple error-help class ;
error-continuation get name>> assoc-stack ;
: :res ( n -- * )
- 1- restarts get-global nth f restarts set-global restart ;
+ 1 - restarts get-global nth f restarts set-global restart ;
: :1 ( -- * ) 1 :res ;
: :2 ( -- * ) 2 :res ;
: restart. ( restart n -- )
[
- 1+ dup 3 <= [ ":" % # " " % ] [ # " :res " % ] if
+ 1 + dup 3 <= [ ":" % # " " % ] [ # " :res " % ] if
name>> %
] "" make print ;
"Object did not survive image save/load: " write third . ;
: io-error. ( error -- )
- "I/O error: " write third print ;
+ "I/O error #" write third . ;
: type-check-error. ( obj -- )
"Type check error" print
: array-size-error. ( obj -- )
"Invalid array size: " write dup third .
- "Maximum: " write fourth 1- . ;
+ "Maximum: " write fourth 1 - . ;
: c-string-error. ( obj -- )
"Cannot convert to C string: " write third . ;
: ffi-error. ( obj -- )
- "FFI: " write
- dup third [ write ": " write ] when*
- fourth print ;
+ "FFI error" print drop ;
: heap-scan-error. ( obj -- )
"Cannot do next-object outside begin/end-scan" print drop ;
: undefined-symbol-error. ( obj -- )
- "The image refers to a library or symbol that was not found"
- " at load time" append print drop ;
+ "The image refers to a library or symbol that was not found at load time"
+ print drop ;
: stack-underflow. ( obj name -- )
write " stack underflow" print drop ;
M: no-current-vocab summary
drop "Not in a vocabulary; IN: form required" ;
-M: no-word-error error.
- "No word named ``" write name>> write "'' found in current vocabulary search path" print ;
+M: no-word-error summary
+ name>>
+ "No word named ``"
+ "'' found in current vocabulary search path" surround ;
+
+M: no-word-error error. summary print ;
+
+M: no-word-in-vocab summary
+ [ vocab>> ] [ word>> ] bi
+ [ "No word named ``" % % "'' found in ``" % % "'' vocabulary" % ] "" make ;
+
+M: no-word-in-vocab error. summary print ;
+
+M: ambiguous-use-error summary
+ words>> first name>>
+ "More than one vocabulary defines a word named ``" "''" surround ;
+
+M: ambiguous-use-error error. summary print ;
M: staging-violation summary
drop
{
{ [ os windows? ] [ "debugger.windows" require ] }
{ [ os unix? ] [ "debugger.unix" require ] }
-} cond
\ No newline at end of file
+} cond