library/tools/errors.factor

   1 ! Copyright (C) 2006 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 IN: errors
   4 USING: generic help tools io kernel math math-internals parser
   5 prettyprint queues sequences sequences-internals strings test
   6 words definitions ;
   7
   8 : expired-error. ( obj -- )
   9     "Object did not survive image save/load: " write third . ;
  10
  11 : undefined-word-error. ( obj -- )
  12     "Undefined word: " write third . ;
  13
  14 : io-error. ( error -- )
  15     "I/O error: " write third print ;
  16
  17 : type-check-error. ( list -- )
  18     "Type check error" print
  19     "Object: " write dup fourth short.
  20     "Object type: " write dup fourth class .
  21     "Expected type: " write third type>class . ;
  22
  23 : signal-error. ( obj -- )
  24     "Operating system signal " write third . ;
  25
  26 : negative-array-size-error. ( obj -- )
  27     "Cannot allocate array with negative size " write third . ;
  28
  29 : c-string-error. ( obj -- )
  30     "Cannot convert to C string: " write third . ;
  31
  32 : ffi-error. ( obj -- )
  33     "FFI: " write third print ;
  34
  35 : heap-scan-error. ( obj -- )
  36     "Cannot do next-object outside begin/end-scan" print drop ;
  37
  38 : undefined-symbol-error. ( obj -- )
  39     "The image refers to a library or symbol that was not found"
  40     " at load time" append print drop ;
  41
  42 : user-interrupt. ( obj -- )
  43     "User interrupt" print drop ;
  44
  45 : stack-underflow. ( obj name -- )
  46     write " stack underflow" print drop ;
  47
  48 : stack-overflow. ( obj name -- )
  49     write " stack overflow" print drop ;
  50
  51 ! Hook for library/cocoa/
  52 DEFER: objc-error. ( alien -- )
  53
  54 : datastack-underflow. "Data" stack-underflow. ;
  55 : datastack-overflow. "Data" stack-overflow. ;
  56 : retainstack-underflow. "Retain" stack-underflow. ;
  57 : retainstack-overflow. "Retain" stack-overflow. ;
  58 : callstack-underflow. "Call" stack-underflow. ;
  59 : callstack-overflow. "Call" stack-overflow. ;
  60
  61 : kernel-error ( error -- word )
  62     #! Kernel errors are indexed by integers.
  63     second {
  64         expired-error.
  65         io-error.
  66         undefined-word-error.
  67         type-check-error.
  68         signal-error.
  69         negative-array-size-error.
  70         c-string-error.
  71         ffi-error.
  72         heap-scan-error.
  73         undefined-symbol-error.
  74         user-interrupt.
  75         datastack-underflow.
  76         datastack-overflow.
  77         retainstack-underflow.
  78         retainstack-overflow.
  79         callstack-underflow.
  80         callstack-overflow.
  81     } nth ;
  82
  83 M: kernel-error error. dup kernel-error execute ;
  84
  85 M: kernel-error error-help kernel-error ;
  86
  87 M: no-method summary
  88     drop "No suitable method" ;
  89
  90 M: no-method error.
  91     "Generic word " write
  92     dup no-method-generic pprint
  93     " does not define a method for the " write
  94     dup no-method-object class pprint
  95     " class." print
  96     "Allowed classes: " write dup no-method-generic order .
  97     "Dispatching on object: " write no-method-object short. ;
  98
  99 M: no-math-method summary
 100     drop "No suitable arithmetic method" ;
 101
 102 M: /0 summary
 103     drop "Division by zero" ;
 104
 105 M: bad-escape summary
 106     drop "Invalid escape code" ;
 107
 108 M: c-stream-error summary
 109     drop "C stream I/O does not support this feature" ;
 110
 111 M: check-closed summary
 112     drop "Attempt to perform I/O on closed stream" ;
 113
 114 M: check-method summary
 115     drop "Invalid parameters for define-method" ;
 116
 117 M: check-tuple summary
 118     drop "Invalid class for define-constructor" ;
 119
 120 M: check-vocab summary
 121     drop "Vocabulary does not exist" ;
 122
 123 M: empty-queue summary
 124     drop "Empty queue" ;
 125
 126 M: no-article summary
 127     drop "Help article does not exist" ;
 128
 129 M: no-cond summary
 130     drop "Fall-through in cond" ;
 131
 132 M: slice-error error.
 133     "Cannot create slice because " write
 134     slice-error-reason print ;
 135
 136 M: no-word summary
 137     drop "Word not found in current vocabulary search path" ;
 138
 139 : parse-dump ( error -- )
 140     "Parsing " write
 141     dup parse-error-file
 142     [ "<interactive>" ] unless*
 143     write-pathname
 144     ":" write
 145     dup parse-error-line [ 1 ] unless* number>string print
 146
 147     dup parse-error-text dup string? [ print ] [ drop ] if
 148
 149     parse-error-col [ 0 ] unless*
 150     CHAR: \s <string> write "^" print ;
 151
 152 M: parse-error error.
 153     dup parse-dump  delegate error. ;
 154
 155 M: bounds-error summary drop "Sequence index out of bounds" ;
 156
 157 M: condition error. delegate error. ;
 158
 159 M: condition error-help drop f ;
 160
 161 M: assert summary drop "Assertion failed" ;
 162
 163 M: no-edit-hook summary drop "No edit hook is set" ;