steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

debugger: change vm-errors to use nth instead of at.

db4
John Benediktsson 2014-06-04 08:35:31 -07:00
parent 82486a5f51
commit e351d63bbe
1 changed files with 40 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

79
basis/debugger/debugger.factor
View File

@ -1,16 +1,16 @@
! Copyright (C) 2004, 2011 Slava Pestov. ! Copyright (C) 2004, 2011 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien.strings slots arrays definitions generic hashtables USING: accessors alien.strings arrays assocs classes
summary io kernel math namespaces make prettyprint classes.builtin classes.mixin classes.tuple classes.tuple.parser
prettyprint.config sequences assocs sequences.private strings combinators combinators.short-circuit compiler.units
io.styles io.pathnames vectors words system splitting continuations definitions destructors effects.parser generic
math.parser classes.mixin classes.tuple continuations generic.math generic.parser generic.single grouping io
continuations.private combinators generic.math classes.builtin io.encodings io.styles kernel lexer make math math.order
classes compiler.units generic.standard generic.single vocabs math.parser namespaces parser prettyprint sequences
init kernel.private io.encodings accessors math.order sequences.private slots source-files.errors strings
destructors source-files parser classes.tuple.parser strings.parser summary system vocabs vocabs.loader vocabs.parser
effects.parser lexer generic.parser strings.parser vocabs.loader words ;
vocabs.parser source-files.errors grouping ; FROM: namespaces => change-global ;
IN: debugger IN: debugger
GENERIC: error-help ( error -- topic ) GENERIC: error-help ( error -- topic )
@ -43,8 +43,7 @@ M: string error. print ;
error-continuation get name>> assoc-stack ; error-continuation get name>> assoc-stack ;
: :res ( n -- * ) : :res ( n -- * )
1 - restarts get-global nth f restarts set-global 1 - restarts [ nth f ] change-global continue-restart ;
continue-restart ;
: :1 ( -- * ) 1 :res ; : :1 ( -- * ) 1 :res ;
: :2 ( -- * ) 2 :res ; : :2 ( -- * ) 2 :res ;
@ -141,40 +140,41 @@ HOOK: signal-error. os ( obj -- )
"Interrupt" print drop ; "Interrupt" print drop ;
PREDICATE: vm-error < array PREDICATE: vm-error < array
dup length 2 < [ drop f ] [
{ {
{ [ dup empty? ] [ drop f ] } [ first-unsafe "kernel-error" = ]
{ [ dup first "kernel-error" = not ] [ drop f ] } [ second-unsafe 0 18 between? ]
[ second 0 18 between? ] } 1&&
} cond ; ] if ;
: vm-errors ( error -- n errors ) : vm-errors ( error -- n errors )
second { second {
{ 0 [ expired-error. ] } expired-error.
{ 1 [ io-error. ] } io-error.
{ 2 [ primitive-error. ] } primitive-error.
{ 3 [ type-check-error. ] } type-check-error.
{ 4 [ divide-by-zero-error. ] } divide-by-zero-error.
{ 5 [ signal-error. ] } signal-error.
{ 6 [ array-size-error. ] } array-size-error.
{ 7 [ c-string-error. ] } c-string-error.
{ 8 [ ffi-error. ] } ffi-error.
{ 9 [ undefined-symbol-error. ] } undefined-symbol-error.
{ 10 [ datastack-underflow. ] } datastack-underflow.
{ 11 [ datastack-overflow. ] } datastack-overflow.
{ 12 [ retainstack-underflow. ] } retainstack-underflow.
{ 13 [ retainstack-overflow. ] } retainstack-overflow.
{ 14 [ callstack-underflow. ] } callstack-underflow.
{ 15 [ callstack-overflow. ] } callstack-overflow.
{ 16 [ memory-error. ] } memory-error.
{ 17 [ fp-trap-error. ] } fp-trap-error.
{ 18 [ interrupt-error. ] } interrupt-error.
} ; inline } ; inline
M: vm-error summary drop "VM error" ; M: vm-error summary drop "VM error" ;
M: vm-error error. dup vm-errors case ; M: vm-error error. dup vm-errors nth execute( x -- ) ;
M: vm-error error-help vm-errors at first ; M: vm-error error-help vm-errors nth ;
M: no-method summary M: no-method summary
drop "No suitable method" ; drop "No suitable method" ;
@ -351,8 +351,7 @@ M: row-variable-can't-have-type summary
drop "Stack effect row variables cannot have a declared type" ; drop "Stack effect row variables cannot have a declared type" ;
M: bad-escape error. M: bad-escape error.
"Bad escape code: \\" write "Bad escape code: \\" write char>> 1string print ;
char>> 1string print ;
M: bad-literal-tuple summary drop "Bad literal tuple" ; M: bad-literal-tuple summary drop "Bad literal tuple" ;