diff --git a/doc/handbook/handbook.facts b/doc/handbook/handbook.facts index f672dd875a..2f26418a1e 100644 --- a/doc/handbook/handbook.facts +++ b/doc/handbook/handbook.facts @@ -51,7 +51,7 @@ ARTICLE: "article-index" "Article index" ARTICLE: "primitive-index" "Primitive index" { $outliner [ all-words [ primitive? ] subset ] } ; -ARTICLE: "error-index" "Type index" +ARTICLE: "error-index" "Error index" { $subsection /0 } { $subsection alien-callback-error } { $subsection alien-invoke-error } diff --git a/library/bootstrap/boot-stage1.factor b/library/bootstrap/boot-stage1.factor index 61e2130bc8..076b939de4 100644 --- a/library/bootstrap/boot-stage1.factor +++ b/library/bootstrap/boot-stage1.factor @@ -159,6 +159,8 @@ sequences vectors words ; "/library/cli.factor" "/library/modules.factor" + + "/library/tools/errors.factor" "/library/bootstrap/init.factor" "/library/bootstrap/image.factor" diff --git a/library/compiler/alien/alien-callback.factor b/library/compiler/alien/alien-callback.factor index 19ed08ba42..678842890d 100644 --- a/library/compiler/alien/alien-callback.factor +++ b/library/compiler/alien/alien-callback.factor @@ -9,9 +9,6 @@ C: alien-callback make-node ; TUPLE: alien-callback-error ; -M: alien-callback-error summary ( error -- ) - drop "Words calling ``alien-callback'' cannot run in the interpreter. Compile the caller word and try again." ; - : alien-callback ( return parameters quot -- address ) throw ; diff --git a/library/compiler/inference/inference.factor b/library/compiler/inference/inference.factor index 41a2febc0c..bfccad7552 100644 --- a/library/compiler/inference/inference.factor +++ b/library/compiler/inference/inference.factor @@ -15,12 +15,6 @@ TUPLE: inference-error message rstate data-stack call-stack ; recursive-state get meta-d get meta-r get throw ; -M: inference-error error. ( error -- ) - "Inference error:" print - dup inference-error-message print - "Recursive state:" print - inference-error-rstate describe ; - M: object value-literal ( value -- ) "A literal value was expected where a computed value was found" inference-error ; diff --git a/library/generic/tuple.factor b/library/generic/tuple.factor index 0d98a32ed3..4e390397e6 100644 --- a/library/generic/tuple.factor +++ b/library/generic/tuple.factor @@ -55,7 +55,7 @@ TUPLE: check-tuple class ; : define-constructor ( word class def -- ) pick reset-generic - swap check-tuple-class [ + swap check-tuple [ dup literalize , "tuple-size" word-prop , \ , % diff --git a/library/test/test.factor b/library/test/test.factor index f1d9d4009c..b1345cd240 100644 --- a/library/test/test.factor +++ b/library/test/test.factor @@ -6,7 +6,6 @@ memory namespaces parser prettyprint sequences strings words vectors ; TUPLE: assert got expect ; -M: assert summary drop "Assertion failed" ; : assert ( got expect -- ) throw ; : assert= ( a b -- ) 2dup = [ 2drop ] [ assert ] if ; diff --git a/library/tools/debugger.factor b/library/tools/debugger.factor index c1f395c12e..07194f634e 100644 --- a/library/tools/debugger.factor +++ b/library/tools/debugger.factor @@ -5,150 +5,29 @@ kernel-internals math namespaces parser prettyprint sequences sequences-internals strings styles vectors words ; IN: errors +PREDICATE: array kernel-error ( obj -- ? ) + dup first \ kernel-error eq? swap second 0 18 between? and ; + GENERIC: error. ( error -- ) GENERIC: error-help ( error -- topic ) +M: object error. ( error -- ) . ; M: object error-help ( error -- topic ) drop f ; +M: tuple error. ( error -- ) describe ; M: tuple error-help ( error -- topic ) class ; +M: string error. ( error -- ) print ; + SYMBOL: error SYMBOL: error-continuation SYMBOL: restarts -: expired-error. ( obj -- ) - "Object did not survive image save/load: " write third . ; - -: undefined-word-error. ( obj -- ) - "Undefined word: " write third . ; - -: io-error. ( error -- ) - "I/O error: " write third print ; - -: type-check-error. ( list -- ) - "Type check error" print - "Object: " write dup fourth short. - "Object type: " write dup fourth class . - "Expected type: " write third type>class . ; - -: signal-error. ( obj -- ) - "Operating system signal " write third . ; - -: negative-array-size-error. ( obj -- ) - "Cannot allocate array with negative size " write third . ; - -: c-string-error. ( obj -- ) - "Cannot convert to C string: " write third . ; - -: ffi-error. ( obj -- ) - "FFI: " write third print ; - -: 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 ; - -: user-interrupt. ( obj -- ) - "User interrupt" print drop ; - -: stack-underflow. ( obj name -- ) - write " stack underflow" print drop ; - -: stack-overflow. ( obj name -- ) - write " stack overflow" print drop ; - -! Hook for library/cocoa/ -DEFER: objc-error. ( alien -- ) - -PREDICATE: array kernel-error ( obj -- ? ) - dup first \ kernel-error eq? swap second 0 18 between? and ; - -: datastack-underflow. "Data" stack-underflow. ; -: datastack-overflow. "Data" stack-overflow. ; -: retainstack-underflow. "Retain" stack-underflow. ; -: retainstack-overflow. "Retain" stack-overflow. ; -: callstack-underflow. "Call" stack-underflow. ; -: callstack-overflow. "Call" stack-overflow. ; - -: kernel-error ( error -- word ) - #! Kernel errors are indexed by integers. - second { - expired-error. - io-error. - undefined-word-error. - type-check-error. - signal-error. - negative-array-size-error. - c-string-error. - ffi-error. - heap-scan-error. - undefined-symbol-error. - user-interrupt. - datastack-underflow. - datastack-overflow. - retainstack-underflow. - retainstack-overflow. - callstack-underflow. - callstack-overflow. - } nth ; - -M: kernel-error error. ( error -- ) dup kernel-error execute ; - -M: kernel-error error-help ( error -- topic ) kernel-error ; - -M: no-method summary - drop "No suitable method" ; - -M: no-method error. ( error -- ) - "Generic word " write - dup no-method-generic pprint - " does not define a method for the " write - dup no-method-object class pprint - " class." print - "Allowed classes: " write dup no-method-generic order . - "Dispatching on object: " write no-method-object short. ; - -M: no-math-method summary - drop "No suitable arithmetic method" ; - -: parse-dump ( error -- ) - "Parsing " write - dup parse-error-file [ "" ] unless* write - ":" write - dup parse-error-line [ 1 ] unless* number>string print - - dup parse-error-text dup string? [ print ] [ drop ] if - - parse-error-col [ 0 ] unless* - CHAR: \s write "^" print ; - -M: parse-error error. ( error -- ) - dup parse-dump delegate error. ; - -M: bounds-error summary drop "Sequence index out of bounds" ; - -M: condition error. delegate error. ; - -M: condition error-help drop f ; - -M: tuple error. ( error -- ) describe ; - -M: string error. ( error -- ) print ; - -M: object error. ( error -- ) . ; - -: :s ( -- ) error-continuation get continuation-data stack. ; - -: :r ( -- ) error-continuation get continuation-retain stack. ; - -: :c ( -- ) error-continuation get continuation-call callstack. ; - -: :get ( var -- value ) - error-continuation get continuation-name hash-stack ; - -: :res ( n -- ) restarts get nth first3 continue-with ; +: :s error-continuation get continuation-data stack. ; +: :r error-continuation get continuation-retain stack. ; +: :c error-continuation get continuation-call callstack. ; +: :get error-continuation get continuation-name hash-stack ; +: :res restarts get nth first3 continue-with ; : :help ( -- ) error get delegates [ error-help ] map [ ] subset diff --git a/library/tools/errors.factor b/library/tools/errors.factor new file mode 100644 index 0000000000..3217a321fb --- /dev/null +++ b/library/tools/errors.factor @@ -0,0 +1,171 @@ +! Copyright (C) 2006 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +IN: errors +USING: alien generic help inference inspector io kernel libc +math math-internals parser prettyprint queues sequences +sequences-internals strings test words ; + +: expired-error. ( obj -- ) + "Object did not survive image save/load: " write third . ; + +: undefined-word-error. ( obj -- ) + "Undefined word: " write third . ; + +: io-error. ( error -- ) + "I/O error: " write third print ; + +: type-check-error. ( list -- ) + "Type check error" print + "Object: " write dup fourth short. + "Object type: " write dup fourth class . + "Expected type: " write third type>class . ; + +: signal-error. ( obj -- ) + "Operating system signal " write third . ; + +: negative-array-size-error. ( obj -- ) + "Cannot allocate array with negative size " write third . ; + +: c-string-error. ( obj -- ) + "Cannot convert to C string: " write third . ; + +: ffi-error. ( obj -- ) + "FFI: " write third print ; + +: 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 ; + +: user-interrupt. ( obj -- ) + "User interrupt" print drop ; + +: stack-underflow. ( obj name -- ) + write " stack underflow" print drop ; + +: stack-overflow. ( obj name -- ) + write " stack overflow" print drop ; + +! Hook for library/cocoa/ +DEFER: objc-error. ( alien -- ) + +: datastack-underflow. "Data" stack-underflow. ; +: datastack-overflow. "Data" stack-overflow. ; +: retainstack-underflow. "Retain" stack-underflow. ; +: retainstack-overflow. "Retain" stack-overflow. ; +: callstack-underflow. "Call" stack-underflow. ; +: callstack-overflow. "Call" stack-overflow. ; + +: kernel-error ( error -- word ) + #! Kernel errors are indexed by integers. + second { + expired-error. + io-error. + undefined-word-error. + type-check-error. + signal-error. + negative-array-size-error. + c-string-error. + ffi-error. + heap-scan-error. + undefined-symbol-error. + user-interrupt. + datastack-underflow. + datastack-overflow. + retainstack-underflow. + retainstack-overflow. + callstack-underflow. + callstack-overflow. + } nth ; + +M: kernel-error error. ( error -- ) dup kernel-error execute ; + +M: kernel-error error-help ( error -- topic ) kernel-error ; + +M: no-method summary + drop "No suitable method" ; + +M: no-method error. ( error -- ) + "Generic word " write + dup no-method-generic pprint + " does not define a method for the " write + dup no-method-object class pprint + " class." print + "Allowed classes: " write dup no-method-generic order . + "Dispatching on object: " write no-method-object short. ; + +M: no-math-method summary + drop "No suitable arithmetic method" ; + +M: /0 summary + drop "Division by zero" ; + +M: bad-escape summary + drop "Invalid escape code" ; + +M: c-stream-error summary + drop "C stream I/O does not support this feature" ; + +M: check-closed summary + drop "Attempt to perform I/O on closed stream" ; + +M: check-method summary + drop "Invalid parameters for define-method" ; + +M: check-ptr summary + drop "Memory allocation failed" ; + +M: check-tuple summary + drop "Invalid class for define-constructor" ; + +M: check-vocab summary + drop "Vocabulary does not exist" ; + +M: empty-queue summary + drop "Empty queue" ; + +M: no-article summary + drop "Help article does not exist" ; + +M: no-cond summary + drop "Fall-through in cond" ; + +M: slice-error error. + "Cannot create slice because " write + slice-error-reason append print ; + +: parse-dump ( error -- ) + "Parsing " write + dup parse-error-file [ "" ] unless* write + ":" write + dup parse-error-line [ 1 ] unless* number>string print + + dup parse-error-text dup string? [ print ] [ drop ] if + + parse-error-col [ 0 ] unless* + CHAR: \s write "^" print ; + +M: parse-error error. ( error -- ) + dup parse-dump delegate error. ; + +M: bounds-error summary drop "Sequence index out of bounds" ; + +M: condition error. delegate error. ; + +M: condition error-help drop f ; + +M: alien-callback-error summary ( error -- ) + drop "Words calling ``alien-callback'' cannot run in the interpreter. Compile the caller word and try again." ; + +M: alien-invoke-error summary ( error -- ) + drop "Words calling ``alien-invoke'' cannot run in the interpreter. Compile the caller word and try again." ; + +M: assert summary drop "Assertion failed" ; + +M: inference-error error. ( error -- ) + "Inference error:" print + dup inference-error-message print + "Recursive state:" print + inference-error-rstate describe ;